symantic-lib/Language/Symantic/Grammar/MegaParsec.hs

   1 {-# LANGUAGE ConstraintKinds #-}
   2 {-# OPTIONS_GHC -fno-warn-orphans #-}
   3 module Grammar.MegaParsec where
   4
   5 import Control.Applicative (Applicative(..))
   6 import Data.String (IsString(..))
   7 import Prelude hiding (any, (^), exp)
   8 import qualified Control.Applicative as Alt
   9 import qualified Data.Char as Char
  10 import qualified Data.Text as Text
  11 import qualified Text.Megaparsec as P
  12
  13 import Language.Symantic.Grammar
  14
  15 -- * Type 'ParsecT'
  16 type ParsecC e s = (P.Token s ~ Char, P.Stream s, P.ErrorComponent e)
  17 instance ParsecC e s => IsString (P.ParsecT e s m [Char]) where
  18         fromString = P.string
  19 instance ParsecC e s => Gram_Rule (P.ParsecT e s m) where
  20         rule = P.label . Text.unpack
  21 instance ParsecC e s => Gram_Terminal (P.ParsecT e s m) where
  22         any          = P.anyChar
  23         eoi          = P.eof
  24         char         = P.char
  25         string       = P.string
  26         unicat cat   = P.satisfy $ (`elem` cats) . Char.generalCategory
  27                 where cats = unicode_categories cat
  28         range (l, h) = P.satisfy $ \c -> l <= c && c <= h
  29         Terminal f `but` Terminal p = Terminal $ P.notFollowedBy (P.try p) *> f
  30 instance ParsecC e s => Gram_Alt (P.ParsecT e s m) where
  31         empty  = Alt.empty
  32         (<+>)  = (Alt.<|>)
  33         choice = P.choice
  34 instance ParsecC e s => Gram_Try (P.ParsecT e s m) where
  35         try = P.try
  36 instance ParsecC e s => Gram_RegR (P.ParsecT e s m) where
  37         Terminal f .*> Reg x = Reg $ f <*> x
  38 instance ParsecC e s => Gram_RegL (P.ParsecT e s m) where
  39         Reg f <*. Terminal x = Reg $ f <*> x
  40 instance ParsecC e s => Gram_App (P.ParsecT e s m) where
  41         between = P.between
  42 instance ParsecC e s => Gram_AltApp (P.ParsecT e s m) where
  43         option   = P.option
  44         optional = P.optional
  45         many     = P.many
  46         some     = P.some
  47         skipMany = P.skipMany
  48 instance ParsecC e s => Gram_CF (P.ParsecT e s m) where
  49         CF f <& Reg p        = CF $ P.lookAhead f <*> p
  50         Reg f &> CF p        = CF $ P.lookAhead f <*> p
  51         minus (CF f) (Reg p) = CF $ P.notFollowedBy (P.try p) *> f
  52 instance ParsecC e s => Gram_Meta P.SourcePos (P.ParsecT e s m) where
  53         withMeta p = do
  54                 pos <- P.getPosition
  55                 ($ pos) <$> p
  56 instance ParsecC e s => Gram_Comment (P.ParsecT e s m)
  57 instance ParsecC e s => Gram_Op (P.ParsecT e s m)