1 {-# LANGUAGE ConstraintKinds #-}
2 {-# LANGUAGE UndecidableInstances #-}
3 {-# OPTIONS_GHC -fno-warn-orphans #-}
4 module Grammar.Megaparsec where
6 import Control.Applicative (Applicative(..))
7 import Data.List.NonEmpty (NonEmpty)
8 import Data.String (IsString(..))
9 import Prelude hiding (any, (^), exp)
10 import qualified Control.Applicative as Alt
11 import qualified Control.Monad.Classes as MC
12 import qualified Data.Char as Char
13 import qualified Data.Text as Text
14 import qualified Text.Megaparsec as P
16 import Language.Symantic.Grammar
19 type ParsecC e s = (P.Token s ~ Char, P.Stream s, P.ErrorComponent e)
20 instance ParsecC e s => IsString (P.ParsecT e s m [Char]) where
22 instance ParsecC e s => Gram_Rule (P.ParsecT e s m) where
23 rule = P.label . Text.unpack
24 instance ParsecC e s => Gram_Terminal (P.ParsecT e s m) where
29 unicat cat = P.satisfy $ (`elem` cats) . Char.generalCategory
30 where cats = unicode_categories cat
31 range (l, h) = P.satisfy $ \c -> l <= c && c <= h
32 Terminal f `but` Terminal p = Terminal $ P.notFollowedBy (P.try p) *> f
33 instance ParsecC e s => Gram_Alt (P.ParsecT e s m) where
37 instance ParsecC e s => Gram_Try (P.ParsecT e s m) where
39 instance ParsecC e s => Gram_RegR (P.ParsecT e s m) where
40 Terminal f .*> Reg x = Reg $ f <*> x
41 instance ParsecC e s => Gram_RegL (P.ParsecT e s m) where
42 Reg f <*. Terminal x = Reg $ f <*> x
43 instance ParsecC e s => Gram_App (P.ParsecT e s m) where
45 instance ParsecC e s => Gram_AltApp (P.ParsecT e s m) where
51 instance ParsecC e s => Gram_CF (P.ParsecT e s m) where
52 CF f <& Reg p = CF $ P.lookAhead f <*> p
53 Reg f &> CF p = CF $ P.lookAhead f <*> p
54 minus (CF f) (Reg p) = CF $ P.notFollowedBy (P.try p) *> f
55 instance ParsecC e s => Gram_Comment (P.ParsecT e s m)
56 instance ParsecC e s => Gram_Op (P.ParsecT e s m)
58 type instance MC.CanDo (P.ParsecT e s m) (MC.EffState st) = 'False
59 instance ParsecC e s => Gram_Reader (NonEmpty P.SourcePos) (P.ParsecT e s m) where
61 s <- P.statePos <$> P.getParserState
66 s <- P.statePos <$> P.getParserState
68 instance ParsecC e s => Gram_Reader () (P.ParsecT e s m) where
69 g_ask_before = fmap ($ ())
70 g_ask_after = fmap ($ ())
71 instance (Monad m, MC.MonadState st m) => Gram_State st m where