Build a pretty dependency tree visualizer
This commit is contained in:
		
							parent
							
								
									ad3bba2d1a
								
							
						
					
					
						commit
						5b0a6f1236
					
				| @ -32,6 +32,7 @@ library | |||||||
|         base |         base | ||||||
|       , mtl |       , mtl | ||||||
|       , bytestring |       , bytestring | ||||||
|  |       , text | ||||||
|       , template-haskell |       , template-haskell | ||||||
| 
 | 
 | ||||||
| executable byg | executable byg | ||||||
| @ -39,5 +40,6 @@ executable byg | |||||||
|     main-is: src/Main.hs |     main-is: src/Main.hs | ||||||
|     build-depends: |     build-depends: | ||||||
|         base |         base | ||||||
|  |       , text | ||||||
|       , template-haskell |       , template-haskell | ||||||
|       , byg |       , byg | ||||||
|  | |||||||
| @ -1,14 +1,15 @@ | |||||||
| {-# LANGUAGE TemplateHaskell #-} | {-# LANGUAGE TemplateHaskell #-} | ||||||
| module Main where | module Main where | ||||||
| 
 | 
 | ||||||
| import Types (Dependency) | import Types.Dependency (Dependency, formatDependencyTrees) | ||||||
| import DependencyGenerator (evalDepGenM) | import DependencyGenerator (evalDepGenM) | ||||||
| import SiteGenerator (generateSite) | import SiteGenerator (generateSite) | ||||||
| 
 | 
 | ||||||
|  | import qualified Data.Text.IO as T | ||||||
| import Language.Haskell.TH.Syntax (lift) | import Language.Haskell.TH.Syntax (lift) | ||||||
| 
 | 
 | ||||||
| dependencies :: [Dependency] | dependencies :: [Dependency] | ||||||
| dependencies = $(lift (evalDepGenM generateSite)) | dependencies = $(lift (evalDepGenM generateSite)) | ||||||
| 
 | 
 | ||||||
| main :: IO () | main :: IO () | ||||||
| main = mapM_ print dependencies | main = T.putStr $ formatDependencyTrees dependencies | ||||||
|  | |||||||
| @ -1,8 +1,10 @@ | |||||||
|  | {-# LANGUAGE OverloadedStrings #-} | ||||||
| module Types.Dependency | module Types.Dependency | ||||||
|   ( Action(..) |   ( Action(..) | ||||||
|   , UToken(..) |   , UToken(..) | ||||||
|   , Dependency(..) |   , Dependency(..) | ||||||
|   , makeDependency |   , makeDependency | ||||||
|  |   , formatDependencyTrees | ||||||
|   ) where |   ) where | ||||||
| 
 | 
 | ||||||
| import Types.Token (Token(..)) | import Types.Token (Token(..)) | ||||||
| @ -10,15 +12,18 @@ import Types.Value (Value) | |||||||
| import Types.Function (Function) | import Types.Function (Function) | ||||||
| import Types.FunctionIO (FunctionIO) | import Types.FunctionIO (FunctionIO) | ||||||
| 
 | 
 | ||||||
|  | import Text.Printf (printf) | ||||||
|  | import Data.Text (Text) | ||||||
|  | import qualified Data.Text as T | ||||||
| import Language.Haskell.TH.Syntax (Lift) | import Language.Haskell.TH.Syntax (Lift) | ||||||
| 
 | 
 | ||||||
| data Action = Function Function | data Action = Function Function | ||||||
|             | FunctionIO FunctionIO |             | FunctionIO FunctionIO | ||||||
|             | Inject Value |             | Inject Value | ||||||
|             | MapComp [Dependency] |  | ||||||
|             | FilterComp |             | FilterComp | ||||||
|             | GetListElem |             | GetListElem | ||||||
|             | SetListElem |             | SetListElem | ||||||
|  |             | MapComp [Dependency] | ||||||
|   deriving (Show, Lift) |   deriving (Show, Lift) | ||||||
| 
 | 
 | ||||||
| data UToken = UToken Int | data UToken = UToken Int | ||||||
| @ -40,3 +45,45 @@ makeUToken = \case | |||||||
|   ZipToken a b -> UZipToken (makeUToken a) (makeUToken b) |   ZipToken a b -> UZipToken (makeUToken a) (makeUToken b) | ||||||
|   NoToken -> UNoToken |   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…
	
	
			
			x
			
			
		
	
		Reference in New Issue
	
	Block a user