diff --git a/Text/Parsec/Indentation.hs b/Text/Parsec/Indentation.hs --- a/Text/Parsec/Indentation.hs +++ b/Text/Parsec/Indentation.hs @@ -76,6 +76,10 @@ localTokenMode :: (Monad m) => (IndentationRel -> IndentationRel) -> ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a localTokenMode = I.localTokenMode localState +{-# INLINE localIndentation #-} +localIndentation :: (Monad m) => IndentationRel -> ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a +localIndentation = I.localIndentation localStateUnlessAbsMode + {-# INLINE absoluteIndentation #-} absoluteIndentation :: (Monad m) => ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a absoluteIndentation = I.absoluteIndentation localState @@ -85,9 +89,9 @@ ignoreAbsoluteIndentation :: (Monad m) => ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a ignoreAbsoluteIndentation = I.ignoreAbsoluteIndentation localState -{-# INLINE localIndentation #-} -localIndentation :: (Monad m) => IndentationRel -> ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a -localIndentation = I.localIndentation localStateUnlessAbsMode +{-# INLINE localAbsoluteIndentation #-} +localAbsoluteIndentation :: (Monad m) => ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a +localAbsoluteIndentation = I.localAbsoluteIndentation localState ------------------------ -- Indent Stream Impls diff --git a/Text/Parser/Indentation/Implementation.hs b/Text/Parser/Indentation/Implementation.hs --- a/Text/Parser/Indentation/Implementation.hs +++ b/Text/Parser/Indentation/Implementation.hs @@ -162,7 +162,7 @@ absoluteIndentation :: LocalState a -> a -> a absoluteIndentation localState = localState pre post where pre i1 = i1 { absMode = True } - post i1 i2 = i2 { absMode = absMode i1 } -- redundant if we assertNonAbsMode + post i1 i2 = i2 { absMode = absMode i1 && absMode i2 } {-# INLINE ignoreAbsoluteIndentation #-} ignoreAbsoluteIndentation :: LocalState a -> a -> a @@ -170,6 +170,12 @@ pre i1 = i1 { absMode = False } post i1 i2 = i2 { absMode = absMode i1 } +{-# INLINE localAbsoluteIndentation #-} +localAbsoluteIndentation :: LocalState a -> a -> a +localAbsoluteIndentation localState = localState pre post where + pre i1 = i1 { absMode = True } + post i1 i2 = i2 { absMode = absMode i1 } + --{-# INLINE askTokenMode #-} --askTokenMode :: (Monad m) => ParsecT (IndentationStream s) u m IndentationRel --askTokenMode = liftM tokenRel getInput @@ -193,7 +199,7 @@ {-# INLINE localIndentation #-} -- NOTE: it is the responsibility of 'localState' to *not* use it's arguments if we are in absMode localIndentation :: LocalState a -> IndentationRel -> a -> a -localIndentation localState Eq m = m +localIndentation _localState Eq m = m localIndentation localState Any m = localIndentation' localState (const 0) (const infIndentation) (const) m localIndentation localState (Const c) m | c == infIndentation = error "localIndentation: Const indentation 'infIndentation' is out of bounds" diff --git a/Text/Trifecta/Indentation.hs b/Text/Trifecta/Indentation.hs new file mode 100644 --- /dev/null +++ b/Text/Trifecta/Indentation.hs @@ -0,0 +1,183 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, GeneralizedNewtypeDeriving, StandaloneDeriving #-} + +-- Implements "Indentation Senstivie Parsing" for Trifecta +module Text.Trifecta.Indentation ( + I.IndentationRel(..), I.Indentation, I.infIndentation, I.mkIndentationState, + IndentationParsing(..), + IndentationParserT, + runIndentationParserT, + evalIndentationParserT, + execIndentationParserT, + ) where + +import Control.Applicative +import Control.Monad.State.Lazy as LazyState +import Control.Monad.State.Strict as StrictState + +import Text.Parser.Combinators +import Text.Parser.Token +import Text.Parser.Char +import Text.Parser.LookAhead +import Text.Trifecta.Combinators +import Text.Trifecta.Delta + +import Text.Parser.Indentation.Implementation (IndentationState(..), IndentationRel(..), LocalState) +import qualified Text.Parser.Indentation.Implementation as I + +-------------- +-- User API -- +-------------- + +class IndentationParsing m where + localTokenMode :: (IndentationRel -> IndentationRel) -> m a -> m a + localIndentation :: IndentationRel -> m a -> m a + absoluteIndentation :: m a -> m a + ignoreAbsoluteIndentation :: m a -> m a + localAbsoluteIndentation :: m a -> m a + localAbsoluteIndentation = ignoreAbsoluteIndentation . absoluteIndentation + +---------------------- +-- Lifted Instances -- +---------------------- + +{- TODO: +Applicative +Functor +MonadWriter w m +MonadError e m +Monad m +MonadReader r m +MonadTrans (StateT s) +Monad m +Monad m +MonadFix m +MonadPlus m +MonadIO m +MonadCont m +#-} + +{-# INLINE liftLazyStateT2 #-} +liftLazyStateT2 :: (m (a, s) -> m (a, s)) -> LazyState.StateT s m a -> LazyState.StateT s m a +liftLazyStateT2 f m = LazyState.StateT $ \s -> f (LazyState.runStateT m s) + +instance (IndentationParsing i) => IndentationParsing (LazyState.StateT s i) where + localTokenMode f = liftLazyStateT2 (localTokenMode f) + localIndentation r = liftLazyStateT2 (localIndentation r) + absoluteIndentation = liftLazyStateT2 absoluteIndentation + ignoreAbsoluteIndentation = liftLazyStateT2 ignoreAbsoluteIndentation + localAbsoluteIndentation = liftLazyStateT2 localAbsoluteIndentation + +{-# INLINE liftStrictStateT2 #-} +liftStrictStateT2 :: (m (a, s) -> m (a, s)) -> StrictState.StateT s m a -> StrictState.StateT s m a +liftStrictStateT2 f m = StrictState.StateT $ \s -> f (StrictState.runStateT m s) + +instance (IndentationParsing i) => IndentationParsing (StrictState.StateT s i) where + localTokenMode f = liftStrictStateT2 (localTokenMode f) + localIndentation r = liftStrictStateT2 (localIndentation r) + absoluteIndentation = liftStrictStateT2 absoluteIndentation + ignoreAbsoluteIndentation = liftStrictStateT2 ignoreAbsoluteIndentation + localAbsoluteIndentation = liftStrictStateT2 localAbsoluteIndentation + +--------------- +-- Data Type -- +--------------- + +-- TODO: do we need a strict version of this? +newtype IndentationParserT t m a = IndentationParserT { unIndentationParserT :: LazyState.StateT IndentationState m a } + deriving (Functor, Applicative, Monad, MonadTrans, MonadPlus, Alternative) + +deriving instance (Parsing m, MonadPlus m) => Parsing (IndentationParserT t m) +deriving instance (DeltaParsing m) => DeltaParsing (IndentationParserT Char m) +deriving instance (MarkParsing Delta m) => MarkParsing Delta (IndentationParserT Char m) +deriving instance (DeltaParsing m) => DeltaParsing (IndentationParserT Token m) +deriving instance (MarkParsing Delta m) => MarkParsing Delta (IndentationParserT Token m) + +{-# INLINE runIndentationParserT #-} +runIndentationParserT :: IndentationParserT t m a -> IndentationState -> m (a, IndentationState) +runIndentationParserT (IndentationParserT m) = LazyState.runStateT m + +{-# INLINE evalIndentationParserT #-} +evalIndentationParserT :: (Monad m) => IndentationParserT t m a -> IndentationState -> m a +evalIndentationParserT (IndentationParserT m) = LazyState.evalStateT m + +{-# INLINE execIndentationParserT #-} +execIndentationParserT :: (Monad m) => IndentationParserT t m a -> IndentationState -> m IndentationState +execIndentationParserT (IndentationParserT m) = LazyState.execStateT m + +--------------------- +-- Class Instances -- +--------------------- + +-- Putting the check in CharParsing -- + +instance (DeltaParsing m) => CharParsing (IndentationParserT Char m) where + satisfy f = checkIndentation (satisfy f) + +instance (DeltaParsing m) => TokenParsing (IndentationParserT Char m) where + someSpace = IndentationParserT $ someSpace -- Ignore indentation of whitespace + +-- Putting the check in TokenParsing -- + +data Token + +instance (DeltaParsing m) => CharParsing (IndentationParserT Token m) where + satisfy f = IndentationParserT $ satisfy f + +instance (DeltaParsing m) => TokenParsing (IndentationParserT Token m) where + token p = checkIndentation (token (unIndentationParserT p)) + +-------- + +instance (LookAheadParsing m, MonadPlus m) => LookAheadParsing (IndentationParserT t m) where + lookAhead m = IndentationParserT $ do + s <- get + x <- lookAhead (unIndentationParserT m) + put s + return x + +-------- + +instance (Monad m) => IndentationParsing (IndentationParserT t m) where + {-# INLINE localTokenMode #-} + localTokenMode = I.localTokenMode localState + + {-# INLINE localIndentation #-} + localIndentation = I.localIndentation localStateUnlessAbsMode + + {-# INLINE absoluteIndentation #-} + absoluteIndentation = I.absoluteIndentation localState + + {-# INLINE ignoreAbsoluteIndentation #-} + ignoreAbsoluteIndentation = I.ignoreAbsoluteIndentation localState + + {-# INLINE localAbsoluteIndentation #-} + localAbsoluteIndentation = I.localAbsoluteIndentation localState + +--------------------- +-- Private Helpers -- +--------------------- + +{-# INLINE localState #-} +localState :: (Monad m) => LocalState (IndentationParserT t m a) +localState pre post m = IndentationParserT $ do + is <- get + put (pre is) + x <- unIndentationParserT m + is' <- get + put (post is is') + return x + +{-# INLINE localStateUnlessAbsMode #-} +localStateUnlessAbsMode :: (Monad m) => LocalState (IndentationParserT t m a) +localStateUnlessAbsMode pre post m = IndentationParserT $ do + a <- gets I.indentationStateAbsMode + unIndentationParserT $ if a then m else localState pre post m + +{-# INLINE checkIndentation #-} +checkIndentation :: (DeltaParsing m) => LazyState.StateT IndentationState m a -> IndentationParserT t m a +checkIndentation m = IndentationParserT $ do + is <- get + p <- position + let ok is' = do x <- m; put is'; return x + err msg = fail msg + I.updateIndentation is (fromIntegral $ column p + 1) ok err diff --git a/indentation.cabal b/indentation.cabal --- a/indentation.cabal +++ b/indentation.cabal @@ -1,5 +1,5 @@ name: indentation -version: 0.1.0.0 +version: 0.2.0.0 synopsis: Indentation sensitive parsing combinators for Parsec -- description: license: BSD3 @@ -19,14 +19,28 @@ library exposed-modules: Text.Parser.Indentation.Implementation - , Text.Parsec.Indentation + build-depends: base >=4.6 && <4.8, + mtl >=2.1 && <2.2 + + if flag(Parsec) + build-depends: parsec ==3.1.* + exposed-modules: Text.Parsec.Indentation , Text.Parsec.Indentation.Char , Text.Parsec.Indentation.Token - build-depends: base >=4.6 && <4.7, - parsec >=3.1 && <3.2, - mtl >=2.1 && <2.2 + if flag(Trifecta) + build-depends: trifecta ==1.4.*, + parsers ==0.11.0.* + exposed-modules: Text.Trifecta.Indentation default-language: Haskell2010 ghc-options: -Wall + +flag Parsec + description: Include indentation operators for Parsec + manual: True + +flag Trifecta + description: Include indentation operators for Trifecta + manual: True