module DepGraph.Data

import Data.String

%default total

dquote : String -> String
dquote str = "\"" ++ str ++ "\""

joinSemicolon : List String -> String
joinSemicolon = joinBy "; "

--------------------------------------------------------------------------------
-- Modules dependency graph
--------------------------------------------------------------------------------

public export
record Module where
  constructor MkModule
  name : String
  deps : List String

public export
record PkgModules where
  constructor MkPkgModules
  name : String
  modules : List Module

public export
PkgsModules : Type
PkgsModules = List PkgModules

export
Show PkgsModules where
  show pkgs = "digraph { splines=\"ortho\";" ++ subgraphs ++ edges ++ "}"
    where
      depEdge : String -> String -> String
      depEdge srcName destName = dquote srcName ++ " -> " ++ dquote destName

      moduleEdge : Module -> String
      moduleEdge mod = joinSemicolon $ depEdge mod.name <$> mod.deps

      pkgEdge : PkgModules -> String
      pkgEdge pkg = concat $ moduleEdge <$> pkg.modules

      moduleNode : Module -> String
      moduleNode mod = dquote mod.name ++ "[style=\"filled\", fillcolor=white]"

      pkgSubgraph : PkgModules -> String
      pkgSubgraph pkg =
        -- prefix the name with "cluster" to group its nodes in a labelled box
        "subgraph " ++ (dquote $ "cluster_" ++ pkg.name)
        ++ "{"
        ++ "style=\"filled\"; fillcolor = \"linen\";"
        ++ "label=" ++ dquote pkg.name ++ ";"
        ++ (joinSemicolon $ moduleNode <$> pkg.modules)
        ++ "}"

      subgraphs, edges : String
      subgraphs = concat $ pkgSubgraph <$> pkgs
      edges = concat $ pkgEdge <$> pkgs

--------------------------------------------------------------------------------
-- Packages dependency graph
--------------------------------------------------------------------------------

public export
record Package where
  constructor MkPackage
  name : String
  deps : List String
  isLocal : Bool

public export
Packages : Type
Packages = List Package

export
Show Packages where
  show pkgs = "digraph {" ++ inner ++ "}"
    where
      depEdge : String -> String -> String
      depEdge srcName destName = dquote srcName ++ " -> " ++ dquote destName

      pkgEdge : Package -> List String
      pkgEdge pkg = depEdge pkg.name <$> pkg.deps

      pkgNode : Package -> String
      pkgNode pkg =
        (dquote pkg.name)
        ++ "["
        ++ (if pkg.isLocal
             then "style=\"filled\"; fillcolor =\"linen\";"
             else "")
        ++ "]"

      edges = concat $ pkgEdge <$> pkgs
      nodes = pkgNode <$> pkgs
      inner = joinSemicolon (nodes ++ edges)