symantic-parser-0.2.1.20210803: tests/Grammar.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}
module Grammar where
import Data.Char (Char)
import Data.Function (($))
import Data.String (String)
import Text.Show (Show(..))
import qualified Data.Functor as Functor
import qualified Parsers.Nandlang
import qualified Parsers.Brainfuck.SymanticParser.Grammar
import qualified Language.Haskell.TH.Syntax as TH

import Symantic.Parser

rawGrammars :: Grammarable Char repr => [ObserveSharing TH.Name repr String]
rawGrammars =
  [ production show [||show||] <$> g1
  , production show [||show||] <$> g2
  , production show [||show||] <$> g3
  , production show [||show||] <$> g4
  , production show [||show||] <$> g5
  , production show [||show||] <$> g6
  , production show [||show||] <$> g7
  , production show [||show||] <$> g8
  , production show [||show||] <$> g9
  , production show [||show||] <$> g10
  , production show [||show||] <$> g11
  , production show [||show||] <$> g12
  , production show [||show||] <$> g13
  , production show [||show||] <$> g14
  , production show [||show||] <$> g15
  , production show [||show||] <$> g16
  , production show [||show||] <$> g17
  , production show [||show||] <$> g18
  , production show [||show||] <$> g19
  , production show [||show||] <$> g20
  ]
grammars :: Grammarable Char repr => [repr String]
grammars = (Functor.<$> rawGrammars) $ \g ->
  observeSharing g

g1 = char 'a'
g2 = string "abc"
g3 = many (char 'a')
g4 = some (string "abcd")
g5 = some (string "abcd") <* eof
g6 = traverse char "aa" <|> traverse char "ab"
g7 = string "aa" <|> string "ab"
g8 = many (char 'r') <* eof
g9 = eof
g10 = char 'a' <|> char 'b'
g11 = many (char 'a') <* char 'b'
g12 = many (oneOf ['a', 'b', 'c', 'd']) <* eof
g13 = Parsers.Brainfuck.SymanticParser.Grammar.grammar @Char @_
g14 = Parsers.Nandlang.grammar
g15 = (char 'a' <|> char 'b') <* char 'c'
g16 = (char 'a' <|> char 'b' <|> char 'c') <* char 'd'
g17 ::
  CombApplicable repr =>
  CombSatisfiable Char repr =>
  CombRegisterableUnscoped repr =>
  Referenceable TH.Name repr =>
  ObserveSharing TH.Name repr (Char, Char)
g17 = bind (item @Char) (\pc -> production (,) [||(,)||] <$> pc <*> pc)
g18 = string "abc" <|> string "de"
g19 = (string "abc" <|> string "de") <|> string "fghi"
g20 = (tokens "abc" <|> tokens "") *> void (tokens "def")