Language/TCT/Read/Cell.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 {-# LANGUAGE Rank2Types #-}
   3 {-# LANGUAGE TypeFamilies #-}
   4 module Language.TCT.Read.Cell where
   5
   6 import Data.Char (Char)
   7 import Data.Either (Either(..))
   8 import Data.Function (($), (.))
   9 import Data.Functor ((<$>))
  10 import Data.Int (Int)
  11 import Data.List.NonEmpty (NonEmpty(..))
  12 import Data.Maybe (Maybe(..))
  13 import Data.Ord (Ord)
  14 import Data.String (String, IsString)
  15 import Prelude (Num(..), toInteger)
  16 import Text.Show (Show)
  17 import qualified Data.Set as Set
  18 import qualified Text.Megaparsec as P
  19
  20 import Language.TCT.Cell
  21
  22 -- * Type 'Parser'
  23 -- | Convenient alias.
  24 type Parser e s a =
  25  ( P.Stream s
  26  , P.Token s ~ Char
  27  , Ord e
  28  , IsString (P.Tokens s)
  29  ) => P.Parsec e s a
  30
  31 p_satisfyMaybe :: P.MonadParsec e s m => (P.Token s -> Maybe a) -> m a
  32 p_satisfyMaybe f = check `P.token` Nothing
  33         where
  34         check c =
  35                 case f c of
  36                  Just a  -> Right a
  37                  Nothing -> Left (Just $ P.Tokens $ c:|[], Set.empty)
  38
  39 p_Position :: Parser e s Pos
  40 p_Position = (<$> P.getPosition) $ \p ->
  41         Pos
  42          (intOfPos $ P.sourceLine p)
  43          (intOfPos $ P.sourceColumn p)
  44 intOfPos :: P.Pos -> Int
  45 intOfPos = fromInteger . toInteger . P.unPos
  46
  47 p_LineNum :: Parser e s Line
  48 p_LineNum = intOfPos . P.sourceLine <$> P.getPosition
  49
  50 p_ColNum :: Parser e s Column
  51 p_ColNum = intOfPos . P.sourceColumn <$> P.getPosition
  52
  53 -- * Debug
  54 pdbg :: ( Show a
  55         , P.Token s ~ Char
  56         , P.ShowToken (P.Token s)
  57         , P.Stream s
  58         ) => String -> P.ParsecT e s m a -> P.ParsecT e s m a
  59 -- pdbg m p = P.dbg m p
  60 pdbg _m p = p
  61 {-# INLINE pdbg #-}