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

-- * Type 'DumpComb'
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]