-- To generalize the use of dot printers in generating graphs
module Drasil.Meta.Analysis.DataPrinters.Dot (digraph, subgraph,
  makeEdgesDi, makeEdgesSub, makeNodesDi, makeNodesSub, replaceInvalidChars) where

import System.IO

-- type synonyms for clarity.
type Name = String
type Nodes = (Colour, [String])
type Edges = (String, [String])

-- Make a simple directional graph.
-- Takes in a file handle, name of directional graph, nodes and edges.
digraph :: Handle -> Name -> [Nodes] -> [Edges] -> IO ()
digraph :: Handle -> String -> [Nodes] -> [Nodes] -> IO ()
digraph Handle
handle String
nm [Nodes]
nds [Nodes]
edgs = do
    Handle -> String -> IO ()
hPutStrLn Handle
handle (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"digraph " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
replaceInvalidChars String
nm String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"{"
    (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> String -> IO ()
hPutStrLn Handle
handle) ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ (Nodes -> [String]) -> [Nodes] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Nodes
ns -> String -> String -> String
makeNodesDi (Nodes -> String
forall a b. (a, b) -> a
fst Nodes
ns) (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Nodes -> [String]
forall a b. (a, b) -> b
snd Nodes
ns) [Nodes]
nds
    (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> String -> IO ()
hPutStrLn Handle
handle) ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ (Nodes -> [String]) -> [Nodes] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String -> [String] -> [String]) -> Nodes -> [String]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> [String] -> [String]
makeEdgesDi) [Nodes]
edgs
    Handle -> String -> IO ()
hPutStrLn Handle
handle String
"}"
    Handle -> IO ()
hClose Handle
handle

-- Similar to digraph, but makes a subgraph and indents each line to look nicer.
-- Does not close the handle when done.
subgraph :: Handle -> Name -> [Nodes] -> [Edges] -> IO ()
subgraph :: Handle -> String -> [Nodes] -> [Nodes] -> IO ()
subgraph Handle
handle String
nm [Nodes]
nds [Nodes]
edgs = do
    Handle -> String -> IO ()
hPutStrLn Handle
handle (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\t\tsubgraph " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
replaceInvalidChars String
nm String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"{"
    (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> String -> IO ()
hPutStrLn Handle
handle) ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ (Nodes -> [String]) -> [Nodes] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Nodes
ns -> String -> String -> String
makeNodesSub (Nodes -> String
forall a b. (a, b) -> a
fst Nodes
ns) (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Nodes -> [String]
forall a b. (a, b) -> b
snd Nodes
ns) [Nodes]
nds
    (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> String -> IO ()
hPutStrLn Handle
handle) ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ (Nodes -> [String]) -> [Nodes] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String -> [String] -> [String]) -> Nodes -> [String]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> [String] -> [String]
makeEdgesSub) [Nodes]
edgs
    Handle -> String -> IO ()
hPutStrLn Handle
handle String
"\t\t}"

------------------
-- Graph-related functions
------------------
type Colour = String

-- Creates an edge between a type and its dependency
makeEdgesDi :: String -> [String] -> [String]
makeEdgesDi :: String -> [String] -> [String]
makeEdgesDi String
nm = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
c -> String -> String
replaceInvalidChars String
nm String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" -> " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
replaceInvalidChars String
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
";")

-- Creates an edge between a type and its dependency (indented for subgraphs)
makeEdgesSub :: String -> [String] -> [String]
makeEdgesSub :: String -> [String] -> [String]
makeEdgesSub String
nm = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
c -> String
"\t\t" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
replaceInvalidChars String
nm String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" -> " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
replaceInvalidChars String
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
";")

-- Creates a node based on the kind of datatype
makeNodesDi :: Colour -> String -> String
makeNodesDi :: String -> String -> String
makeNodesDi String
c String
nm = String -> String
replaceInvalidChars String
nm String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\t[shape=oval, color=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", label=\"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
nm String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\"];"

-- Creates a node based on the kind of datatype (indented for subgraphs)
makeNodesSub :: Colour -> String -> String
makeNodesSub :: String -> String -> String
makeNodesSub String
c String
nm = String
"\t\t" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
replaceInvalidChars String
nm String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\t[shape=oval, color=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", label=\"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
nm String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\"];"

-- Filter out invalid characters and replace them with an underscore.
replaceInvalidChars :: String -> String
replaceInvalidChars :: String -> String
replaceInvalidChars = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Char
x -> if Char
x Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
invalidChars then Char
'_' else Char
x)
  where
    invalidChars :: String
invalidChars = String
"[]!} (){->,$'"