{-# LANGUAGE OverloadedStrings #-}
module Algebra.Graph.Example.Todo (Todo, todo, low, high, (~*~), (>*<), priority) where

import Data.Map (Map)
import Data.String

import Algebra.Graph.AdjacencyMap as AM
import Algebra.Graph.AdjacencyMap.Algorithm as AM
import Algebra.Graph.Class as C

import qualified Data.Map as Map

data Todo a = T (Map a Int) (AdjacencyMap a) deriving Int -> Todo a -> ShowS
[Todo a] -> ShowS
Todo a -> String
(Int -> Todo a -> ShowS)
-> (Todo a -> String) -> ([Todo a] -> ShowS) -> Show (Todo a)
forall a. (Show a, Ord a) => Int -> Todo a -> ShowS
forall a. (Show a, Ord a) => [Todo a] -> ShowS
forall a. (Show a, Ord a) => Todo a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Todo a] -> ShowS
$cshowList :: forall a. (Show a, Ord a) => [Todo a] -> ShowS
show :: Todo a -> String
$cshow :: forall a. (Show a, Ord a) => Todo a -> String
showsPrec :: Int -> Todo a -> ShowS
$cshowsPrec :: forall a. (Show a, Ord a) => Int -> Todo a -> ShowS
Show

instance Ord a => Eq (Todo a) where
  Todo a
x == :: Todo a -> Todo a -> Bool
== Todo a
y = Todo a -> Maybe [a]
forall a. Ord a => Todo a -> Maybe [a]
todo Todo a
x Maybe [a] -> Maybe [a] -> Bool
forall a. Eq a => a -> a -> Bool
== Todo a -> Maybe [a]
forall a. Ord a => Todo a -> Maybe [a]
todo Todo a
y

instance (IsString a, Ord a) => IsString (Todo a) where
  fromString :: String -> Todo a
fromString = a -> Todo a
forall g. Graph g => Vertex g -> g
C.vertex (a -> Todo a) -> (String -> a) -> String -> Todo a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
forall a. IsString a => String -> a
fromString

-- Lower the priority of items in a given todo list
low :: Todo a -> Todo a
low :: Todo a -> Todo a
low (T Map a Int
p AdjacencyMap a
g) = Map a Int -> AdjacencyMap a -> Todo a
forall a. Map a Int -> AdjacencyMap a -> Todo a
T ((Int -> Int) -> Map a Int -> Map a Int
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1) Map a Int
p) AdjacencyMap a
g

-- Raise the priority of items in a given todo list
high :: Todo a -> Todo a
high :: Todo a -> Todo a
high (T Map a Int
p AdjacencyMap a
g) = Map a Int -> AdjacencyMap a -> Todo a
forall a. Map a Int -> AdjacencyMap a -> Todo a
T ((Int -> Int) -> Map a Int -> Map a Int
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Map a Int
p) AdjacencyMap a
g

-- Specify exact priority of items in a given todo list (default 0)
priority :: Int -> Todo a -> Todo a
priority :: Int -> Todo a -> Todo a
priority Int
x (T Map a Int
p AdjacencyMap a
g) = Map a Int -> AdjacencyMap a -> Todo a
forall a. Map a Int -> AdjacencyMap a -> Todo a
T ((Int -> Int) -> Map a Int -> Map a Int
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Int -> Int -> Int
forall a b. a -> b -> a
const Int
x) Map a Int
p) AdjacencyMap a
g

-- Pull the arguments together as close as possible
(~*~) :: Ord a => Todo a -> Todo a -> Todo a
Todo a
x ~*~ :: Todo a -> Todo a -> Todo a
~*~ Todo a
y = Todo a -> Todo a
forall a. Todo a -> Todo a
low Todo a
x Todo a -> Todo a -> Todo a
forall g. Graph g => g -> g -> g
`C.connect` Todo a -> Todo a
forall a. Todo a -> Todo a
high Todo a
y

-- Repel the arguments as far as possible
(>*<) :: Ord a => Todo a -> Todo a -> Todo a
Todo a
x >*< :: Todo a -> Todo a -> Todo a
>*< Todo a
y = Todo a -> Todo a
forall a. Todo a -> Todo a
high Todo a
x Todo a -> Todo a -> Todo a
forall g. Graph g => g -> g -> g
`C.connect` Todo a -> Todo a
forall a. Todo a -> Todo a
low Todo a
y

todo :: forall a. Ord a => Todo a -> Maybe [a]
todo :: Todo a -> Maybe [a]
todo (T Map a Int
p AdjacencyMap a
g) =
  case AdjacencyMap (Int, a) -> Either (Cycle (Int, a)) [(Int, a)]
forall a. Ord a => AdjacencyMap a -> Either (Cycle a) [a]
AM.topSort (AdjacencyMap (Int, a) -> Either (Cycle (Int, a)) [(Int, a)])
-> AdjacencyMap (Int, a) -> Either (Cycle (Int, a)) [(Int, a)]
forall a b. (a -> b) -> a -> b
$ (a -> (Int, a)) -> AdjacencyMap a -> AdjacencyMap (Int, a)
forall a b.
(Ord a, Ord b) =>
(a -> b) -> AdjacencyMap a -> AdjacencyMap b
gmap a -> (Int, a)
prioritise AdjacencyMap a
g of
    Left Cycle (Int, a)
_ -> Maybe [a]
forall a. Maybe a
Nothing
    Right [(Int, a)]
xs -> [a] -> Maybe [a]
forall a. a -> Maybe a
Just ([a] -> Maybe [a]) -> [a] -> Maybe [a]
forall a b. (a -> b) -> a -> b
$ ((Int, a) -> a) -> [(Int, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Int, a) -> a
forall a b. (a, b) -> b
snd [(Int, a)]
xs
  where
    prioritise :: a -> (Int, a)
    prioritise :: a -> (Int, a)
prioritise a
x = (Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> a -> Map a Int -> Int
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Int
0 a
x Map a Int
p, a
x)

instance (IsString a, Ord a) => Num (Todo a) where
  fromInteger :: Integer -> Todo a
fromInteger Integer
i = String -> Todo a
forall a. IsString a => String -> a
fromString (String -> Todo a) -> String -> Todo a
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show (Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
i :: Integer)
  + :: Todo a -> Todo a -> Todo a
(+)           = Todo a -> Todo a -> Todo a
forall g. Graph g => g -> g -> g
C.overlay
  * :: Todo a -> Todo a -> Todo a
(*)           = Todo a -> Todo a -> Todo a
forall g. Graph g => g -> g -> g
C.connect
  signum :: Todo a -> Todo a
signum        = Todo a -> Todo a -> Todo a
forall a b. a -> b -> a
const Todo a
forall g. Graph g => g
C.empty
  abs :: Todo a -> Todo a
abs           = Todo a -> Todo a
forall a. a -> a
id
  negate :: Todo a -> Todo a
negate        = Todo a -> Todo a
forall a. a -> a
id

instance Ord a => Graph (Todo a) where
  type Vertex (Todo a) = a
  empty :: Todo a
empty    = Map a Int -> AdjacencyMap a -> Todo a
forall a. Map a Int -> AdjacencyMap a -> Todo a
T Map a Int
forall k a. Map k a
Map.empty AdjacencyMap a
forall a. AdjacencyMap a
AM.empty
  vertex :: Vertex (Todo a) -> Todo a
vertex Vertex (Todo a)
x = Map a Int -> AdjacencyMap a -> Todo a
forall a. Map a Int -> AdjacencyMap a -> Todo a
T (a -> Int -> Map a Int
forall k a. k -> a -> Map k a
Map.singleton a
Vertex (Todo a)
x Int
0) (Vertex (AdjacencyMap a) -> AdjacencyMap a
forall g. Graph g => Vertex g -> g
C.vertex Vertex (AdjacencyMap a)
Vertex (Todo a)
x)
  overlay :: Todo a -> Todo a -> Todo a
overlay (T Map a Int
p1 AdjacencyMap a
g1) (T Map a Int
p2 AdjacencyMap a
g2) = Map a Int -> AdjacencyMap a -> Todo a
forall a. Map a Int -> AdjacencyMap a -> Todo a
T ((Int -> Int -> Int) -> Map a Int -> Map a Int -> Map a Int
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Map a Int
p1 Map a Int
p2) (AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
forall g. Graph g => g -> g -> g
C.overlay AdjacencyMap a
g1 AdjacencyMap a
g2)
  connect :: Todo a -> Todo a -> Todo a
connect (T Map a Int
p1 AdjacencyMap a
g1) (T Map a Int
p2 AdjacencyMap a
g2) = Map a Int -> AdjacencyMap a -> Todo a
forall a. Map a Int -> AdjacencyMap a -> Todo a
T ((Int -> Int -> Int) -> Map a Int -> Map a Int -> Map a Int
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Map a Int
p1 Map a Int
p2) (AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
forall g. Graph g => g -> g -> g
C.connect AdjacencyMap a
g1 AdjacencyMap a
g2)