content: {-# LANGUAGE OverloadedStrings #-}
  
  module Main(main) where
  
  
  
  import           Control.Monad
  
  import           Data.GraphViz
  import           Data.GraphViz.Types
  import           Data.GraphViz.Types.Generalised
  import           Data.GraphViz.Types.Monadic
  import           Data.GraphViz.Printing
  import           Data.GraphViz.Attributes
  import           Data.GraphViz.Attributes.Complete
  import qualified Data.GraphViz.Attributes.HTML as HTML
  import           Data.GraphViz.Commands
  
  import qualified Data.Text.Lazy.IO as Text.Lazy.IO
  import           Data.Text.Lazy ( Text )
  import qualified Data.Text.Lazy as Text.Lazy
  
  
  
  dataTransformationLabeled :: n -> Text -> [(n, Maybe Text)] -> [n] -> DotM n ()
  dataTransformationLabeled name labelText inputs outputs = do
    node
      name
      [ shape PlainText
      , textLabel labelText
      , BgColor []
      , color White
      , Margin $ DVal 0.01
      ]
    inputs `forM_` \(i, l) -> edge
      i
      name
      ( [Dir NoDir] ++ case l of
        Nothing -> []
        Just t  -> [textLabel t]
      )
    -- edge inputs name [Dir NoDir]
    outputs `forM_` \o -> edge name o []
  
  dataTransformation :: n -> Text -> [n] -> [n] -> DotM n ()
  dataTransformation name labelText inputs outputs = do
    node
      name
      [ shape PlainText
      , textLabel labelText
      , BgColor []
      , color White
      , Margin $ DVal 0.01
      ]
    inputs `forM_` \i -> edge i name [Dir NoDir]
    outputs `forM_` \o -> edge name o []
  
  addNote :: n -> [n] -> Text -> DotM n ()
  addNote noteName refsName foo = do
    node noteName [textLabel foo, shape PlainText, color White, fontColor Gray40]
    refsName `forM_` \n -> edge n noteName [Dir NoDir, style dotted, PenWidth 1.0]
  
  subContext :: n -> Text -> DotM n ()
  subContext n t = node n [textLabel t, color Black, style solid, shape Ellipse]
  
  
  
  main :: IO ()
  main = do
    void $ runGraphviz periphery Pdf "periphery.pdf"
    void $ runGraphviz periphery Svg "periphery.svg"
    void $ runGraphviz ppm Pdf "ppm.pdf"
    void $ runGraphviz ppm Svg "ppm.svg"
    void $ runGraphviz bridocgen Pdf "bridocgen.pdf"
    void $ runGraphviz bridocgen Svg "bridocgen.svg"
   where
  
    periphery :: Data.GraphViz.Types.Generalised.DotGraph String
    periphery = digraph (Str ("periphery")) $ do
  
      -- graphAttrs [Layout Neato]
      nodeAttrs [style filled, color LightGray, shape BoxShape]
      edgeAttrs [color Gray40, PenWidth 2.0]
  
      cluster (Num $ Int 0) $ do
        graphAttrs [textLabel $ "input"]
        graphAttrs [color LightGray, shape Tab]
        nodeAttrs [style filled, color LightGray, shape BoxShape]
        node "stdin/input file" []
        node "program args"     []
        node "config file"      []
  
      cluster (Num $ Int 1) $ do
        graphAttrs [textLabel $ "output"]
        graphAttrs [color LightGray, shape Tab]
        nodeAttrs [style filled, color LightGray, shape BoxShape]
        node "output" [textLabel $ "stdout/output file"]
        node "stderr" [textLabel $ "stderr"]
  
      node "config" []
      "program args" --> "config"
      "config file" --> "config"
      "default config" --> "config"
  
      node "syntaxtree"   []
      node "annotations"  []
      node "annotations'" []
  
      dataTransformation "annTrans"
                         "transform slightly"
                         ["annotations"]
                         ["annotations'"]
  
      dataTransformation "parse"
                         "parse via ghc-exactprint"
                         ["stdin/input file"]
                         ["syntaxtree", "annotations"]
  
      subContext "ppmcontext" $ Text.Lazy.unlines
        [ "transformation in"
        , "PPM monadic context:"
        , "Reader: Config+Anns"
        , "Writer: Output+Errors(+Debug output)"
        ]
  
      "config" --> "ppmcontext"
      "annotations'" --> "ppmcontext"
      "syntaxtree" --> "ppmcontext"
  
      "ppmcontext" --> "output"
      "ppmcontext" --> "stderr"
  
    ppm :: Data.GraphViz.Types.Generalised.DotGraph String
    ppm = digraph (Str ("ppm")) $ do
  
      -- graphAttrs [Layout Neato]
      nodeAttrs [style filled, color LightGray, shape BoxShape]
      edgeAttrs [color Gray40, PenWidth 2.0]
  
      node
        "config"
        [ fontColor Gray40
        , color Gray90
        , textLabel $ Text.Lazy.unlines ["config", "(--dump-config)"]
        ]
      node
        "annotations"
        [ fontColor Gray40
        , color Gray90
        , textLabel $ Text.Lazy.unlines ["annotations", "(--dump-annotations)"]
        ]
  
      node "syntaxtree"
           [textLabel $ Text.Lazy.unlines ["syntaxtree", "(--dump-ast-full)"]]
  
      node
        "modulechildren"
        [textLabel
          $ Text.Lazy.unlines
              [ "top-level module"
              , "children, e.g."
              , "type sig, bind,"
              , "data decl etc."
              ]
        ]
  
      dataTransformation "syntaxSplit"
                         "split into"
                         ["syntaxtree"]
                         ["module header", "modulechildren"]
  
      subContext "bridocgen" $ Text.Lazy.unlines
        [ "translation into BriDoc tree/DAG"
        , "in (nested) monadic context"
        , "(additional) State: NodeAllocIndex"
        ]
  
      addNote "bridocgen-note"
              ["bridocgen"]
              "largest portion of\nbrittany src code"
  
      edge "modulechildren" "bridocgen" [textLabel $ "for each child"]
      edge "config"         "bridocgen" [color Gray70, PenWidth 1.0]
      edge "annotations"    "bridocgen" [color Gray70, PenWidth 1.0]
  
      node
        "bridoc-alt"
        [textLabel $ Text.Lazy.unlines
          ["BriDoc (with alternatives)", "(--dump-bridoc-raw)"]
        ]
      "bridocgen" --> "bridoc-alt"
  
      addNote "bridoc-alt-note"
              ["bridoc-alt"]
              "exponential size,\nbut linear using\n(explicit) sharing"
  
      node "spacing-info" [textLabel $ "Map from BriDoc node\nto spacing info"]
      dataTransformation "getSpacing"
                         "getSpacing/getSpacings"
                         ["bridoc-alt"]
                         ["spacing-info"]
  
      addNote "spacing-info-note" ["spacing-info"] $ Text.Lazy.unlines
        [ "roughly: how much cols/rows"
        , "each Bridoc subtree takes"
        , "in bottom-up fashion"
        ]
  
      node    "bridoc-no-alt"     [textLabel $ "BriDoc without Alts"]
      dataTransformation "transformAlts"
                         "transformAlts"
                         ["bridoc-alt", "spacing-info"]
                         ["bridoc-no-alt"]
  
      edge "config" "transformAlts" [color Gray70, PenWidth 1.0]
  
      addNote "bridocnoaltnote" ["spacing-info", "bridoc-no-alt"] "linear size"
  
      edge "bridocnoaltnote"
           "bridoc-final"
           [Dir NoDir, style dotted, PenWidth 1.0]
  
      node
        "bridoc-final"
        [textLabel $ Text.Lazy.unlines
          ["transformed BriDoc", "(--dump-bridoc-final)"]
        ]
      dataTransformation "otherTransforms"
                         "transformFloating\ntransformColumn\ntransformPar"
                         ["bridoc-no-alt"]
                         ["bridoc-final"]
  
      addNote "otherTransforms-note"
              ["transformAlts", "otherTransforms"]
              "most cpu/memory\nusage happens here"
  
      "bridoc-final" --> "backend"
      edge "annotations" "backend" [color Gray70, PenWidth 1.0]
      edge "config"      "backend" [color Gray70, PenWidth 1.0]
  
      subContext "backend" $ Text.Lazy.unlines
        [ "backend:"
        , "BriDoc -> Text 'rendering'"
        , "in (nested) monadic context"
        , "(additional) State: LayoutState"
        ]
  
      addNote "backendnote" ["backend"] $ Text.Lazy.unlines
        ["'LayoutState' really is", "just the state for", "the backend only."]
  
      "backend" --> "output text fragments"
  
      dataTransformationLabeled
        "outputConcat"
        "output concatenation"
        [("output text fragments", Nothing), ("module header", Just $ "as-is")]
        ["output text"]
  
    bridocgen :: Data.GraphViz.Types.Generalised.DotGraph String
    bridocgen = digraph (Str ("bridocgen")) $ do
  
      -- graphAttrs [Layout Neato]
      nodeAttrs [style filled, color LightGray, shape BoxShape]
      edgeAttrs [color Gray40, PenWidth 2.0]
  
      node "type of node?" [shape DiamondShape, style solid, color Black]
  
      edge "top-level module children" "type of node?" []
  
      dataTransformationLabeled "layoutSig"
                                "layoutSig\n+recursion\n(layoutType etc.)"
                                [("type of node?", Just "type sig")]
                                ["BriDoc (tree/DAG)"]
  
      dataTransformationLabeled "layoutBind"
                                "layoutBind\n+recursion\n(layoutExpr etc.)"
                                [("type of node?", Just "equation")]
                                ["BriDoc (tree/DAG)"]
  
      dataTransformationLabeled "layoutByExact"
                                "layoutByExact"
                                [("type of node?", Just "not handled (yet)")]
                                ["BriDoc (tree/DAG)"]
  
    -- backend :: Data.GraphViz.Types.Generalised.DotGraph String
    -- backend = digraph (Str ("ppm")) $ do
  
  