module Symantic.Parser.Grammar.View where

import Data.Bool (Bool)
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 'ViewGrammar'
newtype ViewGrammar (showName::Bool) a = ViewGrammar { forall (showName :: Bool) a. ViewGrammar showName a -> Tree String
unViewGrammar ::
  Tree.Tree String }

viewGrammar :: ViewGrammar sN a -> ViewGrammar sN a
viewGrammar :: forall (sN :: Bool) a. ViewGrammar sN a -> ViewGrammar sN a
viewGrammar = ViewGrammar sN a -> ViewGrammar sN a
forall a. a -> a
id

instance Show (ViewGrammar sN a) where
  show :: ViewGrammar sN a -> String
show = Tree String -> String
drawTree (Tree String -> String)
-> (ViewGrammar sN a -> Tree String) -> ViewGrammar sN a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ViewGrammar sN a -> Tree String
forall (showName :: Bool) a. ViewGrammar showName a -> Tree String
unViewGrammar
    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 (ViewGrammar sN a) where
  fromString :: String -> ViewGrammar sN a
fromString String
s = Tree String -> ViewGrammar sN a
forall (showName :: Bool) a. Tree String -> ViewGrammar showName a
ViewGrammar (Tree String -> ViewGrammar sN a)
-> Tree String -> ViewGrammar sN 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
  ShowLetName sN letName =>
  Letable letName (ViewGrammar sN) where
  def :: forall a. letName -> ViewGrammar sN a -> ViewGrammar sN a
def letName
name ViewGrammar sN a
x = Tree String -> ViewGrammar sN a
forall (showName :: Bool) a. Tree String -> ViewGrammar showName a
ViewGrammar (Tree String -> ViewGrammar sN a)
-> Tree String -> ViewGrammar sN 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
<>forall (showName :: Bool) letName.
ShowLetName showName letName =>
letName -> String
showLetName @sN letName
name) [ViewGrammar sN a -> Tree String
forall (showName :: Bool) a. ViewGrammar showName a -> Tree String
unViewGrammar ViewGrammar sN a
x]
  ref :: forall a. Bool -> letName -> ViewGrammar sN a
ref Bool
rec letName
name = Tree String -> ViewGrammar sN a
forall (showName :: Bool) a. Tree String -> ViewGrammar showName a
ViewGrammar (Tree String -> ViewGrammar sN a)
-> Tree String -> ViewGrammar sN 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
<> forall (showName :: Bool) letName.
ShowLetName showName letName =>
letName -> String
showLetName @sN letName
name
      ) []
instance Applicable (ViewGrammar sN) where
  TermGrammar (a -> b)
_f <$> :: forall a b.
TermGrammar (a -> b) -> ViewGrammar sN a -> ViewGrammar sN b
<$> ViewGrammar sN a
x = Tree String -> ViewGrammar sN b
forall (showName :: Bool) a. Tree String -> ViewGrammar showName a
ViewGrammar (Tree String -> ViewGrammar sN b)
-> Tree String -> ViewGrammar sN b
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"<$>" [ViewGrammar sN a -> Tree String
forall (showName :: Bool) a. ViewGrammar showName a -> Tree String
unViewGrammar ViewGrammar sN a
x]
  pure :: forall a. TermGrammar a -> ViewGrammar sN a
pure TermGrammar a
a = Tree String -> ViewGrammar sN a
forall (showName :: Bool) a. Tree String -> ViewGrammar showName a
ViewGrammar (Tree String -> ViewGrammar sN a)
-> Tree String -> ViewGrammar sN 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 -> TermGrammar a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
10 TermGrammar a
a String
"") []
  ViewGrammar sN (a -> b)
x <*> :: forall a b.
ViewGrammar sN (a -> b) -> ViewGrammar sN a -> ViewGrammar sN b
<*> ViewGrammar sN a
y = Tree String -> ViewGrammar sN b
forall (showName :: Bool) a. Tree String -> ViewGrammar showName a
ViewGrammar (Tree String -> ViewGrammar sN b)
-> Tree String -> ViewGrammar sN b
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"<*>" [ViewGrammar sN (a -> b) -> Tree String
forall (showName :: Bool) a. ViewGrammar showName a -> Tree String
unViewGrammar ViewGrammar sN (a -> b)
x, ViewGrammar sN a -> Tree String
forall (showName :: Bool) a. ViewGrammar showName a -> Tree String
unViewGrammar ViewGrammar sN a
y]
  ViewGrammar sN a
x <* :: forall a b.
ViewGrammar sN a -> ViewGrammar sN b -> ViewGrammar sN a
<* ViewGrammar sN b
y = Tree String -> ViewGrammar sN a
forall (showName :: Bool) a. Tree String -> ViewGrammar showName a
ViewGrammar (Tree String -> ViewGrammar sN a)
-> Tree String -> ViewGrammar sN a
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"<*" [ViewGrammar sN a -> Tree String
forall (showName :: Bool) a. ViewGrammar showName a -> Tree String
unViewGrammar ViewGrammar sN a
x, ViewGrammar sN b -> Tree String
forall (showName :: Bool) a. ViewGrammar showName a -> Tree String
unViewGrammar ViewGrammar sN b
y]
  ViewGrammar sN a
x *> :: forall a b.
ViewGrammar sN a -> ViewGrammar sN b -> ViewGrammar sN b
*> ViewGrammar sN b
y = Tree String -> ViewGrammar sN b
forall (showName :: Bool) a. Tree String -> ViewGrammar showName a
ViewGrammar (Tree String -> ViewGrammar sN b)
-> Tree String -> ViewGrammar sN b
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"*>" [ViewGrammar sN a -> Tree String
forall (showName :: Bool) a. ViewGrammar showName a -> Tree String
unViewGrammar ViewGrammar sN a
x, ViewGrammar sN b -> Tree String
forall (showName :: Bool) a. ViewGrammar showName a -> Tree String
unViewGrammar ViewGrammar sN b
y]
instance Alternable (ViewGrammar sN) where
  empty :: forall a. ViewGrammar sN a
empty = Tree String -> ViewGrammar sN a
forall (showName :: Bool) a. Tree String -> ViewGrammar showName a
ViewGrammar (Tree String -> ViewGrammar sN a)
-> Tree String -> ViewGrammar sN a
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"empty" []
  ViewGrammar sN a
x <|> :: forall a. ViewGrammar sN a -> ViewGrammar sN a -> ViewGrammar sN a
<|> ViewGrammar sN a
y = Tree String -> ViewGrammar sN a
forall (showName :: Bool) a. Tree String -> ViewGrammar showName a
ViewGrammar (Tree String -> ViewGrammar sN a)
-> Tree String -> ViewGrammar sN a
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"<|>" [ViewGrammar sN a -> Tree String
forall (showName :: Bool) a. ViewGrammar showName a -> Tree String
unViewGrammar ViewGrammar sN a
x, ViewGrammar sN a -> Tree String
forall (showName :: Bool) a. ViewGrammar showName a -> Tree String
unViewGrammar ViewGrammar sN a
y]
  try :: forall a. ViewGrammar sN a -> ViewGrammar sN a
try ViewGrammar sN a
x = Tree String -> ViewGrammar sN a
forall (showName :: Bool) a. Tree String -> ViewGrammar showName a
ViewGrammar (Tree String -> ViewGrammar sN a)
-> Tree String -> ViewGrammar sN a
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"try" [ViewGrammar sN a -> Tree String
forall (showName :: Bool) a. ViewGrammar showName a -> Tree String
unViewGrammar ViewGrammar sN a
x]
instance Satisfiable tok (ViewGrammar sN) where
  satisfy :: [ErrorItem tok] -> TermGrammar (tok -> Bool) -> ViewGrammar sN tok
satisfy [ErrorItem tok]
_es TermGrammar (tok -> Bool)
_p = Tree String -> ViewGrammar sN tok
forall (showName :: Bool) a. Tree String -> ViewGrammar showName a
ViewGrammar (Tree String -> ViewGrammar sN tok)
-> Tree String -> ViewGrammar sN 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 (ViewGrammar sN) where
  branch :: forall a b c.
ViewGrammar sN (Either a b)
-> ViewGrammar sN (a -> c)
-> ViewGrammar sN (b -> c)
-> ViewGrammar sN c
branch ViewGrammar sN (Either a b)
lr ViewGrammar sN (a -> c)
l ViewGrammar sN (b -> c)
r = Tree String -> ViewGrammar sN c
forall (showName :: Bool) a. Tree String -> ViewGrammar showName a
ViewGrammar (Tree String -> ViewGrammar sN c)
-> Tree String -> ViewGrammar sN c
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"branch"
    [ ViewGrammar sN (Either a b) -> Tree String
forall (showName :: Bool) a. ViewGrammar showName a -> Tree String
unViewGrammar ViewGrammar sN (Either a b)
lr, ViewGrammar sN (a -> c) -> Tree String
forall (showName :: Bool) a. ViewGrammar showName a -> Tree String
unViewGrammar ViewGrammar sN (a -> c)
l, ViewGrammar sN (b -> c) -> Tree String
forall (showName :: Bool) a. ViewGrammar showName a -> Tree String
unViewGrammar ViewGrammar sN (b -> c)
r ]
instance Matchable (ViewGrammar sN) where
  conditional :: forall a b.
Eq a =>
ViewGrammar sN a
-> [TermGrammar (a -> Bool)]
-> [ViewGrammar sN b]
-> ViewGrammar sN b
-> ViewGrammar sN b
conditional ViewGrammar sN a
a [TermGrammar (a -> Bool)]
_ps [ViewGrammar sN b]
bs ViewGrammar sN b
b = Tree String -> ViewGrammar sN b
forall (showName :: Bool) a. Tree String -> ViewGrammar showName a
ViewGrammar (Tree String -> ViewGrammar sN b)
-> Tree String -> ViewGrammar sN b
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"conditional"
    [ ViewGrammar sN a -> Tree String
forall (showName :: Bool) a. ViewGrammar showName a -> Tree String
unViewGrammar ViewGrammar sN a
a
    , String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"bs" (ViewGrammar sN b -> Tree String
forall (showName :: Bool) a. ViewGrammar showName a -> Tree String
unViewGrammar (ViewGrammar sN b -> Tree String)
-> [ViewGrammar sN b] -> Forest String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Fct.<$> [ViewGrammar sN b]
bs)
    , ViewGrammar sN b -> Tree String
forall (showName :: Bool) a. ViewGrammar showName a -> Tree String
unViewGrammar ViewGrammar sN b
b
    ]
instance Lookable (ViewGrammar sN) where
  look :: forall a. ViewGrammar sN a -> ViewGrammar sN a
look ViewGrammar sN a
x = Tree String -> ViewGrammar sN a
forall (showName :: Bool) a. Tree String -> ViewGrammar showName a
ViewGrammar (Tree String -> ViewGrammar sN a)
-> Tree String -> ViewGrammar sN a
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"look" [ViewGrammar sN a -> Tree String
forall (showName :: Bool) a. ViewGrammar showName a -> Tree String
unViewGrammar ViewGrammar sN a
x]
  negLook :: forall a. ViewGrammar sN a -> ViewGrammar sN ()
negLook ViewGrammar sN a
x = Tree String -> ViewGrammar sN ()
forall (showName :: Bool) a. Tree String -> ViewGrammar showName a
ViewGrammar (Tree String -> ViewGrammar sN ())
-> Tree String -> ViewGrammar sN ()
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"negLook" [ViewGrammar sN a -> Tree String
forall (showName :: Bool) a. ViewGrammar showName a -> Tree String
unViewGrammar ViewGrammar sN a
x]
  eof :: ViewGrammar sN ()
eof = Tree String -> ViewGrammar sN ()
forall (showName :: Bool) a. Tree String -> ViewGrammar showName a
ViewGrammar (Tree String -> ViewGrammar sN ())
-> Tree String -> ViewGrammar sN ()
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 (ViewGrammar sN) where
  chainPre :: forall a.
ViewGrammar sN (a -> a) -> ViewGrammar sN a -> ViewGrammar sN a
chainPre ViewGrammar sN (a -> a)
f ViewGrammar sN a
x = Tree String -> ViewGrammar sN a
forall (showName :: Bool) a. Tree String -> ViewGrammar showName a
ViewGrammar (Tree String -> ViewGrammar sN a)
-> Tree String -> ViewGrammar sN a
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"chainPre" [ViewGrammar sN (a -> a) -> Tree String
forall (showName :: Bool) a. ViewGrammar showName a -> Tree String
unViewGrammar ViewGrammar sN (a -> a)
f, ViewGrammar sN a -> Tree String
forall (showName :: Bool) a. ViewGrammar showName a -> Tree String
unViewGrammar ViewGrammar sN a
x]
  chainPost :: forall a.
ViewGrammar sN a -> ViewGrammar sN (a -> a) -> ViewGrammar sN a
chainPost ViewGrammar sN a
x ViewGrammar sN (a -> a)
f = Tree String -> ViewGrammar sN a
forall (showName :: Bool) a. Tree String -> ViewGrammar showName a
ViewGrammar (Tree String -> ViewGrammar sN a)
-> Tree String -> ViewGrammar sN a
forall a b. (a -> b) -> a -> b
$ String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"chainPost" [ViewGrammar sN a -> Tree String
forall (showName :: Bool) a. ViewGrammar showName a -> Tree String
unViewGrammar ViewGrammar sN a
x, ViewGrammar sN (a -> a) -> Tree String
forall (showName :: Bool) a. ViewGrammar showName a -> Tree String
unViewGrammar ViewGrammar sN (a -> a)
f]