tests/Grammar.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 {-# LANGUAGE NoMonomorphismRestriction #-}
   3 {-# LANGUAGE TypeApplications #-}
   4 {-# LANGUAGE TypeFamilies #-}
   5 {-# LANGUAGE TemplateHaskell #-}
   6 {-# OPTIONS_GHC -Wno-missing-signatures #-}
   7 module Grammar where
   8 import Data.Char (Char)
   9 import Data.Function (($))
  10 import Data.String (String)
  11 import Text.Show (Show(..))
  12 import qualified Data.Functor as Functor
  13 import qualified Parsers.Nandlang
  14 import qualified Parsers.Brainfuck.SymanticParser.Grammar
  15 import qualified Language.Haskell.TH.Syntax as TH
  16
  17 import Symantic.Parser
  18
  19 rawGrammars :: Grammarable Char repr => [ObserveSharing TH.Name repr String]
  20 rawGrammars =
  21   [ production show [||show||] <$> g1
  22   , production show [||show||] <$> g2
  23   , production show [||show||] <$> g3
  24   , production show [||show||] <$> g4
  25   , production show [||show||] <$> g5
  26   , production show [||show||] <$> g6
  27   , production show [||show||] <$> g7
  28   , production show [||show||] <$> g8
  29   , production show [||show||] <$> g9
  30   , production show [||show||] <$> g10
  31   , production show [||show||] <$> g11
  32   , production show [||show||] <$> g12
  33   , production show [||show||] <$> g13
  34   , production show [||show||] <$> g14
  35   , production show [||show||] <$> g15
  36   , production show [||show||] <$> g16
  37   , production show [||show||] <$> g17
  38   , production show [||show||] <$> g18
  39   , production show [||show||] <$> g19
  40   , production show [||show||] <$> g20
  41   ]
  42 grammars :: Grammarable Char repr => [repr String]
  43 grammars = (Functor.<$> rawGrammars) $ \g ->
  44   observeSharing g
  45
  46 g1 = char 'a'
  47 g2 = string "abc"
  48 g3 = many (char 'a')
  49 g4 = some (string "abcd")
  50 g5 = some (string "abcd") <* eof
  51 g6 = traverse char "aa" <|> traverse char "ab"
  52 g7 = string "aa" <|> string "ab"
  53 g8 = many (char 'r') <* eof
  54 g9 = eof
  55 g10 = char 'a' <|> char 'b'
  56 g11 = many (char 'a') <* char 'b'
  57 g12 = many (oneOf ['a', 'b', 'c', 'd']) <* eof
  58 g13 = Parsers.Brainfuck.SymanticParser.Grammar.grammar @Char @_
  59 g14 = Parsers.Nandlang.grammar
  60 g15 = (char 'a' <|> char 'b') <* char 'c'
  61 g16 = (char 'a' <|> char 'b' <|> char 'c') <* char 'd'
  62 g17 ::
  63   CombApplicable repr =>
  64   CombSatisfiable Char repr =>
  65   CombRegisterableUnscoped repr =>
  66   Referenceable TH.Name repr =>
  67   ObserveSharing TH.Name repr (Char, Char)
  68 g17 = bind (item @Char) (\pc -> production (,) [||(,)||] <$> pc <*> pc)
  69 g18 = string "abc" <|> string "de"
  70 g19 = (string "abc" <|> string "de") <|> string "fghi"
  71 g20 = (tokens "abc" <|> tokens "") *> void (tokens "def")