]> Git — Sourcephile - haskell/symantic-parser.git/blob - parsers/Parsers/Brainfuck/SymanticParser/Grammar.hs
iface: remove `satisfyOrFail`
[haskell/symantic-parser.git] / parsers / Parsers / Brainfuck / SymanticParser / Grammar.hs
1 {-# LANGUAGE AllowAmbiguousTypes #-}
2 {-# LANGUAGE DataKinds #-}
3 {-# LANGUAGE ScopedTypeVariables #-}
4 {-# LANGUAGE TemplateHaskell #-}
5 {-# LANGUAGE TypeApplications #-}
6 {-# LANGUAGE ViewPatterns #-}
7 module Parsers.Brainfuck.SymanticParser.Grammar where
8
9 import Data.Char (Char)
10 import Data.Function ((.))
11 import qualified Prelude
12
13 import qualified Symantic.Parser as SP
14
15 import Parsers.Utils
16 import Parsers.Brainfuck.Types
17
18 -- | Use with @$$(runParser @Text grammar)@,
19 -- but in another Haskell module to avoid
20 -- GHC stage restriction on such top-level splice.
21 grammar :: forall tok repr.
22 CoerceEnum Char tok =>
23 CoerceEnum tok Char =>
24 SP.Grammarable tok repr =>
25 repr [Instruction]
26 grammar = whitespace SP.*> bf
27 where
28 whitespace = SP.skipMany (SP.noneOf (coerceEnum @_ @tok Prelude.<$> "<>+-,.[]"))
29 lexeme :: repr a -> repr a
30 lexeme p = p SP.<* whitespace
31 bf :: repr [Instruction]
32 bf = SP.many (lexeme (SP.match (SP.look (SP.item @tok))
33 (SP.prod . coerceEnum Prelude.<$> "<>+-,.[")
34 op SP.empty))
35 op :: SP.Production '[] tok -> repr Instruction
36 op prod = case coerceEnum (SP.runValue prod) of
37 '<' -> SP.item @tok SP.$> SP.prod Backward
38 '>' -> SP.item @tok SP.$> SP.prod Forward
39 '+' -> SP.item @tok SP.$> SP.prod Increment
40 '-' -> SP.item @tok SP.$> SP.prod Decrement
41 ',' -> SP.item @tok SP.$> SP.prod Input
42 '.' -> SP.item @tok SP.$> SP.prod Output
43 '[' -> SP.between (lexeme (SP.item @tok))
44 (SP.token (coerceEnum @_ @tok ']'))
45 ($(SP.prodCon 'Loop) SP.<$> bf)
46 _ -> Prelude.undefined