1 module Symantic.Parser.Grammar.Dump where
3 import Data.Function (($), (.), id)
4 import Data.Semigroup (Semigroup(..))
5 import Data.String (String, IsString(..))
6 import Symantic.Parser.Grammar.Combinators
7 import Symantic.Parser.Grammar.Observations
8 import Text.Show (Show(..))
9 import qualified Control.Applicative as Fct
10 import qualified Data.Tree as Tree
11 import qualified Data.List as List
14 newtype GramDump a = GramDump { unGramDump :: Tree.Tree String }
16 gramDump :: GramDump a -> GramDump a
19 instance Show (GramDump a) where
20 show = drawTree . unGramDump
22 drawTree :: Tree.Tree String -> String
23 drawTree = List.unlines . draw
24 draw :: Tree.Tree String -> [String]
25 draw (Tree.Node x ts0) = List.lines x <> drawSubTrees ts0
28 drawSubTrees [t] = shift "`- " " " (draw t)
29 drawSubTrees (t:ts) = shift "+- " "| " (draw t) <> drawSubTrees ts
30 shift first other = List.zipWith (<>) (first : List.repeat other)
32 instance IsString (GramDump a) where
33 fromString s = GramDump $ Tree.Node (fromString s) []
35 instance Letable GramDump where
36 let_ letRec letName = GramDump $
39 <> (if letRec then "rec " else "")
42 instance Applicable GramDump where
43 _f <$> x = GramDump $ Tree.Node "<$>" [unGramDump x]
44 pure a = GramDump $ Tree.Node ("pure "<>show a) []
45 x <*> y = GramDump $ Tree.Node "<*>" [unGramDump x, unGramDump y]
46 instance Alternable GramDump where
47 empty = GramDump $ Tree.Node "empty" []
48 x <|> y = GramDump $ Tree.Node "<|>" [unGramDump x, unGramDump y]
49 try x = GramDump $ Tree.Node "try" [unGramDump x]
50 instance Charable GramDump where
51 satisfy _p = GramDump $ Tree.Node "satisfy" []
52 instance Selectable GramDump where
53 branch lr l r = GramDump $ Tree.Node "branch"
54 [ unGramDump lr, unGramDump l, unGramDump r ]
55 instance Matchable GramDump where
56 conditional _cs bs a b = GramDump $ Tree.Node "conditional"
57 [ Tree.Node "bs" (unGramDump Fct.<$> bs)
61 instance Lookable GramDump where
62 look x = GramDump $ Tree.Node "look" [unGramDump x]
63 negLook x = GramDump $ Tree.Node "negLook" [unGramDump x]
64 instance Foldable GramDump where
65 chainPre f x = GramDump $ Tree.Node "chainPre" [unGramDump f, unGramDump x]
66 chainPost x f = GramDump $ Tree.Node "chainPost" [unGramDump x, unGramDump f]