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