Build a pretty dependency tree visualizer
This commit is contained in:
		@@ -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"
 | 
			
		||||
            ]
 | 
			
		||||
 
 | 
			
		||||
		Reference in New Issue
	
	Block a user