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.ShowErrorComponent e
  30  ) => P.Parsec e s a
  31
  32 p_satisfyMaybe :: P.MonadParsec e s m => (P.Token s -> Maybe a) -> m a
  33 p_satisfyMaybe f = check `P.token` Nothing
  34         where
  35         check c =
  36                 case f c of
  37                  Just a  -> Right a
  38                  Nothing -> Left (Just $ P.Tokens $ c:|[], Set.empty)
  39
  40 p_Position :: Parser e s Pos
  41 p_Position = (<$> P.getPosition) $ \p ->
  42         Pos
  43          (intOfPos $ P.sourceLine p)
  44          (intOfPos $ P.sourceColumn p)
  45 intOfPos :: P.Pos -> Int
  46 intOfPos = fromInteger . toInteger . P.unPos
  47
  48 p_LineNum :: Parser e s Line
  49 p_LineNum = intOfPos . P.sourceLine <$> P.getPosition
  50
  51 p_ColNum :: Parser e s Column
  52 p_ColNum = intOfPos . P.sourceColumn <$> P.getPosition
  53
  54 -- * Debug
  55 pdbg :: Show a => String -> Parser e s a -> Parser e s a
  56 -- pdbg m p = P.dbg m p
  57 pdbg _m p = p
  58 {-# INLINE pdbg #-}