test/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.String (String)
  10 import Text.Show (Show(..))
  11 import qualified Data.Functor as Functor
  12 import qualified Parsers.Nandlang
  13 import qualified Parsers.Brainfuck.SymanticParser
  14
  15 import Symantic.Parser
  16 import qualified Symantic.Parser.Haskell as H
  17
  18 rawGrammars :: Grammarable Char repr => [repr String]
  19 rawGrammars =
  20   [ H.Term (H.ValueCode show [||show||]) <$> g1
  21   , H.Term (H.ValueCode show [||show||]) <$> g2
  22   , H.Term (H.ValueCode show [||show||]) <$> g3
  23   , H.Term (H.ValueCode show [||show||]) <$> g4
  24   , H.Term (H.ValueCode show [||show||]) <$> g5
  25   , H.Term (H.ValueCode show [||show||]) <$> g6
  26   , H.Term (H.ValueCode show [||show||]) <$> g7
  27   , H.Term (H.ValueCode show [||show||]) <$> g8
  28   , H.Term (H.ValueCode show [||show||]) <$> g9
  29   , H.Term (H.ValueCode show [||show||]) <$> g10
  30   , H.Term (H.ValueCode show [||show||]) <$> g11
  31   , H.Term (H.ValueCode show [||show||]) <$> g12
  32   , H.Term (H.ValueCode show [||show||]) <$> g13
  33   , H.Term (H.ValueCode show [||show||]) <$> g14
  34   , H.Term (H.ValueCode show [||show||]) <$> g15
  35   , H.Term (H.ValueCode show [||show||]) <$> g16
  36   ]
  37 grammars :: Grammarable Char repr => [repr String]
  38 grammars = observeSharing Functor.<$> rawGrammars
  39
  40 g1 = char 'a'
  41 g2 = string "abc"
  42 g3 = many (char 'a')
  43 g4 = some (string "abcd")
  44 g5 = some (string "abcd") <* eof
  45 g6 = traverse char "aa" <|> traverse char "ab"
  46 g7 = string "aa" <|> string "ab"
  47 g8 = many (char 'r') <* eof
  48 g9 = eof
  49 g10 = char 'a' <|> char 'b'
  50 g11 = many (char 'a') <* char 'b'
  51 g12 = many (oneOf ['a', 'b', 'c', 'd']) <* eof
  52 g13 = Parsers.Brainfuck.SymanticParser.grammar @Char @_
  53 g14 = Parsers.Nandlang.grammar
  54 g15 = (char 'a' <|> char 'b') <* char 'c'
  55 g16 = (char 'a' <|> char 'b' <|> char 'c') <* char 'd'