Build a pretty dependency tree visualizer
This commit is contained in:
parent
ad3bba2d1a
commit
5b0a6f1236
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"
|
||||
]
|
||||
|
|
Loading…
Reference in New Issue