gdritter repos apicius / cf70b61
Early explorations into building a reverse tree from the recipe Getty Ritter 7 years ago
1 changed file(s) with 100 addition(s) and 1 deletion(s). Collapse all Expand all
+100
-1
src/Main.hs less more
11 module Main where
22
3 import Data.List (intercalate)
4 import qualified Data.Text as T
5 import Data.Text (Text)
6
7 import AST
38 import Parser (parseFile)
49
510 main :: IO ()
611 main = do
712 cs <- getContents
8 print (parseFile "[stdin]" cs)
13 case parseFile "[stdin]" cs of
14 Left err -> putStrLn err
15 Right recipes ->
16 putStrLn (unlines (map showRecipeGraph recipes))
17
18 -- An 'ActionChunk' represents a set of actions in between two join
19 -- points. This is 'reversed' from what we'd expect: the 'name' is
20 -- actually the name of the join point at the end of a sequence of
21 -- actions, or the string DONE, while the 'prev' is the name of the
22 -- join point that came at the beginning, or the ingredients list
23 -- that started the rule. The actions also will appear in reverse
24 -- order.
25
26 -- Maybe an explanation is in order: this rule
27 -- ingredients -> a -> $x -> b -> c -> $y;
28 -- will produce two ActionChunks:
29 -- ActionChunk $y [c, b] (Right $x)
30 -- and
31 -- ActionChunk $x [a] (Left ingredients)
32 data ActionChunk = ActionChunk
33 { acName :: Text
34 , acRules :: [Text]
35 , acPrev :: Either IngredientList Text
36 } deriving (Eq, Show)
37
38 -- This is the function that actually splits apart the action into
39 -- ActionChunks. It's grosser than I'd hoped, but it's mostly a lot
40 -- of fiddly but straightforward traversing.
41 splitApart :: Either IngredientList Text -> [Action] -> [ActionChunk]
42 splitApart i = toChunk [] . reverse
43 where toChunk cs (Join t:xs) =
44 gather t xs [] cs
45 toChunk cs (Action "DONE" _:xs) =
46 gather "DONE" xs [] cs
47 toChunk cs (Done:xs) =
48 gather "DONE" xs [] cs
49 toChunk _ (Action _ _:_) =
50 error "expected chunk to end with a join or DONE"
51 toChunk cs [] = cs
52 gather n xs@(Join t:_) as cs =
53 toChunk (ActionChunk n (reverse as) (Right t) : cs) xs
54 gather n (Action t _:xs) as cs =
55 gather n xs (t:as) cs
56 gather _ (Done:_) _ _ =
57 error "unsure how to handle this case"
58 gather n [] as cs =
59 ActionChunk n (reverse as) i : cs
60
61 -- Here we take a recipe and pull all the ActionChunks into a single
62 -- list.
63 getChunks :: Recipe -> [ActionChunk]
64 getChunks Recipe { rRecipe = st } =
65 mconcat (map getActions st)
66 where getActions (Step (InpJoin t) as) = splitApart (Right t) as
67 getActions (Step (InpIngredients is) as) = splitApart (Left is) as
68
69 -- The ReverseGraph is a tree rooted at the DONE node. The 'children'
70 -- are actually the steps leading up to a given node. Only childless
71 -- nodes should have an IngredientList associated with them, but we
72 -- don't encode this invariant in the type.
73 data ReverseGraph = ReverseGraph
74 { rStep :: Either IngredientList Text
75 , rPrevs :: [ReverseGraph]
76 } deriving (Eq, Show)
77
78 -- Take a list of ActionChunks and stitch them back together so that
79 -- we can build a ReverseGraph of them. Again, fiddly but straightforward
80 -- traversing of the data structures.
81 buildReverseGraph :: [ActionChunk] -> ReverseGraph
82 buildReverseGraph as = ReverseGraph (Right "DONE")
83 (concat (map buildFrom (findChunks "DONE")))
84 where findChunks n = [ chunk | chunk <- as, acName chunk == n ]
85 buildFrom (ActionChunk _ rs p) = go rs p
86 go [] (Right p) = concat $ map buildFrom (findChunks p)
87 go [] (Left i) = [ReverseGraph (Left i) []]
88 go (r:rs) p = [ReverseGraph (Right r) (go rs p)]
89
90 -- Prettily convert a ReverseGraph to a readable tree. This will give
91 -- us a recipe tree in reverse order, starting with the DONE, and
92 -- gradually going back to the ingredients.
93 prettyGraph :: ReverseGraph -> String
94 prettyGraph = go 0
95 where go n (ReverseGraph t rs) =
96 indent n ++ stepName t ++ "\n" ++ concat (map (go (n+2)) rs)
97 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) =
102 T.unpack amt ++ " " ++ T.unpack name
103 ingName (Ingredient Nothing name) =
104 T.unpack name
105
106 showRecipeGraph :: Recipe -> String
107 showRecipeGraph = prettyGraph . buildReverseGraph . getChunks