gdritter repos apicius / 508ff34
Working-but-incomplete DOT output Getty Ritter 8 years ago
1 changed file(s) with 35 addition(s) and 5 deletion(s). Collapse all Expand all
+35
-5
src/Main.hs less more
1 {-# LANGUAGE ParallelListComp #-}
2
13 module Main where
24
35 import Data.List (intercalate)
9597 where go n (ReverseGraph t rs) =
9698 indent n ++ stepName t ++ "\n" ++ concat (map (go (n+2)) rs)
9799 indent n = replicate n ' '
98 stepName (Right t) = T.unpack t
99 stepName (Left (IngredientList is)) =
100 intercalate "; " [ ingName i | i <- is ]
101 ingName (Ingredient (Just amt) name) =
100
101 stepName :: Either IngredientList Text -> String
102 stepName (Right t) = T.unpack t
103 stepName (Left (IngredientList is)) =
104 intercalate "; " [ ingName i | i <- is ]
105 where ingName (Ingredient (Just amt) name) =
102106 T.unpack amt ++ " " ++ T.unpack name
103107 ingName (Ingredient Nothing name) =
104108 T.unpack name
105109
110 stepMeta :: Either IngredientList Text -> String
111 stepMeta (Right t) = " [label=\"" ++ T.unpack t ++ "\",color=red]"
112 stepMeta (Left (IngredientList is)) =
113 " [label=\"" ++ intercalate "; " [ ingName i | i <- is ] ++ "\"]"
114 where ingName (Ingredient (Just amt) name) =
115 T.unpack amt ++ " " ++ T.unpack name
116 ingName (Ingredient Nothing name) =
117 T.unpack name
118
119 dotGraph :: Text -> ReverseGraph -> String
120 dotGraph rname gr = ("digraph \"" ++ T.unpack rname ++ "\" {\n") ++ unlines (go "n" 0 gr) ++ "\n}"
121 where go :: String -> Int -> ReverseGraph -> [String]
122 go parent n (ReverseGraph t rs) =
123 let name = parent ++ "_" ++ show n
124 children = [ (i, name ++ "_" ++ show i, r)
125 | i <- [0..]
126 | r <- rs
127 ]
128 in [ " " ++ name ++ stepMeta t ] ++
129 [ " " ++ cname ++ " -> " ++ name ++ ";"
130 | (_, cname, _) <- children
131 ] ++
132 concat [ go name i r
133 | (i, _, r) <- children
134 ]
135
106136 showRecipeGraph :: Recipe -> String
107 showRecipeGraph = prettyGraph . buildReverseGraph . getChunks
137 showRecipeGraph r@(Recipe name _) = dotGraph name . buildReverseGraph . getChunks $ r