{-# language RecursiveDo #-}


import Data.Map ((!), fromList)

import Control.Monad.State

import qualified Text.Dot as Dot


-- * Graph definition

-- | type of Graphs.
data Graph node
    = Graph {
        nodes :: [node],
        edges :: [(node, node)]
      }
  deriving Show

-- | The empty Graph.
emptyGraph :: Graph a
emptyGraph = Graph [] []

-- | Converts a Graph into dot format
toDot :: (Ord s, Show s) => Graph s -> String
toDot (Graph nodes edges) = Dot.showDot $ do
    ids <- mapM (\ l -> Dot.node [("label", show l)]) nodes
    let idMap = fromList $ zip nodes ids
    mapM_ (\ (a, b) -> (idMap ! a) Dot..->. (idMap ! b)) edges


-- * GraphMonad

-- | Allows to write directed Graphs in form of monadic statements.
type GraphMonad n a = State (Graph n) a

data Output n = Output n

-- | Builds the Graph given a graph creation command.
buildGraph :: GraphMonad n () -> Graph n
buildGraph cmd = snd $ runState cmd emptyGraph

-- | Constructs a node. $inputs$ are all nodes which should be
-- connected (via edges) to this new node.
mkNode :: n -> [Output n] -> GraphMonad n (Output n)
mkNode node inputs =
    State $ \ (Graph nodes edges) ->
        let newEdges = map (\ (Output input) -> (input, node)) inputs
        in (Output node, Graph (node : nodes) (edges ++ newEdges))


-- * example graph

-- | This is just an example graph.
example :: Graph String
example = buildGraph $ mdo

    mkNode "unconnected" []

    a <- mkNode "A" []
    b <- mkNode "B" [a]
    mkNode "C" [a, b]

    subgraph a b

    c1 <- mkNode "cyclic" [c1, c2]
    c2 <- mkNode "cyclic2" [c1]

    return ()

-- | example for encapsulating subgraphs.
-- This doesn't show in the resulting graph.
subgraph :: Output String -> Output String -> GraphMonad String ()
subgraph a b = do
    x <- mkNode "x" [a]
    mkNode "y" [x, b]
    return ()

-- | Print out the example graph in dot format to stdout
main = putStrLn $ toDot example