module Drasil.Generator.SRS.TraceabilityGraphs (outputDot) where

import Data.List (intercalate)
import System.IO (Handle, IOMode(WriteMode), openFile, hPutStrLn, hClose)
import System.Directory (setCurrentDirectory)

import Drasil.Database (UID)
import Drasil.Metadata.TraceabilityGraphs (GraphInfo(..), NodeFamily(..),
  Label, Colour)
import Utils.Drasil (createDirIfMissing)

-- | Creates the directory for output, gathers all individual graph output functions and calls them.
outputDot :: FilePath -> GraphInfo -> IO ()
outputDot :: FilePath -> GraphInfo -> IO ()
outputDot FilePath
outputFilePath GraphInfo
gi = do
    Bool -> FilePath -> IO ()
createDirIfMissing Bool
False FilePath
outputFilePath
    FilePath -> IO ()
setCurrentDirectory FilePath
outputFilePath
    GraphInfo
-> FilePath
-> (GraphInfo -> [(UID, [UID])])
-> [GraphInfo -> NodeFamily]
-> IO ()
mkOutput GraphInfo
gi FilePath
"avsa" GraphInfo -> [(UID, [UID])]
edgesAvsA [GraphInfo -> NodeFamily
assumpNF]
    GraphInfo
-> FilePath
-> (GraphInfo -> [(UID, [UID])])
-> [GraphInfo -> NodeFamily]
-> IO ()
mkOutput GraphInfo
gi FilePath
"avsall" GraphInfo -> [(UID, [UID])]
edgesAvsAll [GraphInfo -> NodeFamily
assumpNF, GraphInfo -> NodeFamily
ddNF, GraphInfo -> NodeFamily
tmNF, GraphInfo -> NodeFamily
gdNF, GraphInfo -> NodeFamily
imNF, GraphInfo -> NodeFamily
reqNF, GraphInfo -> NodeFamily
chgNF]
    GraphInfo
-> FilePath
-> (GraphInfo -> [(UID, [UID])])
-> [GraphInfo -> NodeFamily]
-> IO ()
mkOutput GraphInfo
gi FilePath
"refvsref" GraphInfo -> [(UID, [UID])]
edgesRefvsRef [GraphInfo -> NodeFamily
ddNF, GraphInfo -> NodeFamily
tmNF, GraphInfo -> NodeFamily
gdNF, GraphInfo -> NodeFamily
imNF]
    GraphInfo
-> FilePath
-> (GraphInfo -> [(UID, [UID])])
-> [GraphInfo -> NodeFamily]
-> IO ()
mkOutput GraphInfo
gi FilePath
"allvsr" GraphInfo -> [(UID, [UID])]
edgesAllvsR [GraphInfo -> NodeFamily
assumpNF, GraphInfo -> NodeFamily
ddNF, GraphInfo -> NodeFamily
tmNF, GraphInfo -> NodeFamily
gdNF, GraphInfo -> NodeFamily
imNF, GraphInfo -> NodeFamily
reqNF, GraphInfo -> NodeFamily
gsNF]
    GraphInfo
-> FilePath
-> (GraphInfo -> [(UID, [UID])])
-> [GraphInfo -> NodeFamily]
-> IO ()
mkOutput GraphInfo
gi FilePath
"allvsall" GraphInfo -> [(UID, [UID])]
edgesAllvsAll [GraphInfo -> NodeFamily
assumpNF, GraphInfo -> NodeFamily
ddNF, GraphInfo -> NodeFamily
tmNF, GraphInfo -> NodeFamily
gdNF, GraphInfo -> NodeFamily
imNF, GraphInfo -> NodeFamily
reqNF, GraphInfo -> NodeFamily
gsNF, GraphInfo -> NodeFamily
chgNF]

-- ** Helpers

-- | General output function for making a traceability graph. Takes in the graph information, title, edge generator functions, and node family functions.
mkOutput :: GraphInfo -> String -> (GraphInfo -> [(UID, [UID])]) -> [GraphInfo -> NodeFamily] -> IO ()
mkOutput :: GraphInfo
-> FilePath
-> (GraphInfo -> [(UID, [UID])])
-> [GraphInfo -> NodeFamily]
-> IO ()
mkOutput GraphInfo
gi FilePath
ttl GraphInfo -> [(UID, [UID])]
getDirections [GraphInfo -> NodeFamily]
getLabels = do
    Handle
handle <- FilePath -> IOMode -> IO Handle
openFile (FilePath
ttl FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".dot") IOMode
WriteMode
    Handle -> FilePath -> IO ()
hPutStrLn Handle
handle (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"digraph " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
ttl FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" {"
    let labels :: [NodeFamily]
labels = GraphInfo -> [GraphInfo -> NodeFamily] -> [NodeFamily]
filterAndGI GraphInfo
gi [GraphInfo -> NodeFamily]
getLabels
    Handle -> [(UID, [UID])] -> [NodeFamily] -> IO ()
outputSub Handle
handle (GraphInfo -> [(UID, [UID])]
getDirections GraphInfo
gi) [NodeFamily]
labels
    Handle -> FilePath -> IO ()
hPutStrLn Handle
handle FilePath
"}"
    Handle -> IO ()
hClose Handle
handle

-- | Graph output helper. Takes in the file handle, edges, and node families.
outputSub :: Handle -> [(UID, [UID])] -> [NodeFamily] -> IO ()
outputSub :: Handle -> [(UID, [UID])] -> [NodeFamily] -> IO ()
outputSub Handle
handle [(UID, [UID])]
edges [NodeFamily]
nodes = do
    ((UID, [UID]) -> IO ()) -> [(UID, [UID])] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> (UID, [UID]) -> IO ()
mkDirections Handle
handle) [(UID, [UID])]
edges
    Handle -> FilePath -> IO ()
hPutStrLn Handle
handle FilePath
"\n"
    (NodeFamily -> IO ()) -> [NodeFamily] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> NodeFamily -> IO ()
mkNodes Handle
handle) [NodeFamily]
nodes

-- | Prints graph edges (directions) onto a given file handle.
mkDirections :: Handle -> (UID, [UID]) -> IO ()
mkDirections :: Handle -> (UID, [UID]) -> IO ()
mkDirections Handle
handle (UID, [UID])
ls = do
    (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> FilePath -> IO ()
hPutStrLn Handle
handle) ([FilePath] -> IO ()) -> [FilePath] -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> [FilePath]
makeEdgesSub (UID -> FilePath
forall a. Show a => a -> FilePath
show (UID -> FilePath) -> UID -> FilePath
forall a b. (a -> b) -> a -> b
$ (UID, [UID]) -> UID
forall a b. (a, b) -> a
fst (UID, [UID])
ls) ((FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (UID -> FilePath) -> [UID] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map UID -> FilePath
forall a. Show a => a -> FilePath
show ([UID] -> [FilePath]) -> [UID] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (UID, [UID]) -> [UID]
forall a b. (a, b) -> b
snd (UID, [UID])
ls)
    where
       -- Creates an edge between a type and its dependency (indented for subgraphs)
        makeEdgesSub :: String -> [String] -> [String]
        makeEdgesSub :: FilePath -> [FilePath] -> [FilePath]
makeEdgesSub FilePath
_ [] = []
        makeEdgesSub FilePath
nm (FilePath
c:[FilePath]
cs) = (FilePath
"\t" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
filterInvalidChars FilePath
nm FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" -> " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
filterInvalidChars FilePath
c FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
";")FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath -> [FilePath] -> [FilePath]
makeEdgesSub FilePath
nm [FilePath]
cs

-- | Prints graph nodes (labels) onto a given file handle.
mkNodes :: Handle -> NodeFamily -> IO ()
mkNodes :: Handle -> NodeFamily -> IO ()
mkNodes Handle
handle NF{nodeUIDs :: NodeFamily -> [UID]
nodeUIDs = [UID]
u, nodeLabels :: NodeFamily -> [FilePath]
nodeLabels = [FilePath]
ls, nfLabel :: NodeFamily -> FilePath
nfLabel = FilePath
lbl, nfColour :: NodeFamily -> FilePath
nfColour = FilePath
col} = do
    ((FilePath, FilePath) -> IO ()) -> [(FilePath, FilePath)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> FilePath -> IO ()
hPutStrLn Handle
handle (FilePath -> IO ())
-> ((FilePath, FilePath) -> FilePath)
-> (FilePath, FilePath)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath -> FilePath)
-> (FilePath, FilePath) -> FilePath
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (FilePath -> FilePath -> FilePath -> FilePath
makeNodesSub FilePath
col)) ([(FilePath, FilePath)] -> IO ())
-> [(FilePath, FilePath)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath] -> [(FilePath, FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
ls ([FilePath] -> [(FilePath, FilePath)])
-> [FilePath] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ (UID -> FilePath) -> [UID] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map UID -> FilePath
forall a. Show a => a -> FilePath
show [UID]
u
    Handle -> FilePath -> [UID] -> IO ()
mkSubgraph Handle
handle FilePath
lbl [UID]
u
    where
        -- Creates a node based on the kind of datatype (indented for subgraphs)
        makeNodesSub :: Colour -> String -> String -> String
        makeNodesSub :: FilePath -> FilePath -> FilePath -> FilePath
makeNodesSub FilePath
c FilePath
l FilePath
nm  = FilePath
"\t" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
filterInvalidChars FilePath
nm FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\t[shape=box, color=black, style=filled, fillcolor=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
c FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
", label=\"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
l FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\"];"

-- | Helper that only makes a subgraph if there are elements in the subgraph. Otherwise, it returns nothing.
mkSubgraph :: Handle -> Label -> [UID] -> IO ()
mkSubgraph :: Handle -> FilePath -> [UID] -> IO ()
mkSubgraph Handle
handle FilePath
l [UID]
u
    | FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
l = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall a. Monoid a => a
mempty
    | Bool
otherwise = do
             Handle -> FilePath -> IO ()
hPutStrLn Handle
handle (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"\n\tsubgraph " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
l FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" {"
             Handle -> FilePath -> IO ()
hPutStrLn Handle
handle FilePath
"\trank=\"same\""
             Handle -> FilePath -> IO ()
hPutStrLn Handle
handle (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"\t{" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " ((UID -> FilePath) -> [UID] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath
filterInvalidChars (FilePath -> FilePath) -> (UID -> FilePath) -> UID -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UID -> FilePath
forall a. Show a => a -> FilePath
show) [UID]
u) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"}"
             Handle -> FilePath -> IO ()
hPutStrLn Handle
handle FilePath
"\t}\n"

-- | Gets graph labels.
filterAndGI :: GraphInfo -> [GraphInfo -> NodeFamily] -> [NodeFamily]
filterAndGI :: GraphInfo -> [GraphInfo -> NodeFamily] -> [NodeFamily]
filterAndGI GraphInfo
gi [GraphInfo -> NodeFamily]
toNodes = [NodeFamily]
labels
    where
        labels :: [NodeFamily]
labels = ((GraphInfo -> NodeFamily) -> NodeFamily)
-> [GraphInfo -> NodeFamily] -> [NodeFamily]
forall a b. (a -> b) -> [a] -> [b]
map ((GraphInfo -> NodeFamily) -> GraphInfo -> NodeFamily
forall a b. (a -> b) -> a -> b
$ GraphInfo
gi) [GraphInfo -> NodeFamily]
toNodes

-- | Helper to remove invalid characters.
filterInvalidChars :: String -> String
filterInvalidChars :: FilePath -> FilePath
filterInvalidChars = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` FilePath
invalidChars)
  where
    invalidChars :: FilePath
invalidChars = FilePath
"^[]!} (){->,$"