{-# 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
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 = forall a. Ord a => Todo a -> Maybe [a]
todo Todo a
x forall a. Eq a => a -> a -> Bool
== 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 = forall g. Graph g => Vertex g -> g
C.vertex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

-- Lower the priority of items in a given todo list
low :: Todo a -> Todo a
low :: forall a. Todo a -> Todo a
low (T Map a Int
p AdjacencyMap a
g) = forall a. Map a Int -> AdjacencyMap a -> Todo a
T (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (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 :: forall a. Todo a -> Todo a
high (T Map a Int
p AdjacencyMap a
g) = forall a. Map a Int -> AdjacencyMap a -> Todo a
T (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (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 :: forall a. Int -> Todo a -> Todo a
priority Int
x (T Map a Int
p AdjacencyMap a
g) = forall a. Map a Int -> AdjacencyMap a -> Todo a
T (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (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 ~*~ :: forall a. Ord a => Todo a -> Todo a -> Todo a
~*~ Todo a
y = forall a. Todo a -> Todo a
low Todo a
x forall g. Graph g => g -> g -> g
`C.connect` 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 >*< :: forall a. Ord a => Todo a -> Todo a -> Todo a
>*< Todo a
y = forall a. Todo a -> Todo a
high Todo a
x forall g. Graph g => g -> g -> g
`C.connect` forall a. Todo a -> Todo a
low Todo a
y

todo :: forall a. Ord a => Todo a -> Maybe [a]
todo :: forall a. Ord a => Todo a -> Maybe [a]
todo (T Map a Int
p AdjacencyMap a
g) =
  case forall a. Ord a => AdjacencyMap a -> Either (Cycle a) [a]
AM.topSort forall a b. (a -> b) -> a -> b
$ 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)
_ -> forall a. Maybe a
Nothing
    Right [(Int, a)]
xs -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Int, a)]
xs
  where
    prioritise :: a -> (Int, a)
    prioritise :: a -> (Int, a)
prioritise a
x = (forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ 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 = forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show (forall a. Num a => Integer -> a
fromInteger Integer
i :: Integer)
  + :: Todo a -> Todo a -> Todo a
(+)           = forall g. Graph g => g -> g -> g
C.overlay
  * :: Todo a -> Todo a -> Todo a
(*)           = forall g. Graph g => g -> g -> g
C.connect
  signum :: Todo a -> Todo a
signum        = forall a b. a -> b -> a
const forall g. Graph g => g
C.empty
  abs :: Todo a -> Todo a
abs           = forall a. a -> a
id
  negate :: Todo a -> Todo a
negate        = forall a. a -> a
id

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