module Symantic.Parser.Grammar.Dump where
import Data.Function (($), (.), id)
import Data.Semigroup (Semigroup(..))
import Data.String (String, IsString(..))
import Text.Show (Show(..))
import qualified Control.Applicative as Fct
import qualified Data.Tree as Tree
import qualified Data.List as List
import Symantic.Univariant.Letable
import Symantic.Parser.Grammar.Combinators
newtype DumpComb a = DumpComb { forall a. DumpComb a -> Tree String
unDumpComb :: Tree.Tree String }
dumpComb :: DumpComb a -> DumpComb a
dumpComb :: forall a. DumpComb a -> DumpComb a
dumpComb = DumpComb a -> DumpComb a
forall a. a -> a
id
instance Show (DumpComb a) where
show :: DumpComb a -> String
show = Tree String -> String
drawTree (Tree String -> String)
-> (DumpComb a -> Tree String) -> DumpComb a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DumpComb a -> Tree String
forall a. DumpComb a -> Tree String
unDumpComb
where
drawTree :: Tree.Tree String -> String
drawTree :: Tree String -> String
drawTree = [String] -> String
List.unlines ([String] -> String)
-> (Tree String -> [String]) -> Tree String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree String -> [String]
draw
draw :: Tree.Tree String -> [String]
draw :: Tree String -> [String]
draw (Tree.Node String
x Forest String
ts0) = String -> [String]
List.lines String
x [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> Forest String -> [String]
drawSubTrees Forest String
ts0
where
drawSubTrees :: Forest String -> [String]
drawSubTrees [] = []
drawSubTrees [Tree String
t] = String -> String -> [String] -> [String]
forall {c}. Semigroup c => c -> c -> [c] -> [c]
shift String
"` " String
" " (Tree String -> [String]
draw Tree String
t)
drawSubTrees (Tree String
t:Forest String
ts) = String -> String -> [String] -> [String]
forall {c}. Semigroup c => c -> c -> [c] -> [c]
shift String
"+ " String
"| " (Tree String -> [String]
draw Tree String
t) [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> Forest String -> [String]
drawSubTrees Forest String
ts
shift :: c -> c -> [c] -> [c]
shift c
first c
other = (c -> c -> c) -> [c] -> [c] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
List.zipWith c -> c -> c
forall a. Semigroup a => a -> a -> a
(<>) (c
first c -> [c] -> [c]
forall a. a -> [a] -> [a]
: c -> [c]
forall a. a -> [a]
List.repeat c
other)
instance IsString (DumpComb a) where
fromString :: String -> DumpComb a
fromString String
s = Tree String -> DumpComb a
forall a. Tree String -> DumpComb a
DumpComb (Tree String -> DumpComb a) -> Tree String -> DumpComb a
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node (ShowS
forall a. IsString a => String -> a
fromString String
s) []
instance Show letName => Letable letName DumpComb where
def :: forall a. letName -> DumpComb a -> DumpComb a
def letName
name DumpComb a
x = Tree String -> DumpComb a
forall a. Tree String -> DumpComb a
DumpComb (Tree String -> DumpComb a) -> Tree String -> DumpComb a
forall a b. (a -> b) -> a -> b
$
String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node (String
"def "String -> ShowS
forall a. Semigroup a => a -> a -> a
<>letName -> String
forall a. Show a => a -> String
show letName
name) [DumpComb a -> Tree String
forall a. DumpComb a -> Tree String
unDumpComb DumpComb a
x]
ref :: forall a. Bool -> letName -> DumpComb a
ref Bool
rec letName
name = Tree String -> DumpComb a
forall a. Tree String -> DumpComb a
DumpComb (Tree String -> DumpComb a) -> Tree String -> DumpComb a
forall a b. (a -> b) -> a -> b
$
String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node
( (if Bool
rec then String
"rec " else String
"ref ")
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> letName -> String
forall a. Show a => a -> String
show letName
name
) []
instance Applicable DumpComb where
Haskell (a -> b)
_f <$> :: forall a b. Haskell (a -> b) -> DumpComb a -> DumpComb b
<$> DumpComb a
x = Tree String -> DumpComb b
forall a. Tree String -> DumpComb a
DumpComb (Tree String -> DumpComb b) -> Tree String -> DumpComb b
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"<$>" [DumpComb a -> Tree String
forall a. DumpComb a -> Tree String
unDumpComb DumpComb a
x]
pure :: forall a. Haskell a -> DumpComb a
pure Haskell a
a = Tree String -> DumpComb a
forall a. Tree String -> DumpComb a
DumpComb (Tree String -> DumpComb a) -> Tree String -> DumpComb a
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node (String
"pure "String -> ShowS
forall a. Semigroup a => a -> a -> a
<>Int -> Haskell a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
10 Haskell a
a String
"") []
DumpComb (a -> b)
x <*> :: forall a b. DumpComb (a -> b) -> DumpComb a -> DumpComb b
<*> DumpComb a
y = Tree String -> DumpComb b
forall a. Tree String -> DumpComb a
DumpComb (Tree String -> DumpComb b) -> Tree String -> DumpComb b
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"<*>" [DumpComb (a -> b) -> Tree String
forall a. DumpComb a -> Tree String
unDumpComb DumpComb (a -> b)
x, DumpComb a -> Tree String
forall a. DumpComb a -> Tree String
unDumpComb DumpComb a
y]
instance Alternable DumpComb where
empty :: forall a. DumpComb a
empty = Tree String -> DumpComb a
forall a. Tree String -> DumpComb a
DumpComb (Tree String -> DumpComb a) -> Tree String -> DumpComb a
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"empty" []
DumpComb a
x <|> :: forall a. DumpComb a -> DumpComb a -> DumpComb a
<|> DumpComb a
y = Tree String -> DumpComb a
forall a. Tree String -> DumpComb a
DumpComb (Tree String -> DumpComb a) -> Tree String -> DumpComb a
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"<|>" [DumpComb a -> Tree String
forall a. DumpComb a -> Tree String
unDumpComb DumpComb a
x, DumpComb a -> Tree String
forall a. DumpComb a -> Tree String
unDumpComb DumpComb a
y]
try :: forall a. DumpComb a -> DumpComb a
try DumpComb a
x = Tree String -> DumpComb a
forall a. Tree String -> DumpComb a
DumpComb (Tree String -> DumpComb a) -> Tree String -> DumpComb a
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"try" [DumpComb a -> Tree String
forall a. DumpComb a -> Tree String
unDumpComb DumpComb a
x]
instance Satisfiable DumpComb tok where
satisfy :: [ErrorItem tok] -> Haskell (tok -> Bool) -> DumpComb tok
satisfy [ErrorItem tok]
_es Haskell (tok -> Bool)
_p = Tree String -> DumpComb tok
forall a. Tree String -> DumpComb a
DumpComb (Tree String -> DumpComb tok) -> Tree String -> DumpComb tok
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"satisfy" []
instance Selectable DumpComb where
branch :: forall a b c.
DumpComb (Either a b)
-> DumpComb (a -> c) -> DumpComb (b -> c) -> DumpComb c
branch DumpComb (Either a b)
lr DumpComb (a -> c)
l DumpComb (b -> c)
r = Tree String -> DumpComb c
forall a. Tree String -> DumpComb a
DumpComb (Tree String -> DumpComb c) -> Tree String -> DumpComb c
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"branch"
[ DumpComb (Either a b) -> Tree String
forall a. DumpComb a -> Tree String
unDumpComb DumpComb (Either a b)
lr, DumpComb (a -> c) -> Tree String
forall a. DumpComb a -> Tree String
unDumpComb DumpComb (a -> c)
l, DumpComb (b -> c) -> Tree String
forall a. DumpComb a -> Tree String
unDumpComb DumpComb (b -> c)
r ]
instance Matchable DumpComb where
conditional :: forall a b.
Eq a =>
[Haskell (a -> Bool)]
-> [DumpComb b] -> DumpComb a -> DumpComb b -> DumpComb b
conditional [Haskell (a -> Bool)]
_cs [DumpComb b]
bs DumpComb a
a DumpComb b
b = Tree String -> DumpComb b
forall a. Tree String -> DumpComb a
DumpComb (Tree String -> DumpComb b) -> Tree String -> DumpComb b
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"conditional"
[ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"bs" (DumpComb b -> Tree String
forall a. DumpComb a -> Tree String
unDumpComb (DumpComb b -> Tree String) -> [DumpComb b] -> Forest String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Fct.<$> [DumpComb b]
bs)
, DumpComb a -> Tree String
forall a. DumpComb a -> Tree String
unDumpComb DumpComb a
a
, DumpComb b -> Tree String
forall a. DumpComb a -> Tree String
unDumpComb DumpComb b
b
]
instance Lookable DumpComb where
look :: forall a. DumpComb a -> DumpComb a
look DumpComb a
x = Tree String -> DumpComb a
forall a. Tree String -> DumpComb a
DumpComb (Tree String -> DumpComb a) -> Tree String -> DumpComb a
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"look" [DumpComb a -> Tree String
forall a. DumpComb a -> Tree String
unDumpComb DumpComb a
x]
negLook :: forall a. DumpComb a -> DumpComb ()
negLook DumpComb a
x = Tree String -> DumpComb ()
forall a. Tree String -> DumpComb a
DumpComb (Tree String -> DumpComb ()) -> Tree String -> DumpComb ()
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"negLook" [DumpComb a -> Tree String
forall a. DumpComb a -> Tree String
unDumpComb DumpComb a
x]
eof :: DumpComb ()
eof = Tree String -> DumpComb ()
forall a. Tree String -> DumpComb a
DumpComb (Tree String -> DumpComb ()) -> Tree String -> DumpComb ()
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"eof" []
instance Foldable DumpComb where
chainPre :: forall a. DumpComb (a -> a) -> DumpComb a -> DumpComb a
chainPre DumpComb (a -> a)
f DumpComb a
x = Tree String -> DumpComb a
forall a. Tree String -> DumpComb a
DumpComb (Tree String -> DumpComb a) -> Tree String -> DumpComb a
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"chainPre" [DumpComb (a -> a) -> Tree String
forall a. DumpComb a -> Tree String
unDumpComb DumpComb (a -> a)
f, DumpComb a -> Tree String
forall a. DumpComb a -> Tree String
unDumpComb DumpComb a
x]
chainPost :: forall a. DumpComb a -> DumpComb (a -> a) -> DumpComb a
chainPost DumpComb a
x DumpComb (a -> a)
f = Tree String -> DumpComb a
forall a. Tree String -> DumpComb a
DumpComb (Tree String -> DumpComb a) -> Tree String -> DumpComb a
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"chainPost" [DumpComb a -> Tree String
forall a. DumpComb a -> Tree String
unDumpComb DumpComb a
x, DumpComb (a -> a) -> Tree String
forall a. DumpComb a -> Tree String
unDumpComb DumpComb (a -> a)
f]