Build a pretty dependency tree visualizer

This commit is contained in:
Niels G. W. Serup 2024-09-24 22:14:47 +02:00
parent ad3bba2d1a
commit 5b0a6f1236
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
3 changed files with 53 additions and 3 deletions

View File

@ -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

View File

@ -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

View File

@ -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"
]