From 5b0a6f123659ca9ad148140c1821c3e0dd1081c1 Mon Sep 17 00:00:00 2001
From: "Niels G. W. Serup" <ngws@metanohi.name>
Date: Tue, 24 Sep 2024 22:14:47 +0200
Subject: [PATCH] Build a pretty dependency tree visualizer

---
 byg/byg.cabal               |  2 ++
 byg/src/Main.hs             |  5 ++--
 byg/src/Types/Dependency.hs | 49 ++++++++++++++++++++++++++++++++++++-
 3 files changed, 53 insertions(+), 3 deletions(-)

diff --git a/byg/byg.cabal b/byg/byg.cabal
index 52e19d3..d7da384 100644
--- a/byg/byg.cabal
+++ b/byg/byg.cabal
@@ -32,6 +32,7 @@ library
         base
       , mtl
       , bytestring
+      , text
       , template-haskell
 
 executable byg
@@ -39,5 +40,6 @@ executable byg
     main-is: src/Main.hs
     build-depends:
         base
+      , text
       , template-haskell
       , byg
diff --git a/byg/src/Main.hs b/byg/src/Main.hs
index e0f4992..40ab697 100644
--- a/byg/src/Main.hs
+++ b/byg/src/Main.hs
@@ -1,14 +1,15 @@
 {-# LANGUAGE TemplateHaskell #-}
 module Main where
 
-import Types (Dependency)
+import Types.Dependency (Dependency, formatDependencyTrees)
 import DependencyGenerator (evalDepGenM)
 import SiteGenerator (generateSite)
 
+import qualified Data.Text.IO as T
 import Language.Haskell.TH.Syntax (lift)
 
 dependencies :: [Dependency]
 dependencies = $(lift (evalDepGenM generateSite))
 
 main :: IO ()
-main = mapM_ print dependencies
+main = T.putStr $ formatDependencyTrees dependencies
diff --git a/byg/src/Types/Dependency.hs b/byg/src/Types/Dependency.hs
index 316971e..d188745 100644
--- a/byg/src/Types/Dependency.hs
+++ b/byg/src/Types/Dependency.hs
@@ -1,8 +1,10 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Types.Dependency
   ( Action(..)
   , UToken(..)
   , Dependency(..)
   , makeDependency
+  , formatDependencyTrees
   ) where
 
 import Types.Token (Token(..))
@@ -10,15 +12,18 @@ import Types.Value (Value)
 import Types.Function (Function)
 import Types.FunctionIO (FunctionIO)
 
+import Text.Printf (printf)
+import Data.Text (Text)
+import qualified Data.Text as T
 import Language.Haskell.TH.Syntax (Lift)
 
 data Action = Function Function
             | FunctionIO FunctionIO
             | Inject Value
-            | MapComp [Dependency]
             | FilterComp
             | GetListElem
             | SetListElem
+            | MapComp [Dependency]
   deriving (Show, Lift)
 
 data UToken = UToken Int
@@ -40,3 +45,45 @@ makeUToken = \case
   ZipToken a b -> UZipToken (makeUToken a) (makeUToken b)
   NoToken -> UNoToken
 
+formatDependencyTrees :: [Dependency] -> Text
+formatDependencyTrees = T.concat . (formatDependencyTrees' "")
+  where formatDependencyTrees' indentation = concatMap (formatDependencyTree indentation)
+
+        formatDependencyTree indentation (Dependency a action b) =
+          concat [ [ indentation ]
+                 , formatUToken a
+                 , [ " -> " ]
+                 , formatUToken b
+                 , [ ": " ]
+                 , formatAction indentation action
+                 ]
+
+        formatUToken = \case
+          UToken i ->
+            [ T.pack (printf "%02d" i) ]
+          UTupleToken a b ->
+            concat [ [ "tup(" ]
+                   , formatUToken a
+                   , [ ", " ]
+                   , formatUToken b
+                   , [ ")" ]
+                   ]
+          UZipToken a b ->
+            concat [ [ "zip(" ]
+                   , formatUToken a
+                   , [ ", " ]
+                   , formatUToken b
+                   , [ ")" ]
+                   ]
+          UNoToken ->
+            [ "--" ]
+
+        formatAction indentation = \case
+          MapComp subDeps ->
+            concat [ [ "MapComp:\n" ]
+                   , formatDependencyTrees' (T.append indentation "|  ") subDeps
+                   ]
+          action ->
+            [ T.pack (show action)
+            , "\n"
+            ]