diff --git a/Text/Trifecta.hs b/Text/Trifecta.hs --- a/Text/Trifecta.hs +++ b/Text/Trifecta.hs @@ -11,14 +11,20 @@ ---------------------------------------------------------------------------- module Text.Trifecta ( module Text.Trifecta.Diagnostic + , module Text.Trifecta.Highlight + , module Text.Trifecta.Language + , module Text.Trifecta.Layout + , module Text.Trifecta.Literate , module Text.Trifecta.Parser , module Text.Trifecta.Rope - , module Text.Trifecta.Highlight , module System.Console.Terminfo.PrettyPrint ) where import Text.Trifecta.Diagnostic +import Text.Trifecta.Highlight +import Text.Trifecta.Language +import Text.Trifecta.Layout +import Text.Trifecta.Literate import Text.Trifecta.Parser import Text.Trifecta.Rope -import Text.Trifecta.Highlight import System.Console.Terminfo.PrettyPrint diff --git a/Text/Trifecta/Diagnostic.hs b/Text/Trifecta/Diagnostic.hs --- a/Text/Trifecta/Diagnostic.hs +++ b/Text/Trifecta/Diagnostic.hs @@ -13,24 +13,22 @@ ( -- * Diagnostics Diagnostic(..) - , tellDiagnostic -- * Rendering , Renderable(..) , Source , rendering + , renderingCaret , Caret(..), Careted(..) , Span(..), Spanned(..) , Fixit(..), Rendered(..) -- * Emitting diagnostics , MonadDiagnostic(..) - , fatal - , err - , warn - , note - , verbose - , warnWith - , noteWith - , verboseWith + , panic, panicAt + , fatal, fatalAt + , err, errAt + , warn, warnAt + , note, noteAt + , verbose, verboseAt -- * Diagnostic Levels , DiagnosticLevel(..) ) where diff --git a/Text/Trifecta/Diagnostic/Class.hs b/Text/Trifecta/Diagnostic/Class.hs --- a/Text/Trifecta/Diagnostic/Class.hs +++ b/Text/Trifecta/Diagnostic/Class.hs @@ -30,46 +30,37 @@ import Text.Trifecta.Diagnostic.Rendering.Prim class Monad m => MonadDiagnostic e m | m -> e where - fatalWith :: [Diagnostic e] -> [Rendering] -> e -> m a -- consuming error - errWith :: [Diagnostic e] -> [Rendering] -> e -> m a -- non-consuming error, handled by <|> - logWith :: DiagnosticLevel -> [Diagnostic e] -> [Rendering] -> e -> m () -- log an error and continue + throwDiagnostic :: Diagnostic e -> m a + logDiagnostic :: Diagnostic e -> m () instance MonadDiagnostic e m => MonadDiagnostic e (Lazy.StateT s m) where - fatalWith d r e = lift (fatalWith d r e) - errWith d r e = lift (errWith d r e) - logWith l d r e = lift (logWith l d r e) + throwDiagnostic = lift . throwDiagnostic + logDiagnostic = lift . logDiagnostic instance MonadDiagnostic e m => MonadDiagnostic e (Strict.StateT s m) where - fatalWith d r e = lift (fatalWith d r e) - errWith d r e = lift (errWith d r e) - logWith l d r e = lift (logWith l d r e) + throwDiagnostic = lift . throwDiagnostic + logDiagnostic = lift . logDiagnostic instance MonadDiagnostic e m => MonadDiagnostic e (ReaderT r m) where - fatalWith d r e = lift (fatalWith d r e) - errWith d r e = lift (errWith d r e) - logWith l d r e = lift (logWith l d r e) + throwDiagnostic = lift . throwDiagnostic + logDiagnostic = lift . logDiagnostic instance (MonadDiagnostic e m, Monoid w) => MonadDiagnostic e (Lazy.WriterT w m) where - fatalWith d r e = lift (fatalWith d r e) - errWith d r e = lift (errWith d r e) - logWith l d r e = lift (logWith l d r e) + throwDiagnostic = lift . throwDiagnostic + logDiagnostic = lift . logDiagnostic instance (MonadDiagnostic e m, Monoid w) => MonadDiagnostic e (Strict.WriterT w m) where - fatalWith d r e = lift (fatalWith d r e) - errWith d r e = lift (errWith d r e) - logWith l d r e = lift (logWith l d r e) + throwDiagnostic = lift . throwDiagnostic + logDiagnostic = lift . logDiagnostic instance (MonadDiagnostic e m, Monoid w) => MonadDiagnostic e (Lazy.RWST r w s m) where - fatalWith d r e = lift (fatalWith d r e) - errWith d r e = lift (errWith d r e) - logWith l d r e = lift (logWith l d r e) + throwDiagnostic = lift . throwDiagnostic + logDiagnostic = lift . logDiagnostic instance (MonadDiagnostic e m, Monoid w) => MonadDiagnostic e (Strict.RWST r w s m) where - fatalWith d r e = lift (fatalWith d r e) - errWith d r e = lift (errWith d r e) - logWith l d r e = lift (logWith l d r e) + throwDiagnostic = lift . throwDiagnostic + logDiagnostic = lift . logDiagnostic instance MonadDiagnostic e m => MonadDiagnostic e (IdentityT m) where - fatalWith d r e = lift (fatalWith d r e) - errWith d r e = lift (errWith d r e) - logWith l d r e = lift (logWith l d r e) + throwDiagnostic = lift . throwDiagnostic + logDiagnostic = lift . logDiagnostic diff --git a/Text/Trifecta/Diagnostic/Combinators.hs b/Text/Trifecta/Diagnostic/Combinators.hs --- a/Text/Trifecta/Diagnostic/Combinators.hs +++ b/Text/Trifecta/Diagnostic/Combinators.hs @@ -10,48 +10,48 @@ -- -- Combinators for throwing and logging expressive diagnostics ---------------------------------------------------------------------------- -module Text.Trifecta.Diagnostic.Combinators - ( fatal - , err - , warn - , note - , verbose - , warnWith - , noteWith - , verboseWith +module Text.Trifecta.Diagnostic.Combinators + ( panic, panicAt + , fatal, fatalAt + , err, errAt + , warn, warnAt + , note, noteAt + , verbose, verboseAt ) where +import Control.Applicative +import Control.Monad.Instances () +import Text.Trifecta.Parser.Class import Text.Trifecta.Diagnostic.Class import Text.Trifecta.Diagnostic.Prim import Text.Trifecta.Diagnostic.Level import Text.Trifecta.Diagnostic.Rendering.Prim - -fatal :: MonadDiagnostic e m => e -> m a -fatal = fatalWith [] [] - -err :: MonadDiagnostic e m => e -> m a -err = errWith [] [] +import Text.Trifecta.Diagnostic.Rendering.Caret +import Text.Trifecta.Rope.Delta -warn :: MonadDiagnostic e m => e -> m () -warn = warnWith [] [] +rendCaret :: MonadParser m => m Rendering +rendCaret = (delta >>= addCaret) <$> rend -note :: MonadDiagnostic e m => e -> m () -note = noteWith [] [] +panicAt, fatalAt, errAt :: MonadDiagnostic e m => [Diagnostic e] -> e -> Rendering -> m a +panicAt es e r = throwDiagnostic $ Diagnostic (Right r) Panic e es +fatalAt es e r = throwDiagnostic $ Diagnostic (Right r) Fatal e es +errAt es e r = throwDiagnostic $ Diagnostic (Right r) Error e es -verbose :: MonadDiagnostic e m => Int -> e -> m () -verbose n = verboseWith n [] [] +panic, fatal, err :: (MonadParser m, MonadDiagnostic e m) => [Diagnostic e] -> e -> m a +panic es e = rendCaret >>= panicAt es e +fatal es e = rendCaret >>= fatalAt es e +err es e = rendCaret >>= errAt es e -warnWith :: MonadDiagnostic e m => [Diagnostic e] -> [Rendering] -> e -> m () -warnWith = logWith Warning +warnAt, noteAt :: MonadDiagnostic e m => [Diagnostic e] -> e -> Rendering -> m () +warnAt es e r = logDiagnostic $ Diagnostic (Right r) Warning e es +noteAt es e r = logDiagnostic $ Diagnostic (Right r) Note e es -noteWith :: MonadDiagnostic e m => [Diagnostic e] -> [Rendering] -> e -> m () -noteWith = logWith Note +verboseAt :: MonadDiagnostic e m => Int -> [Diagnostic e] -> e -> Rendering -> m () +verboseAt l es e r = logDiagnostic $ Diagnostic (Right r) (Verbose l) e es -verboseWith :: MonadDiagnostic e m => Int -> [Diagnostic e] -> [Rendering] -> e -> m () -verboseWith n = logWith (Verbose n) +warn, note :: (MonadParser m, MonadDiagnostic e m) => [Diagnostic e] -> e -> m () +warn es e = rendCaret >>= warnAt es e +note es e = rendCaret >>= noteAt es e --- sublimate :: MonadDiagnostic e m => m a -> m a --- sublimate a = a `catchError` \e -> --- if fatalErr e then throwError e else do --- m <- here --- tell (diagnose m e) +verbose :: (MonadParser m, MonadDiagnostic e m) => Int -> [Diagnostic e] -> e -> m () +verbose l es e = rendCaret >>= verboseAt l es e diff --git a/Text/Trifecta/Diagnostic/Err.hs b/Text/Trifecta/Diagnostic/Err.hs --- a/Text/Trifecta/Diagnostic/Err.hs +++ b/Text/Trifecta/Diagnostic/Err.hs @@ -26,12 +26,11 @@ import Text.Trifecta.Diagnostic.Rendering.Prim import Text.PrettyPrint.Free --- | unlocated error data Err e - = EmptyErr -- empty, no error specified - | FailErr String -- a recoverable error caused by fail - | PanicErr String -- something is bad with the grammar, fail fast - | Err [Rendering] !DiagnosticLevel e [Diagnostic e] + = EmptyErr -- no error specified, unlocated + | FailErr Rendering String -- a recoverable error caused by fail from a known location + | PanicErr Rendering String -- something is bad with the grammar, fail fast + | Err !(Diagnostic e) -- a user defined error message deriving Show knownErr :: Err e -> Bool @@ -39,36 +38,39 @@ knownErr _ = True fatalErr :: Err e -> Bool -fatalErr (Err _ Fatal _ _) = True -fatalErr (PanicErr _) = True +fatalErr (Err (Diagnostic _ Panic _ _)) = True +fatalErr (Err (Diagnostic _ Fatal _ _)) = True +fatalErr (PanicErr _ _) = True fatalErr _ = False instance Functor Err where fmap _ EmptyErr = EmptyErr - fmap _ (FailErr s) = FailErr s - fmap _ (PanicErr s) = PanicErr s - fmap f (Err rs l e es) = Err rs l (f e) (fmap (fmap f) es) + fmap _ (FailErr r s) = FailErr r s + fmap _ (PanicErr r s) = PanicErr r s + fmap f (Err e) = Err (fmap f e) instance Foldable Err where foldMap _ EmptyErr = mempty foldMap _ FailErr{} = mempty foldMap _ PanicErr{} = mempty - foldMap f (Err _ _ e ds) = f e `mappend` foldMap (foldMap f) ds + foldMap f (Err e) = foldMap f e instance Traversable Err where traverse _ EmptyErr = pure EmptyErr - traverse _ (FailErr s) = pure $ FailErr s - traverse _ (PanicErr s) = pure $ PanicErr s - traverse f (Err rs l e ds) = Err rs l <$> f e <*> traverse (traverse f) ds + traverse _ (FailErr r s) = pure $ FailErr r s + traverse _ (PanicErr r s) = pure $ PanicErr r s + traverse f (Err e) = Err <$> traverse f e -- | Merge two errors, selecting the most severe. instance Alt Err where - a EmptyErr = a - _ a@(Err _ Fatal _ _) = a - a@(Err _ Fatal _ _) _ = a - _ a@PanicErr{} = a - a@PanicErr{} _ = a - _ b = b + a EmptyErr = a + _ a@(Err (Diagnostic _ Panic _ _)) = a + a@(Err (Diagnostic _ Panic _ _)) _ = a + _ a@PanicErr{} = a + a@PanicErr{} _ = a + _ a@(Err (Diagnostic _ Fatal _ _)) = a + a@(Err (Diagnostic _ Fatal _ _)) _ = a + _ b = b {-# INLINE () #-} -- | Merge two errors, selecting the most severe. @@ -83,4 +85,4 @@ -- | Merge two errors, selecting the most severe. instance Monoid (Err t) where mempty = EmptyErr - mappend = () + mappend = () diff --git a/Text/Trifecta/Diagnostic/Level.hs b/Text/Trifecta/Diagnostic/Level.hs --- a/Text/Trifecta/Diagnostic/Level.hs +++ b/Text/Trifecta/Diagnostic/Level.hs @@ -10,7 +10,7 @@ -- -- A fairly straightforward set of common error levels. ---------------------------------------------------------------------------- -module Text.Trifecta.Diagnostic.Level +module Text.Trifecta.Diagnostic.Level ( DiagnosticLevel(..) ) where @@ -20,12 +20,12 @@ import System.Console.Terminfo.PrettyPrint -- | The severity of an error (or message) -data DiagnosticLevel +data DiagnosticLevel = Verbose !Int -- ^ a comment we should only show to the excessively curious | Note -- ^ a comment | Warning -- ^ a warning, computation continues | Error -- ^ a user specified error - | Fatal -- ^ a user specified fatal error + | Fatal -- ^ a user specified fatal error | Panic -- ^ a non-maskable death sentence thrown by the parser itself deriving (Eq,Show,Read) diff --git a/Text/Trifecta/Diagnostic/Prim.hs b/Text/Trifecta/Diagnostic/Prim.hs --- a/Text/Trifecta/Diagnostic/Prim.hs +++ b/Text/Trifecta/Diagnostic/Prim.hs @@ -13,7 +13,6 @@ ---------------------------------------------------------------------------- module Text.Trifecta.Diagnostic.Prim ( Diagnostic(..) - , tellDiagnostic ) where import Control.Applicative @@ -46,9 +45,6 @@ addHighlights h (Diagnostic rs l m xs) = Diagnostic (addHighlights h <$> rs) l m (addHighlights h <$> xs) instance (Typeable m, Show m) => Exception (Diagnostic m) - -tellDiagnostic :: (MonadWriter t m, Reducer (Diagnostic e) t) => Diagnostic e -> m () -tellDiagnostic = tell . unit instance Renderable (Diagnostic m) where render (Diagnostic r _ _ _) = either (const emptyRendering) id r diff --git a/Text/Trifecta/Diagnostic/Rendering.hs b/Text/Trifecta/Diagnostic/Rendering.hs --- a/Text/Trifecta/Diagnostic/Rendering.hs +++ b/Text/Trifecta/Diagnostic/Rendering.hs @@ -11,7 +11,7 @@ ---------------------------------------------------------------------------- module Text.Trifecta.Diagnostic.Rendering ( Renderable(..) - , Source, rendering + , Source, rendering, renderingCaret , Caret(..), Careted(..) , Span(..), Spanned(..) , Fixit(..), Rendered(..) diff --git a/Text/Trifecta/Diagnostic/Rendering/Caret.hs b/Text/Trifecta/Diagnostic/Rendering/Caret.hs --- a/Text/Trifecta/Diagnostic/Rendering/Caret.hs +++ b/Text/Trifecta/Diagnostic/Rendering/Caret.hs @@ -19,6 +19,7 @@ , drawCaret , addCaret , caretEffects + , renderingCaret ) where import Control.Applicative @@ -84,6 +85,9 @@ instance Semigroup Caret where a <> _ = a + +renderingCaret :: Delta -> ByteString -> Rendering +renderingCaret d bs = addCaret d $ rendering d bs data Careted a = a :^ Caret deriving (Eq,Ord,Show) diff --git a/Text/Trifecta/Language.hs b/Text/Trifecta/Language.hs new file mode 100644 --- /dev/null +++ b/Text/Trifecta/Language.hs @@ -0,0 +1,34 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Language +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- +module Text.Trifecta.Language + ( Language(..) + , runLanguage + , LanguageDef(..) + , MonadLanguage(..) + , asksLanguage + , identifier + , reserved + , reservedByteString + , op + , reservedOp + , reservedOpByteString + , emptyLanguageDef + , haskellLanguageDef + , haskell98LanguageDef + ) where + +import Text.Trifecta.Language.Class +import Text.Trifecta.Language.Combinators +import Text.Trifecta.Language.Prim +import Text.Trifecta.Language.Monad +import Text.Trifecta.Language.Style + diff --git a/Text/Trifecta/Language/Class.hs b/Text/Trifecta/Language/Class.hs new file mode 100644 --- /dev/null +++ b/Text/Trifecta/Language/Class.hs @@ -0,0 +1,59 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Language.Class +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- +module Text.Trifecta.Language.Class + ( MonadLanguage(..) + , asksLanguage + ) where + +import Control.Monad (liftM) +import Control.Monad.Trans.Class +import Control.Monad.Trans.Reader +import Control.Monad.Trans.Identity +import qualified Control.Monad.Trans.Writer.Strict as Strict +import qualified Control.Monad.Trans.State.Strict as Strict +import qualified Control.Monad.Trans.RWS.Strict as Strict +import qualified Control.Monad.Trans.Writer.Lazy as Lazy +import qualified Control.Monad.Trans.State.Lazy as Lazy +import qualified Control.Monad.Trans.RWS.Lazy as Lazy +import Data.Monoid +import Text.Trifecta.Language.Prim +import Text.Trifecta.Parser.Class + +class MonadParser m => MonadLanguage m where + askLanguage :: m (LanguageDef m) + +asksLanguage :: MonadLanguage m => (LanguageDef m -> r) -> m r +asksLanguage f = liftM f askLanguage + +instance MonadLanguage m => MonadLanguage (Strict.StateT s m) where + askLanguage = liftM liftLanguageDef $ lift askLanguage + +instance MonadLanguage m => MonadLanguage (Lazy.StateT s m) where + askLanguage = liftM liftLanguageDef $ lift askLanguage + +instance (Monoid w, MonadLanguage m) => MonadLanguage (Strict.WriterT w m) where + askLanguage = liftM liftLanguageDef $ lift askLanguage + +instance (Monoid w, MonadLanguage m) => MonadLanguage (Lazy.WriterT w m) where + askLanguage = liftM liftLanguageDef $ lift askLanguage + +instance MonadLanguage m => MonadLanguage (ReaderT s m) where + askLanguage = liftM liftLanguageDef $ lift askLanguage + +instance MonadLanguage m => MonadLanguage (IdentityT m) where + askLanguage = liftM liftLanguageDef $ lift askLanguage + +instance (Monoid w, MonadLanguage m) => MonadLanguage (Strict.RWST r w s m) where + askLanguage = liftM liftLanguageDef $ lift askLanguage + +instance (Monoid w, MonadLanguage m) => MonadLanguage (Lazy.RWST r w s m) where + askLanguage = liftM liftLanguageDef $ lift askLanguage diff --git a/Text/Trifecta/Language/Combinators.hs b/Text/Trifecta/Language/Combinators.hs new file mode 100644 --- /dev/null +++ b/Text/Trifecta/Language/Combinators.hs @@ -0,0 +1,42 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Language.Combinators +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- +module Text.Trifecta.Language.Combinators + ( identifier + , reserved + , reservedByteString + , op + , reservedOp + , reservedOpByteString + ) where + +import Data.ByteString +import Text.Trifecta.Language.Class +import Text.Trifecta.Language.Prim +import Text.Trifecta.Parser.Identifier + +identifier :: MonadLanguage m => m ByteString +identifier = asksLanguage languageIdentifierStyle >>= ident + +reserved :: MonadLanguage m => String -> m () +reserved i = asksLanguage languageIdentifierStyle >>= \style -> reserve style i + +reservedByteString :: MonadLanguage m => ByteString -> m () +reservedByteString i = asksLanguage languageIdentifierStyle >>= \style -> reserveByteString style i + +op :: MonadLanguage m => m ByteString +op = asksLanguage languageOperatorStyle >>= ident + +reservedOp :: MonadLanguage m => String -> m () +reservedOp i = asksLanguage languageOperatorStyle >>= \style -> reserve style i + +reservedOpByteString :: MonadLanguage m => ByteString -> m () +reservedOpByteString i = asksLanguage languageOperatorStyle >>= \style -> reserveByteString style i diff --git a/Text/Trifecta/Language/Monad.hs b/Text/Trifecta/Language/Monad.hs new file mode 100644 --- /dev/null +++ b/Text/Trifecta/Language/Monad.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, GeneralizedNewtypeDeriving #-} +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Language.Monad +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- +module Text.Trifecta.Language.Monad + ( Language(..) + , runLanguage + ) where + +import Control.Applicative +import Control.Monad () +import Control.Monad.Trans.Class +import Control.Monad.Reader +import Control.Monad.Writer.Class +import Control.Monad.State.Class +import Control.Monad.Cont.Class +import Text.Trifecta.Diagnostic.Class +import Text.Trifecta.Parser.Class +import Text.Trifecta.Parser.Mark +import Text.Trifecta.Parser.Token.Style +import Text.Trifecta.Language.Prim +import Text.Trifecta.Language.Class + +newtype Language m a = Language { unlanguage :: ReaderT (LanguageDef (Language m)) m a } + deriving (Functor,Applicative,Alternative,Monad,MonadPlus,MonadCont) + +runLanguage :: Language m a -> LanguageDef (Language m) -> m a +runLanguage = runReaderT . unlanguage + +instance MonadParser m => MonadLanguage (Language m) where + askLanguage = Language ask + +instance MonadTrans Language where + lift = Language . lift + +instance MonadParser m => MonadParser (Language m) where + highlightInterval h s e = lift $ highlightInterval h s e + someSpace = asksLanguage languageCommentStyle >>= buildSomeSpaceParser (lift someSpace) + nesting (Language (ReaderT m)) = Language $ ReaderT $ nesting . m + semi = lift semi + try (Language m) = Language $ try m + labels (Language m) ss = Language $ labels m ss + satisfy = lift . satisfy + satisfy8 = lift . satisfy8 + skipping = lift . skipping + unexpected = lift . unexpected + position = lift position + line = lift line + lookAhead (Language m) = Language (lookAhead m) + slicedWith f (Language m) = Language $ ReaderT $ slicedWith f . runReaderT m + +instance MonadMark d m => MonadMark d (Language m) where + mark = lift mark + release = lift . release + +instance MonadDiagnostic e m => MonadDiagnostic e (Language m) where + throwDiagnostic = lift . throwDiagnostic + logDiagnostic = lift . logDiagnostic + +instance MonadState s m => MonadState s (Language m) where + get = Language $ lift get + put s = Language $ lift $ put s + +instance MonadWriter w m => MonadWriter w (Language m) where + tell = Language . lift . tell + pass = Language . pass . unlanguage + listen = Language . listen . unlanguage + +instance MonadReader e m => MonadReader e (Language m) where + ask = Language $ lift ask + local f (Language m) = Language $ ReaderT $ \e -> local f (runReaderT m e) diff --git a/Text/Trifecta/Language/Prim.hs b/Text/Trifecta/Language/Prim.hs new file mode 100644 --- /dev/null +++ b/Text/Trifecta/Language/Prim.hs @@ -0,0 +1,28 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Language.Prim +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- +module Text.Trifecta.Language.Prim + ( LanguageDef(..) + , liftLanguageDef + ) where + +import Control.Monad.Trans.Class +import Text.Trifecta.Parser.Token.Style +import Text.Trifecta.Parser.Identifier + +data LanguageDef m = LanguageDef + { languageCommentStyle :: CommentStyle + , languageIdentifierStyle :: IdentifierStyle m + , languageOperatorStyle :: IdentifierStyle m + } + +liftLanguageDef :: (MonadTrans t, Monad m) => LanguageDef m -> LanguageDef (t m) +liftLanguageDef (LanguageDef c i o) = LanguageDef c (liftIdentifierStyle i) (liftIdentifierStyle o) diff --git a/Text/Trifecta/Language/Style.hs b/Text/Trifecta/Language/Style.hs new file mode 100644 --- /dev/null +++ b/Text/Trifecta/Language/Style.hs @@ -0,0 +1,26 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Language.Style +-- Copyright : (c) Edward Kmett 2011 +-- License : BSD3 +-- +-- Maintainer : ekmett@gmail.com +-- Stability : provisional +-- Portability : non-portable +-- +----------------------------------------------------------------------------- +module Text.Trifecta.Language.Style + ( emptyLanguageDef + , haskellLanguageDef + , haskell98LanguageDef + ) where + +import Text.Trifecta.Parser.Class +import Text.Trifecta.Parser.Token.Style +import Text.Trifecta.Parser.Identifier.Style +import Text.Trifecta.Language.Prim + +emptyLanguageDef, haskellLanguageDef, haskell98LanguageDef :: MonadParser m => LanguageDef m +emptyLanguageDef = LanguageDef emptyCommentStyle emptyIdents emptyOps +haskellLanguageDef = LanguageDef haskellCommentStyle haskellIdents haskellOps +haskell98LanguageDef = LanguageDef haskellCommentStyle haskell98Idents haskell98Ops diff --git a/Text/Trifecta/Layout.hs b/Text/Trifecta/Layout.hs new file mode 100644 --- /dev/null +++ b/Text/Trifecta/Layout.hs @@ -0,0 +1,23 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Parser.Layout +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- +module Text.Trifecta.Layout + ( Layout(..) + , LayoutMark(..) + , MonadLayout(..) + , LayoutState(..) + , runLayout + , defaultLayoutState + ) where + +import Text.Trifecta.Layout.Monad +import Text.Trifecta.Layout.Class +import Text.Trifecta.Layout.Prim diff --git a/Text/Trifecta/Layout/Class.hs b/Text/Trifecta/Layout/Class.hs new file mode 100644 --- /dev/null +++ b/Text/Trifecta/Layout/Class.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Layout.Class +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- +module Text.Trifecta.Layout.Class + ( MonadLayout(..) + ) where + +import Data.Monoid +import Control.Monad.Trans.Class +import Control.Monad.Trans.Reader +import Control.Monad.Trans.Identity +import qualified Control.Monad.Trans.State.Lazy as Lazy +import qualified Control.Monad.Trans.State.Strict as Strict +import qualified Control.Monad.Trans.Writer.Lazy as Lazy +import qualified Control.Monad.Trans.Writer.Strict as Strict +import qualified Control.Monad.Trans.RWS.Lazy as Lazy +import qualified Control.Monad.Trans.RWS.Strict as Strict +import Text.Trifecta.Layout.Prim +import Text.Trifecta.Parser.Class + +class MonadParser m => MonadLayout m where + layout :: m LayoutToken + layoutState :: (LayoutState -> (a, LayoutState)) -> m a + +instance MonadLayout m => MonadLayout (Strict.StateT s m) where + layout = lift layout + layoutState = lift . layoutState + +instance MonadLayout m => MonadLayout (Lazy.StateT s m) where + layout = lift layout + layoutState = lift . layoutState + +instance MonadLayout m => MonadLayout (ReaderT e m) where + layout = lift layout + layoutState = lift . layoutState + +instance (Monoid w, MonadLayout m) => MonadLayout (Strict.WriterT w m) where + layout = lift layout + layoutState = lift . layoutState + +instance (Monoid w, MonadLayout m) => MonadLayout (Lazy.WriterT w m) where + layout = lift layout + layoutState = lift . layoutState + +instance (Monoid w, MonadLayout m) => MonadLayout (Strict.RWST r w s m) where + layout = lift layout + layoutState = lift . layoutState + +instance (Monoid w, MonadLayout m) => MonadLayout (Lazy.RWST r w s m) where + layout = lift layout + layoutState = lift . layoutState + +instance MonadLayout m => MonadLayout (IdentityT m) where + layout = lift layout + layoutState = lift . layoutState diff --git a/Text/Trifecta/Layout/Combinators.hs b/Text/Trifecta/Layout/Combinators.hs new file mode 100644 --- /dev/null +++ b/Text/Trifecta/Layout/Combinators.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Layout.Combinators +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- +module Text.Trifecta.Layout.Combinators + ( layoutEq + , getLayout + , setLayout + , modLayout + , disableLayout + , enableLayout + , laidout + ) where + +import Control.Applicative +import Control.Monad (guard) +import Data.Lens.Common +import Text.Trifecta.Rope.Delta +import Text.Trifecta.Parser.Class +import Text.Trifecta.Parser.Token.Combinators +import qualified Text.Trifecta.Highlight.Prim as Highlight +import Text.Trifecta.Layout.Class +import Text.Trifecta.Layout.Prim + +getLayout :: MonadLayout m => Lens LayoutState t -> m t +getLayout l = layoutState $ \s -> (getL l s, s) + +setLayout :: MonadLayout m => Lens LayoutState t -> t -> m () +setLayout l t = layoutState $ \s -> ((), setL l t s) + +modLayout :: MonadLayout m => Lens LayoutState t -> (t -> t) -> m () +modLayout l f = layoutState $ \s -> ((), modL l f s) + +disableLayout :: MonadLayout m => m a -> m a +disableLayout p = do + r <- rend + modLayout layoutStack (DisabledLayout r:) + result <- p + stk <- getLayout layoutStack + case stk of + DisabledLayout r':xs | delta r == delta r' -> result <$ setLayout layoutStack xs + _ -> unexpected "layout" + +enableLayout :: MonadLayout m => m a -> m a +enableLayout p = do + result <- highlight Highlight.Layout $ do + r <- rend + modLayout layoutStack (IndentedLayout r:) + p + result <$ layout "virtual right brace" + +laidout :: MonadLayout m => m a -> m a +laidout p = braces p <|> enableLayout p + +layoutEq :: MonadLayout m => LayoutToken -> m () +layoutEq s = try $ do + r <- layout + guard (s == r) + diff --git a/Text/Trifecta/Layout/Monad.hs b/Text/Trifecta/Layout/Monad.hs new file mode 100644 --- /dev/null +++ b/Text/Trifecta/Layout/Monad.hs @@ -0,0 +1,112 @@ +{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleInstances, UndecidableInstances #-} +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Parser.Layout.Monad +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- +module Text.Trifecta.Layout.Monad + ( Layout(..) + , runLayout + ) where + +import Control.Applicative +import Control.Category +import Control.Monad +import Control.Monad.State.Class +import Control.Monad.Trans.State.Strict (StateT(..)) +import Control.Monad.Writer.Class +import Control.Monad.Reader.Class +import Control.Monad.Cont.Class +import Control.Monad.Trans.Class +import Prelude hiding ((.), id) +import Text.Trifecta.Diagnostic.Class +import Text.Trifecta.Parser.Class +import Text.Trifecta.Parser.Mark +import Text.Trifecta.Parser.Combinators +import Text.Trifecta.Layout.Prim +import Text.Trifecta.Layout.Class +import Text.Trifecta.Layout.Combinators +import Text.Trifecta.Rope.Delta + +-- | Adds Haskell-style "layout" to base parser +newtype Layout m a = Layout { unlayout :: StateT LayoutState m a } + deriving (Functor, Applicative, Alternative, Monad, MonadPlus, MonadTrans, MonadCont) + +runLayout :: Monad m => Layout m a -> LayoutState -> m (a, LayoutState) +runLayout = runStateT . unlayout + +instance MonadParser m => MonadParser (Layout m) where + satisfy p = try $ layoutEq Other *> lift (satisfy p) + satisfy8 p = try $ layoutEq Other *> lift (satisfy8 p) + line = lift line + unexpected = lift . unexpected + try = Layout . try . unlayout + labels m s = Layout $ labels (unlayout m) s + skipMany = Layout . skipMany . unlayout + highlightInterval h s e = lift $ highlightInterval h s e + someSpace = try $ (layoutEq WhiteSpace "") + nesting (Layout m) = disableLayout $ Layout (nesting m) + semi = getLayout layoutStack >>= \ stk -> case stk of + (DisabledLayout _:_) -> lift semi + _ -> try (';' <$ layoutEq VirtualSemi "virtual semi-colon") + <|> lift semi + skipping = lift . skipping + position = lift position + slicedWith f (Layout m) = Layout $ slicedWith f m + lookAhead (Layout m) = Layout $ lookAhead m + +instance MonadMark d m => MonadMark (LayoutMark d) (Layout m) where + mark = LayoutMark <$> getLayout id <*> lift mark + release (LayoutMark s m) = lift (release m) *> setLayout id s + +instance MonadDiagnostic e m => MonadDiagnostic e (Layout m) where + throwDiagnostic = lift . throwDiagnostic + logDiagnostic = lift . logDiagnostic + +instance MonadParser m => MonadLayout (Layout m) where + layout = buildLayoutParser (lift whiteSpace) + layoutState f = Layout . StateT $ return . f + +buildLayoutParser :: MonadLayout m => m () -> m LayoutToken +buildLayoutParser realWhiteSpace = do + bol <- getLayout layoutBol + m <- position + realWhiteSpace + r <- position + if near m r && not bol + then onside m r + else getLayout layoutStack >>= \stk -> case compare (column r) (depth stk) of + GT -> onside m r + EQ -> return VirtualSemi + LT -> case stk of + (IndentedLayout _:xs) -> VirtualRightBrace <$ setLayout layoutStack xs <* setLayout layoutBol True + _ -> unexpected "layout context" + where + onside m r + | r /= m = pure WhiteSpace + | otherwise = setLayout layoutBol False *> option Other (VirtualRightBrace <$ eof <* trailing) + trailing = getLayout layoutStack >>= \ stk -> case stk of + (IndentedLayout _:xs) -> setLayout layoutStack xs + _ -> empty + depth [] = 0 + depth (IndentedLayout r:_) = column r + depth (DisabledLayout _:_) = -1 + +instance MonadState s m => MonadState s (Layout m) where + get = Layout $ lift get + put = Layout . lift . put + +instance MonadReader e m => MonadReader e (Layout m) where + ask = Layout $ lift ask + local f (Layout m) = Layout $ local f m + +instance MonadWriter w m => MonadWriter w (Layout m) where + tell = Layout . lift . tell + listen (Layout m) = Layout $ listen m + pass (Layout m) = Layout $ pass m diff --git a/Text/Trifecta/Layout/Prim.hs b/Text/Trifecta/Layout/Prim.hs new file mode 100644 --- /dev/null +++ b/Text/Trifecta/Layout/Prim.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Layout.Prim +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- +module Text.Trifecta.Layout.Prim + ( LayoutToken(..) + , LayoutState(..) + , LayoutContext(..) + , LayoutMark(..) + , defaultLayoutState + , layoutBol + , layoutStack + ) where + +import Data.Functor +import Data.Lens.Common +import Data.Foldable +import Data.Semigroup.Foldable +import Data.Semigroup.Traversable +import Data.Traversable +import Text.Trifecta.Rope.Delta +import Text.Trifecta.Rope.Bytes +import Text.Trifecta.Diagnostic.Rendering.Prim + +data LayoutToken + = VirtualSemi + | VirtualRightBrace + | WhiteSpace + | Other + deriving (Eq,Ord,Show,Read) + +data LayoutContext + = IndentedLayout Rendering + | DisabledLayout Rendering + +instance HasDelta LayoutContext where + delta (IndentedLayout r) = delta r + delta (DisabledLayout r) = delta r + +instance HasBytes LayoutContext where + bytes = bytes . delta + +data LayoutState = LayoutState + { _layoutBol :: Bool + , _layoutStack :: [LayoutContext] + } + +defaultLayoutState :: LayoutState +defaultLayoutState = LayoutState False [] + +layoutBol :: Lens LayoutState Bool +layoutBol = lens _layoutBol (\s l -> l { _layoutBol = s}) + +layoutStack :: Lens LayoutState [LayoutContext] +layoutStack = lens _layoutStack (\s l -> l { _layoutStack = s}) + +data LayoutMark d = LayoutMark LayoutState d + +instance Functor LayoutMark where + fmap f (LayoutMark s a) = LayoutMark s (f a) + +instance Foldable LayoutMark where + foldMap f (LayoutMark _ a) = f a + +instance Traversable LayoutMark where + traverse f (LayoutMark s a) = LayoutMark s <$> f a + +instance Foldable1 LayoutMark where + foldMap1 f (LayoutMark _ a) = f a + +instance Traversable1 LayoutMark where + traverse1 f (LayoutMark s a) = LayoutMark s <$> f a + +instance HasDelta d => HasDelta (LayoutMark d) where + delta (LayoutMark _ d) = delta d + +instance HasBytes d => HasBytes (LayoutMark d) where + bytes (LayoutMark _ d) = bytes d diff --git a/Text/Trifecta/Literate.hs b/Text/Trifecta/Literate.hs new file mode 100644 --- /dev/null +++ b/Text/Trifecta/Literate.hs @@ -0,0 +1,23 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Parser.Literate +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- +module Text.Trifecta.Literate + ( Literate(..) + , LiterateMark(..) + , MonadLiterate(..) + , LiterateState(..) + , runLiterate + , defaultLiterateState + ) where + +import Text.Trifecta.Literate.Monad +import Text.Trifecta.Literate.Class +import Text.Trifecta.Literate.Prim diff --git a/Text/Trifecta/Literate/Class.hs b/Text/Trifecta/Literate/Class.hs new file mode 100644 --- /dev/null +++ b/Text/Trifecta/Literate/Class.hs @@ -0,0 +1,54 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Literate.Class +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- +module Text.Trifecta.Literate.Class + ( MonadLiterate(..) + ) where + +import Control.Monad.Trans.Class +import Control.Monad.Trans.Reader +import Control.Monad.Trans.Identity +import qualified Control.Monad.Trans.State.Strict as Strict +import qualified Control.Monad.Trans.State.Lazy as Lazy +import qualified Control.Monad.Trans.Writer.Strict as Strict +import qualified Control.Monad.Trans.Writer.Lazy as Lazy +import qualified Control.Monad.Trans.RWS.Strict as Strict +import qualified Control.Monad.Trans.RWS.Lazy as Lazy +import Data.Monoid +import Text.Trifecta.Parser.Class +import Text.Trifecta.Literate.Prim + +class MonadParser m => MonadLiterate m where + literateState :: (LiterateState -> (a, LiterateState)) -> m a + +instance MonadLiterate m => MonadLiterate (Strict.StateT s m) where + literateState = lift . literateState + +instance MonadLiterate m => MonadLiterate (Lazy.StateT s m) where + literateState = lift . literateState + +instance (Monoid w, MonadLiterate m) => MonadLiterate (Strict.WriterT w m) where + literateState = lift . literateState + +instance (Monoid w, MonadLiterate m) => MonadLiterate (Lazy.WriterT w m) where + literateState = lift . literateState + +instance (Monoid w, MonadLiterate m) => MonadLiterate (Strict.RWST r w s m) where + literateState = lift . literateState + +instance (Monoid w, MonadLiterate m) => MonadLiterate (Lazy.RWST r w s m) where + literateState = lift . literateState + +instance MonadLiterate m => MonadLiterate (IdentityT m) where + literateState = lift . literateState + +instance MonadLiterate m => MonadLiterate (ReaderT e m) where + literateState = lift . literateState diff --git a/Text/Trifecta/Literate/Combinators.hs b/Text/Trifecta/Literate/Combinators.hs new file mode 100644 --- /dev/null +++ b/Text/Trifecta/Literate/Combinators.hs @@ -0,0 +1,85 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Literate.Combinators +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- +module Text.Trifecta.Literate.Combinators + ( someLiterateSpace + , getLiterate + , putLiterate + ) where + +import Data.Char (isSpace) +import Control.Applicative +import Control.Monad +import Text.Trifecta.Rope.Delta +import qualified Text.Trifecta.Highlight.Prim as Highlight +import Text.Trifecta.Literate.Prim +import Text.Trifecta.Literate.Class +import Text.Trifecta.Parser.Char +import Text.Trifecta.Parser.Class +import Text.Trifecta.Parser.Combinators + +getLiterate :: MonadLiterate m => m LiterateState +getLiterate = literateState $ \s -> (s, s) + +putLiterate :: MonadLiterate m => LiterateState -> m () +putLiterate s = literateState $ \_ -> ((), s) + +skipLine :: MonadParser m => m () +skipLine = do + r <- restOfLine + skipping (delta r) + +someLiterateSpace :: MonadLiterate m => m () +someLiterateSpace = do + s <- getLiterate + case s of + IlliterateStart -> skipSome $ satisfy isSpace + LiterateStart -> position >>= \m -> track m <|> begin m <|> blank m <|> other m + LiterateCode -> do + skipSome $ satisfy isSpace + option () $ position >>= \m -> when (column m == 0) $ do + highlight Highlight.LiterateSyntax (string "\\end{code}") *> skipLine + begin m <|> blank m <|> other m + LiterateTrack -> skipSome horizontalSpace >> skipOptional bird + <|> bird + where + bird = newline *> position >>= \m -> track m <|> blank m + +-- parse space excluding newlines +horizontalSpace :: MonadLiterate m => m Char +horizontalSpace = satisfy $ \s -> s /= '\n' && isSpace s + +track, begin, blank, other :: MonadLiterate m => Delta -> m () +track s = do + e <- position + try $ highlight Highlight.LiterateSyntax (char '>') + *> highlightInterval Highlight.LiterateComment s e + *> skipSome horizontalSpace + tracks <|> putLiterate LiterateTrack where + tracks = do + s' <- newline *> position + track s' <|> blank s' + +begin s = do + try $ highlight Highlight.LiterateSyntax (string "\begin{code}") *> skipLine + position >>= highlightInterval Highlight.LiterateComment s + putLiterate LiterateCode + whiteSpace + +other s = do + notChar '>' *> skipLine + begin s <|> blank s <|> other s + +blank s = do + k <- try $ do + skipMany horizontalSpace + True <$ newline <|> False <$ eof + when k $ track s <|> begin s <|> blank s <|> other s diff --git a/Text/Trifecta/Literate/Monad.hs b/Text/Trifecta/Literate/Monad.hs new file mode 100644 --- /dev/null +++ b/Text/Trifecta/Literate/Monad.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, GeneralizedNewtypeDeriving #-} +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Literate.Monad +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- +module Text.Trifecta.Literate.Monad + ( Literate(..) + , runLiterate + ) where + +import Control.Applicative +import Control.Monad +import Control.Monad.Trans.State.Strict (StateT(..)) +import Control.Monad.Trans.Class +import Control.Monad.State.Class +import Control.Monad.Cont.Class +import Control.Monad.Reader.Class +import Control.Monad.Writer.Class +import Data.Semigroup +import Text.Trifecta.Diagnostic.Class +import Text.Trifecta.Language.Prim +import Text.Trifecta.Language.Class +import Text.Trifecta.Literate.Prim +import Text.Trifecta.Literate.Class +import Text.Trifecta.Literate.Combinators +import Text.Trifecta.Parser.Char +import Text.Trifecta.Parser.Class +import Text.Trifecta.Parser.Combinators +import Text.Trifecta.Parser.Mark +import Text.Trifecta.Rope.Delta + +newtype Literate m a = Literate { unliterate :: StateT LiterateState m a } + deriving (Functor,Applicative,Alternative,Monad,MonadPlus,MonadTrans,MonadCont) + +runLiterate :: Monad m => Literate m a -> LiterateState -> m (a, LiterateState) +runLiterate = runStateT . unliterate + +instance MonadParser m => MonadParser (Literate m) where + someSpace = someLiterateSpace + highlightInterval h s e = lift $ highlightInterval h s e + try (Literate m) = Literate $ try m + nesting (Literate m) = Literate $ nesting m + skipMany (Literate m) = Literate $ skipMany m + slicedWith f (Literate m) = Literate $ slicedWith f m + labels (Literate m) p = Literate $ labels m p + semi = lift semi + line = lift line + satisfy = lift . satisfy + satisfy8 = lift . satisfy8 + unexpected = lift . unexpected + position = lift position + skipping d + | near (Columns 0 0) d = lift $ skipping d -- we don't change literate states within a line + | otherwise = do + s <- position + let e = s <> d + () <$ (manyTill (someSpace <|> () <$ anyChar) $ position >>= \p -> guard (e <= p)) + lookAhead (Literate (StateT p)) = Literate $ StateT $ \s -> do + as' <- lookAhead $ p s + return (fst as', s) + +instance MonadParser m => MonadLiterate (Literate m) where + literateState f = Literate $ StateT $ return . f + +instance MonadMark d m => MonadMark (LiterateMark d) (Literate m) where + mark = LiterateMark <$> getLiterate <*> lift mark + release (LiterateMark s d) = lift (release d) *> putLiterate s + +instance MonadLanguage m => MonadLanguage (Literate m) where + askLanguage = liftM liftLanguageDef $ lift askLanguage + +instance MonadDiagnostic e m => MonadDiagnostic e (Literate m) where + throwDiagnostic = lift . throwDiagnostic + logDiagnostic = lift . logDiagnostic + +instance MonadState s m => MonadState s (Literate m) where + get = lift get + put = lift . put + +instance MonadReader e m => MonadReader e (Literate m) where + ask = lift ask + local f (Literate m) = Literate $ local f m + +instance MonadWriter w m => MonadWriter w (Literate m) where + tell = lift . tell + listen (Literate m) = Literate $ listen m + pass (Literate m) = Literate $ pass m diff --git a/Text/Trifecta/Literate/Prim.hs b/Text/Trifecta/Literate/Prim.hs new file mode 100644 --- /dev/null +++ b/Text/Trifecta/Literate/Prim.hs @@ -0,0 +1,60 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Literate.Prim +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- +module Text.Trifecta.Literate.Prim + ( LiterateState(..) + , defaultLiterateState + , LiterateMark(..) + ) where + +import Data.Functor +import Data.Foldable +import Data.Traversable +import Data.Semigroup +import Data.Semigroup.Foldable +import Data.Semigroup.Traversable +import Text.Trifecta.Rope.Bytes +import Text.Trifecta.Rope.Delta + +data LiterateState + = LiterateStart -- ^ Parsing literate syntax + | IlliterateStart -- ^ Disable literate parsing + | LiterateCode -- ^ In the midst of a @\begin{code} ... \end{code}@ block + | LiterateTrack -- ^ In the midst of a @> ...@ block + +defaultLiterateState :: LiterateState +defaultLiterateState = LiterateStart + +data LiterateMark d = LiterateMark LiterateState d + +instance Functor LiterateMark where + fmap f (LiterateMark s a) = LiterateMark s (f a) + +instance Foldable LiterateMark where + foldMap f (LiterateMark _ a) = f a + +instance Traversable LiterateMark where + traverse f (LiterateMark s a) = LiterateMark s <$> f a + +instance Foldable1 LiterateMark where + foldMap1 f (LiterateMark _ a) = f a + +instance Traversable1 LiterateMark where + traverse1 f (LiterateMark s a) = LiterateMark s <$> f a + +instance HasDelta d => HasDelta (LiterateMark d) where + delta (LiterateMark _ d) = delta d + +instance HasBytes d => HasBytes (LiterateMark d) where + bytes (LiterateMark _ d) = bytes d + +instance Semigroup d => Semigroup (LiterateMark d) where + LiterateMark _ d <> LiterateMark s e = LiterateMark s (d <> e) diff --git a/Text/Trifecta/Parser.hs b/Text/Trifecta/Parser.hs --- a/Text/Trifecta/Parser.hs +++ b/Text/Trifecta/Parser.hs @@ -15,9 +15,6 @@ , module Text.Trifecta.Parser.Class , module Text.Trifecta.Parser.Combinators , module Text.Trifecta.Parser.Identifier - , module Text.Trifecta.Parser.Language - , module Text.Trifecta.Parser.Layout - , module Text.Trifecta.Parser.Literate , module Text.Trifecta.Parser.Prim , module Text.Trifecta.Parser.Result , module Text.Trifecta.Parser.Rich @@ -42,9 +39,6 @@ import Text.Trifecta.Parser.Class import Text.Trifecta.Parser.Combinators import Text.Trifecta.Parser.Identifier -import Text.Trifecta.Parser.Language -import Text.Trifecta.Parser.Layout -import Text.Trifecta.Parser.Literate import Text.Trifecta.Parser.Prim import Text.Trifecta.Parser.Result import Text.Trifecta.Parser.Rich diff --git a/Text/Trifecta/Parser/Language.hs b/Text/Trifecta/Parser/Language.hs deleted file mode 100644 --- a/Text/Trifecta/Parser/Language.hs +++ /dev/null @@ -1,34 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Text.Trifecta.Parser.Language --- Copyright : (C) 2011 Edward Kmett --- License : BSD-style (see the file LICENSE) --- --- Maintainer : Edward Kmett --- Stability : experimental --- Portability : non-portable --- ----------------------------------------------------------------------------- -module Text.Trifecta.Parser.Language - ( Language(..) - , runLanguage - , LanguageDef(..) - , MonadLanguage(..) - , asksLanguage - , identifier - , reserved - , reservedByteString - , op - , reservedOp - , reservedOpByteString - , emptyLanguageDef - , haskellLanguageDef - , haskell98LanguageDef - ) where - -import Text.Trifecta.Parser.Language.Class -import Text.Trifecta.Parser.Language.Combinators -import Text.Trifecta.Parser.Language.Prim -import Text.Trifecta.Parser.Language.Monad -import Text.Trifecta.Parser.Language.Style - diff --git a/Text/Trifecta/Parser/Language/Class.hs b/Text/Trifecta/Parser/Language/Class.hs deleted file mode 100644 --- a/Text/Trifecta/Parser/Language/Class.hs +++ /dev/null @@ -1,48 +0,0 @@ -module Text.Trifecta.Parser.Language.Class - ( MonadLanguage(..) - , asksLanguage - ) where - -import Control.Monad (liftM) -import Control.Monad.Trans.Class -import Control.Monad.Trans.Reader -import Control.Monad.Trans.Identity -import qualified Control.Monad.Trans.Writer.Strict as Strict -import qualified Control.Monad.Trans.State.Strict as Strict -import qualified Control.Monad.Trans.RWS.Strict as Strict -import qualified Control.Monad.Trans.Writer.Lazy as Lazy -import qualified Control.Monad.Trans.State.Lazy as Lazy -import qualified Control.Monad.Trans.RWS.Lazy as Lazy -import Data.Monoid -import Text.Trifecta.Parser.Language.Prim -import Text.Trifecta.Parser.Class - -class MonadParser m => MonadLanguage m where - askLanguage :: m (LanguageDef m) - -asksLanguage :: MonadLanguage m => (LanguageDef m -> r) -> m r -asksLanguage f = liftM f askLanguage - -instance MonadLanguage m => MonadLanguage (Strict.StateT s m) where - askLanguage = liftM liftLanguageDef $ lift askLanguage - -instance MonadLanguage m => MonadLanguage (Lazy.StateT s m) where - askLanguage = liftM liftLanguageDef $ lift askLanguage - -instance (Monoid w, MonadLanguage m) => MonadLanguage (Strict.WriterT w m) where - askLanguage = liftM liftLanguageDef $ lift askLanguage - -instance (Monoid w, MonadLanguage m) => MonadLanguage (Lazy.WriterT w m) where - askLanguage = liftM liftLanguageDef $ lift askLanguage - -instance MonadLanguage m => MonadLanguage (ReaderT s m) where - askLanguage = liftM liftLanguageDef $ lift askLanguage - -instance MonadLanguage m => MonadLanguage (IdentityT m) where - askLanguage = liftM liftLanguageDef $ lift askLanguage - -instance (Monoid w, MonadLanguage m) => MonadLanguage (Strict.RWST r w s m) where - askLanguage = liftM liftLanguageDef $ lift askLanguage - -instance (Monoid w, MonadLanguage m) => MonadLanguage (Lazy.RWST r w s m) where - askLanguage = liftM liftLanguageDef $ lift askLanguage diff --git a/Text/Trifecta/Parser/Language/Combinators.hs b/Text/Trifecta/Parser/Language/Combinators.hs deleted file mode 100644 --- a/Text/Trifecta/Parser/Language/Combinators.hs +++ /dev/null @@ -1,42 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Text.Trifecta.Parser.Language.Combinators --- Copyright : (C) 2011 Edward Kmett --- License : BSD-style (see the file LICENSE) --- --- Maintainer : Edward Kmett --- Stability : experimental --- Portability : non-portable --- ----------------------------------------------------------------------------- -module Text.Trifecta.Parser.Language.Combinators - ( identifier - , reserved - , reservedByteString - , op - , reservedOp - , reservedOpByteString - ) where - -import Data.ByteString -import Text.Trifecta.Parser.Language.Class -import Text.Trifecta.Parser.Language.Prim -import Text.Trifecta.Parser.Identifier - -identifier :: MonadLanguage m => m ByteString -identifier = asksLanguage languageIdentifierStyle >>= ident - -reserved :: MonadLanguage m => String -> m () -reserved i = asksLanguage languageIdentifierStyle >>= \style -> reserve style i - -reservedByteString :: MonadLanguage m => ByteString -> m () -reservedByteString i = asksLanguage languageIdentifierStyle >>= \style -> reserveByteString style i - -op :: MonadLanguage m => m ByteString -op = asksLanguage languageOperatorStyle >>= ident - -reservedOp :: MonadLanguage m => String -> m () -reservedOp i = asksLanguage languageOperatorStyle >>= \style -> reserve style i - -reservedOpByteString :: MonadLanguage m => ByteString -> m () -reservedOpByteString i = asksLanguage languageOperatorStyle >>= \style -> reserveByteString style i diff --git a/Text/Trifecta/Parser/Language/Monad.hs b/Text/Trifecta/Parser/Language/Monad.hs deleted file mode 100644 --- a/Text/Trifecta/Parser/Language/Monad.hs +++ /dev/null @@ -1,69 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, GeneralizedNewtypeDeriving #-} -module Text.Trifecta.Parser.Language.Monad - ( Language(..) - , runLanguage - ) where - -import Control.Applicative -import Control.Monad () -import Control.Monad.Trans.Class -import Control.Monad.Reader -import Control.Monad.Writer.Class -import Control.Monad.State.Class -import Control.Monad.Cont.Class -import Text.Trifecta.Diagnostic.Class -import Text.Trifecta.Parser.Class -import Text.Trifecta.Parser.Mark -import Text.Trifecta.Parser.Token.Style -import Text.Trifecta.Parser.Language.Prim -import Text.Trifecta.Parser.Language.Class - -newtype Language m a = Language { unlanguage :: ReaderT (LanguageDef (Language m)) m a } - deriving (Functor,Applicative,Alternative,Monad,MonadPlus,MonadCont) - -runLanguage :: Language m a -> LanguageDef (Language m) -> m a -runLanguage = runReaderT . unlanguage - -instance MonadParser m => MonadLanguage (Language m) where - askLanguage = Language ask - -instance MonadTrans Language where - lift = Language . lift - -instance MonadParser m => MonadParser (Language m) where - highlightInterval h s e = lift $ highlightInterval h s e - someSpace = asksLanguage languageCommentStyle >>= buildSomeSpaceParser (lift someSpace) - nesting (Language (ReaderT m)) = Language $ ReaderT $ nesting . m - semi = lift semi - try (Language m) = Language $ try m - labels (Language m) ss = Language $ labels m ss - satisfy = lift . satisfy - satisfy8 = lift . satisfy8 - skipping = lift . skipping - unexpected = lift . unexpected - position = lift position - line = lift line - lookAhead (Language m) = Language (lookAhead m) - slicedWith f (Language m) = Language $ ReaderT $ slicedWith f . runReaderT m - -instance MonadMark d m => MonadMark d (Language m) where - mark = lift mark - release = lift . release - -instance MonadDiagnostic e m => MonadDiagnostic e (Language m) where - fatalWith xs rs e = lift $ fatalWith xs rs e - errWith xs rs e = lift $ errWith xs rs e - logWith l xs rs e = lift $ logWith l xs rs e - -instance MonadState s m => MonadState s (Language m) where - get = Language $ lift get - put s = Language $ lift $ put s - -instance MonadWriter w m => MonadWriter w (Language m) where - tell = Language . lift . tell - pass = Language . pass . unlanguage - listen = Language . listen . unlanguage - -instance MonadReader e m => MonadReader e (Language m) where - ask = Language $ lift ask - local f (Language m) = Language $ ReaderT $ \e -> local f (runReaderT m e) diff --git a/Text/Trifecta/Parser/Language/Prim.hs b/Text/Trifecta/Parser/Language/Prim.hs deleted file mode 100644 --- a/Text/Trifecta/Parser/Language/Prim.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Text.Trifecta.Parser.Language.Prim - ( LanguageDef(..) - , liftLanguageDef - ) where - -import Control.Monad.Trans.Class -import Text.Trifecta.Parser.Token.Style -import Text.Trifecta.Parser.Identifier - -data LanguageDef m = LanguageDef - { languageCommentStyle :: CommentStyle - , languageIdentifierStyle :: IdentifierStyle m - , languageOperatorStyle :: IdentifierStyle m - } - -liftLanguageDef :: (MonadTrans t, Monad m) => LanguageDef m -> LanguageDef (t m) -liftLanguageDef (LanguageDef c i o) = LanguageDef c (liftIdentifierStyle i) (liftIdentifierStyle o) diff --git a/Text/Trifecta/Parser/Language/Style.hs b/Text/Trifecta/Parser/Language/Style.hs deleted file mode 100644 --- a/Text/Trifecta/Parser/Language/Style.hs +++ /dev/null @@ -1,26 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Text.Trifecta.Parser.Language.Style --- Copyright : (c) Edward Kmett 2011 --- License : BSD3 --- --- Maintainer : ekmett@gmail.com --- Stability : provisional --- Portability : non-portable --- ------------------------------------------------------------------------------ -module Text.Trifecta.Parser.Language.Style - ( emptyLanguageDef - , haskellLanguageDef - , haskell98LanguageDef - ) where - -import Text.Trifecta.Parser.Class -import Text.Trifecta.Parser.Token.Style -import Text.Trifecta.Parser.Identifier.Style -import Text.Trifecta.Parser.Language.Prim - -emptyLanguageDef, haskellLanguageDef, haskell98LanguageDef :: MonadParser m => LanguageDef m -emptyLanguageDef = LanguageDef emptyCommentStyle emptyIdents emptyOps -haskellLanguageDef = LanguageDef haskellCommentStyle haskellIdents haskellOps -haskell98LanguageDef = LanguageDef haskellCommentStyle haskell98Idents haskell98Ops diff --git a/Text/Trifecta/Parser/Layout.hs b/Text/Trifecta/Parser/Layout.hs deleted file mode 100644 --- a/Text/Trifecta/Parser/Layout.hs +++ /dev/null @@ -1,23 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Text.Trifecta.Parser.Layout --- Copyright : (C) 2011 Edward Kmett --- License : BSD-style (see the file LICENSE) --- --- Maintainer : Edward Kmett --- Stability : experimental --- Portability : non-portable --- ----------------------------------------------------------------------------- -module Text.Trifecta.Parser.Layout - ( Layout(..) - , LayoutMark(..) - , MonadLayout(..) - , LayoutState(..) - , runLayout - , defaultLayoutState - ) where - -import Text.Trifecta.Parser.Layout.Monad -import Text.Trifecta.Parser.Layout.Class -import Text.Trifecta.Parser.Layout.Prim diff --git a/Text/Trifecta/Parser/Layout/Class.hs b/Text/Trifecta/Parser/Layout/Class.hs deleted file mode 100644 --- a/Text/Trifecta/Parser/Layout/Class.hs +++ /dev/null @@ -1,53 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses #-} -module Text.Trifecta.Parser.Layout.Class - ( MonadLayout(..) - ) where - -import Data.Monoid -import Control.Monad.Trans.Class -import Control.Monad.Trans.Reader -import Control.Monad.Trans.Identity -import qualified Control.Monad.Trans.State.Lazy as Lazy -import qualified Control.Monad.Trans.State.Strict as Strict -import qualified Control.Monad.Trans.Writer.Lazy as Lazy -import qualified Control.Monad.Trans.Writer.Strict as Strict -import qualified Control.Monad.Trans.RWS.Lazy as Lazy -import qualified Control.Monad.Trans.RWS.Strict as Strict -import Text.Trifecta.Parser.Layout.Prim -import Text.Trifecta.Parser.Class - -class MonadParser m => MonadLayout m where - layout :: m LayoutToken - layoutState :: (LayoutState -> (a, LayoutState)) -> m a - -instance MonadLayout m => MonadLayout (Strict.StateT s m) where - layout = lift layout - layoutState = lift . layoutState - -instance MonadLayout m => MonadLayout (Lazy.StateT s m) where - layout = lift layout - layoutState = lift . layoutState - -instance MonadLayout m => MonadLayout (ReaderT e m) where - layout = lift layout - layoutState = lift . layoutState - -instance (Monoid w, MonadLayout m) => MonadLayout (Strict.WriterT w m) where - layout = lift layout - layoutState = lift . layoutState - -instance (Monoid w, MonadLayout m) => MonadLayout (Lazy.WriterT w m) where - layout = lift layout - layoutState = lift . layoutState - -instance (Monoid w, MonadLayout m) => MonadLayout (Strict.RWST r w s m) where - layout = lift layout - layoutState = lift . layoutState - -instance (Monoid w, MonadLayout m) => MonadLayout (Lazy.RWST r w s m) where - layout = lift layout - layoutState = lift . layoutState - -instance MonadLayout m => MonadLayout (IdentityT m) where - layout = lift layout - layoutState = lift . layoutState diff --git a/Text/Trifecta/Parser/Layout/Combinators.hs b/Text/Trifecta/Parser/Layout/Combinators.hs deleted file mode 100644 --- a/Text/Trifecta/Parser/Layout/Combinators.hs +++ /dev/null @@ -1,56 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses #-} -module Text.Trifecta.Parser.Layout.Combinators - ( layoutEq - , getLayout - , setLayout - , modLayout - , disableLayout - , enableLayout - , laidout - ) where - -import Control.Applicative -import Control.Monad (guard) -import Data.Lens.Common -import Text.Trifecta.Rope.Delta -import Text.Trifecta.Parser.Class -import Text.Trifecta.Parser.Token.Combinators -import qualified Text.Trifecta.Highlight.Prim as Highlight -import Text.Trifecta.Parser.Layout.Class -import Text.Trifecta.Parser.Layout.Prim - -getLayout :: MonadLayout m => Lens LayoutState t -> m t -getLayout l = layoutState $ \s -> (getL l s, s) - -setLayout :: MonadLayout m => Lens LayoutState t -> t -> m () -setLayout l t = layoutState $ \s -> ((), setL l t s) - -modLayout :: MonadLayout m => Lens LayoutState t -> (t -> t) -> m () -modLayout l f = layoutState $ \s -> ((), modL l f s) - -disableLayout :: MonadLayout m => m a -> m a -disableLayout p = do - r <- rend - modLayout layoutStack (DisabledLayout r:) - result <- p - stk <- getLayout layoutStack - case stk of - DisabledLayout r':xs | delta r == delta r' -> result <$ setLayout layoutStack xs - _ -> unexpected "layout" - -enableLayout :: MonadLayout m => m a -> m a -enableLayout p = do - result <- highlight Highlight.Layout $ do - r <- rend - modLayout layoutStack (IndentedLayout r:) - p - result <$ layout "virtual right brace" - -laidout :: MonadLayout m => m a -> m a -laidout p = braces p <|> enableLayout p - -layoutEq :: MonadLayout m => LayoutToken -> m () -layoutEq s = try $ do - r <- layout - guard (s == r) - diff --git a/Text/Trifecta/Parser/Layout/Monad.hs b/Text/Trifecta/Parser/Layout/Monad.hs deleted file mode 100644 --- a/Text/Trifecta/Parser/Layout/Monad.hs +++ /dev/null @@ -1,113 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleInstances, UndecidableInstances #-} ------------------------------------------------------------------------------ --- | --- Module : Text.Trifecta.Parser.Layout.Monad --- Copyright : (C) 2011 Edward Kmett --- License : BSD-style (see the file LICENSE) --- --- Maintainer : Edward Kmett --- Stability : experimental --- Portability : non-portable --- ----------------------------------------------------------------------------- -module Text.Trifecta.Parser.Layout.Monad - ( Layout(..) - , runLayout - ) where - -import Control.Applicative -import Control.Category -import Control.Monad -import Control.Monad.State.Class -import Control.Monad.Trans.State.Strict (StateT(..)) -import Control.Monad.Writer.Class -import Control.Monad.Reader.Class -import Control.Monad.Cont.Class -import Control.Monad.Trans.Class -import Prelude hiding ((.), id) -import Text.Trifecta.Diagnostic.Class -import Text.Trifecta.Parser.Class -import Text.Trifecta.Parser.Mark -import Text.Trifecta.Parser.Combinators -import Text.Trifecta.Parser.Layout.Prim -import Text.Trifecta.Parser.Layout.Class -import Text.Trifecta.Parser.Layout.Combinators -import Text.Trifecta.Rope.Delta - --- | Adds Haskell-style "layout" to base parser -newtype Layout m a = Layout { unlayout :: StateT LayoutState m a } - deriving (Functor, Applicative, Alternative, Monad, MonadPlus, MonadTrans, MonadCont) - -runLayout :: Monad m => Layout m a -> LayoutState -> m (a, LayoutState) -runLayout = runStateT . unlayout - -instance MonadParser m => MonadParser (Layout m) where - satisfy p = try $ layoutEq Other *> lift (satisfy p) - satisfy8 p = try $ layoutEq Other *> lift (satisfy8 p) - line = lift line - unexpected = lift . unexpected - try = Layout . try . unlayout - labels m s = Layout $ labels (unlayout m) s - skipMany = Layout . skipMany . unlayout - highlightInterval h s e = lift $ highlightInterval h s e - someSpace = try $ (layoutEq WhiteSpace "") - nesting (Layout m) = disableLayout $ Layout (nesting m) - semi = getLayout layoutStack >>= \ stk -> case stk of - (DisabledLayout _:_) -> lift semi - _ -> try (';' <$ layoutEq VirtualSemi "virtual semi-colon") - <|> lift semi - skipping = lift . skipping - position = lift position - slicedWith f (Layout m) = Layout $ slicedWith f m - lookAhead (Layout m) = Layout $ lookAhead m - -instance MonadMark d m => MonadMark (LayoutMark d) (Layout m) where - mark = LayoutMark <$> getLayout id <*> lift mark - release (LayoutMark s m) = lift (release m) *> setLayout id s - -instance MonadDiagnostic e m => MonadDiagnostic e (Layout m) where - fatalWith xs r e = lift $ fatalWith xs r e - errWith xs r e = lift $ errWith xs r e - logWith l xs r e = lift $ logWith l xs r e - -instance MonadParser m => MonadLayout (Layout m) where - layout = buildLayoutParser (lift whiteSpace) - layoutState f = Layout . StateT $ return . f - -buildLayoutParser :: MonadLayout m => m () -> m LayoutToken -buildLayoutParser realWhiteSpace = do - bol <- getLayout layoutBol - m <- position - realWhiteSpace - r <- position - if near m r && not bol - then onside m r - else getLayout layoutStack >>= \stk -> case compare (column r) (depth stk) of - GT -> onside m r - EQ -> return VirtualSemi - LT -> case stk of - (IndentedLayout _:xs) -> VirtualRightBrace <$ setLayout layoutStack xs <* setLayout layoutBol True - _ -> unexpected "layout context" - where - onside m r - | r /= m = pure WhiteSpace - | otherwise = setLayout layoutBol False *> option Other (VirtualRightBrace <$ eof <* trailing) - trailing = getLayout layoutStack >>= \ stk -> case stk of - (IndentedLayout _:xs) -> setLayout layoutStack xs - _ -> empty - depth [] = 0 - depth (IndentedLayout r:_) = column r - depth (DisabledLayout _:_) = -1 - -instance MonadState s m => MonadState s (Layout m) where - get = Layout $ lift get - put = Layout . lift . put - -instance MonadReader e m => MonadReader e (Layout m) where - ask = Layout $ lift ask - local f (Layout m) = Layout $ local f m - -instance MonadWriter w m => MonadWriter w (Layout m) where - tell = Layout . lift . tell - listen (Layout m) = Layout $ listen m - pass (Layout m) = Layout $ pass m diff --git a/Text/Trifecta/Parser/Layout/Prim.hs b/Text/Trifecta/Parser/Layout/Prim.hs deleted file mode 100644 --- a/Text/Trifecta/Parser/Layout/Prim.hs +++ /dev/null @@ -1,75 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses #-} -module Text.Trifecta.Parser.Layout.Prim - ( LayoutToken(..) - , LayoutState(..) - , LayoutContext(..) - , LayoutMark(..) - , defaultLayoutState - , layoutBol - , layoutStack - ) where - -import Data.Functor -import Data.Lens.Common -import Data.Foldable -import Data.Semigroup.Foldable -import Data.Semigroup.Traversable -import Data.Traversable -import Text.Trifecta.Rope.Delta -import Text.Trifecta.Rope.Bytes -import Text.Trifecta.Diagnostic.Rendering.Prim - -data LayoutToken - = VirtualSemi - | VirtualRightBrace - | WhiteSpace - | Other - deriving (Eq,Ord,Show,Read) - -data LayoutContext - = IndentedLayout Rendering - | DisabledLayout Rendering - -instance HasDelta LayoutContext where - delta (IndentedLayout r) = delta r - delta (DisabledLayout r) = delta r - -instance HasBytes LayoutContext where - bytes = bytes . delta - -data LayoutState = LayoutState - { _layoutBol :: Bool - , _layoutStack :: [LayoutContext] - } - -defaultLayoutState :: LayoutState -defaultLayoutState = LayoutState False [] - -layoutBol :: Lens LayoutState Bool -layoutBol = lens _layoutBol (\s l -> l { _layoutBol = s}) - -layoutStack :: Lens LayoutState [LayoutContext] -layoutStack = lens _layoutStack (\s l -> l { _layoutStack = s}) - -data LayoutMark d = LayoutMark LayoutState d - -instance Functor LayoutMark where - fmap f (LayoutMark s a) = LayoutMark s (f a) - -instance Foldable LayoutMark where - foldMap f (LayoutMark _ a) = f a - -instance Traversable LayoutMark where - traverse f (LayoutMark s a) = LayoutMark s <$> f a - -instance Foldable1 LayoutMark where - foldMap1 f (LayoutMark _ a) = f a - -instance Traversable1 LayoutMark where - traverse1 f (LayoutMark s a) = LayoutMark s <$> f a - -instance HasDelta d => HasDelta (LayoutMark d) where - delta (LayoutMark _ d) = delta d - -instance HasBytes d => HasBytes (LayoutMark d) where - bytes (LayoutMark _ d) = bytes d diff --git a/Text/Trifecta/Parser/Literate.hs b/Text/Trifecta/Parser/Literate.hs deleted file mode 100644 --- a/Text/Trifecta/Parser/Literate.hs +++ /dev/null @@ -1,23 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Text.Trifecta.Parser.Literate --- Copyright : (C) 2011 Edward Kmett --- License : BSD-style (see the file LICENSE) --- --- Maintainer : Edward Kmett --- Stability : experimental --- Portability : non-portable --- ----------------------------------------------------------------------------- -module Text.Trifecta.Parser.Literate - ( Literate(..) - , LiterateMark(..) - , MonadLiterate(..) - , LiterateState(..) - , runLiterate - , defaultLiterateState - ) where - -import Text.Trifecta.Parser.Literate.Monad -import Text.Trifecta.Parser.Literate.Class -import Text.Trifecta.Parser.Literate.Prim diff --git a/Text/Trifecta/Parser/Literate/Class.hs b/Text/Trifecta/Parser/Literate/Class.hs deleted file mode 100644 --- a/Text/Trifecta/Parser/Literate/Class.hs +++ /dev/null @@ -1,43 +0,0 @@ -module Text.Trifecta.Parser.Literate.Class - ( MonadLiterate(..) - ) where - -import Control.Monad.Trans.Class -import Control.Monad.Trans.Reader -import Control.Monad.Trans.Identity -import qualified Control.Monad.Trans.State.Strict as Strict -import qualified Control.Monad.Trans.State.Lazy as Lazy -import qualified Control.Monad.Trans.Writer.Strict as Strict -import qualified Control.Monad.Trans.Writer.Lazy as Lazy -import qualified Control.Monad.Trans.RWS.Strict as Strict -import qualified Control.Monad.Trans.RWS.Lazy as Lazy -import Data.Monoid -import Text.Trifecta.Parser.Class -import Text.Trifecta.Parser.Literate.Prim - -class MonadParser m => MonadLiterate m where - literateState :: (LiterateState -> (a, LiterateState)) -> m a - -instance MonadLiterate m => MonadLiterate (Strict.StateT s m) where - literateState = lift . literateState - -instance MonadLiterate m => MonadLiterate (Lazy.StateT s m) where - literateState = lift . literateState - -instance (Monoid w, MonadLiterate m) => MonadLiterate (Strict.WriterT w m) where - literateState = lift . literateState - -instance (Monoid w, MonadLiterate m) => MonadLiterate (Lazy.WriterT w m) where - literateState = lift . literateState - -instance (Monoid w, MonadLiterate m) => MonadLiterate (Strict.RWST r w s m) where - literateState = lift . literateState - -instance (Monoid w, MonadLiterate m) => MonadLiterate (Lazy.RWST r w s m) where - literateState = lift . literateState - -instance MonadLiterate m => MonadLiterate (IdentityT m) where - literateState = lift . literateState - -instance MonadLiterate m => MonadLiterate (ReaderT e m) where - literateState = lift . literateState diff --git a/Text/Trifecta/Parser/Literate/Combinators.hs b/Text/Trifecta/Parser/Literate/Combinators.hs deleted file mode 100644 --- a/Text/Trifecta/Parser/Literate/Combinators.hs +++ /dev/null @@ -1,74 +0,0 @@ -module Text.Trifecta.Parser.Literate.Combinators - ( someLiterateSpace - , getLiterate - , putLiterate - ) where - -import Data.Char (isSpace) -import Control.Applicative -import Control.Monad -import Text.Trifecta.Rope.Delta -import qualified Text.Trifecta.Highlight.Prim as Highlight -import Text.Trifecta.Parser.Char -import Text.Trifecta.Parser.Class -import Text.Trifecta.Parser.Combinators -import Text.Trifecta.Parser.Literate.Prim -import Text.Trifecta.Parser.Literate.Class - -getLiterate :: MonadLiterate m => m LiterateState -getLiterate = literateState $ \s -> (s, s) - -putLiterate :: MonadLiterate m => LiterateState -> m () -putLiterate s = literateState $ \_ -> ((), s) - -skipLine :: MonadParser m => m () -skipLine = do - r <- restOfLine - skipping (delta r) - -someLiterateSpace :: MonadLiterate m => m () -someLiterateSpace = do - s <- getLiterate - case s of - IlliterateStart -> skipSome $ satisfy isSpace - LiterateStart -> position >>= \m -> track m <|> begin m <|> blank m <|> other m - LiterateCode -> do - skipSome $ satisfy isSpace - option () $ position >>= \m -> when (column m == 0) $ do - highlight Highlight.LiterateSyntax (string "\\end{code}") *> skipLine - begin m <|> blank m <|> other m - LiterateTrack -> skipSome horizontalSpace >> skipOptional bird - <|> bird - where - bird = newline *> position >>= \m -> track m <|> blank m - --- parse space excluding newlines -horizontalSpace :: MonadLiterate m => m Char -horizontalSpace = satisfy $ \s -> s /= '\n' && isSpace s - -track, begin, blank, other :: MonadLiterate m => Delta -> m () -track s = do - e <- position - try $ highlight Highlight.LiterateSyntax (char '>') - *> highlightInterval Highlight.LiterateComment s e - *> skipSome horizontalSpace - tracks <|> putLiterate LiterateTrack where - tracks = do - s' <- newline *> position - track s' <|> blank s' - -begin s = do - try $ highlight Highlight.LiterateSyntax (string "\begin{code}") *> skipLine - position >>= highlightInterval Highlight.LiterateComment s - putLiterate LiterateCode - whiteSpace - -other s = do - notChar '>' *> skipLine - begin s <|> blank s <|> other s - -blank s = do - k <- try $ do - skipMany horizontalSpace - True <$ newline <|> False <$ eof - when k $ track s <|> begin s <|> blank s <|> other s diff --git a/Text/Trifecta/Parser/Literate/Monad.hs b/Text/Trifecta/Parser/Literate/Monad.hs deleted file mode 100644 --- a/Text/Trifecta/Parser/Literate/Monad.hs +++ /dev/null @@ -1,84 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, GeneralizedNewtypeDeriving #-} -module Text.Trifecta.Parser.Literate.Monad - ( Literate(..) - , runLiterate - ) where - -import Control.Applicative -import Control.Monad -import Control.Monad.Trans.State.Strict (StateT(..)) -import Control.Monad.Trans.Class -import Control.Monad.State.Class -import Control.Monad.Cont.Class -import Control.Monad.Reader.Class -import Control.Monad.Writer.Class -import Data.Semigroup -import Text.Trifecta.Diagnostic.Class -import Text.Trifecta.Parser.Char -import Text.Trifecta.Parser.Class -import Text.Trifecta.Parser.Combinators -import Text.Trifecta.Parser.Mark -import Text.Trifecta.Parser.Language.Prim -import Text.Trifecta.Parser.Language.Class -import Text.Trifecta.Parser.Literate.Prim -import Text.Trifecta.Parser.Literate.Class -import Text.Trifecta.Parser.Literate.Combinators -import Text.Trifecta.Rope.Delta - -newtype Literate m a = Literate { unliterate :: StateT LiterateState m a } - deriving (Functor,Applicative,Alternative,Monad,MonadPlus,MonadTrans,MonadCont) - -runLiterate :: Monad m => Literate m a -> LiterateState -> m (a, LiterateState) -runLiterate = runStateT . unliterate - -instance MonadParser m => MonadParser (Literate m) where - someSpace = someLiterateSpace - highlightInterval h s e = lift $ highlightInterval h s e - try (Literate m) = Literate $ try m - nesting (Literate m) = Literate $ nesting m - skipMany (Literate m) = Literate $ skipMany m - slicedWith f (Literate m) = Literate $ slicedWith f m - labels (Literate m) p = Literate $ labels m p - semi = lift semi - line = lift line - satisfy = lift . satisfy - satisfy8 = lift . satisfy8 - unexpected = lift . unexpected - position = lift position - skipping d - | near (Columns 0 0) d = lift $ skipping d -- we don't change literate states within a line - | otherwise = do - s <- position - let e = s <> d - () <$ (manyTill (someSpace <|> () <$ anyChar) $ position >>= \p -> guard (e <= p)) - lookAhead (Literate (StateT p)) = Literate $ StateT $ \s -> do - as' <- lookAhead $ p s - return (fst as', s) - -instance MonadParser m => MonadLiterate (Literate m) where - literateState f = Literate $ StateT $ return . f - -instance MonadMark d m => MonadMark (LiterateMark d) (Literate m) where - mark = LiterateMark <$> getLiterate <*> lift mark - release (LiterateMark s d) = lift (release d) *> putLiterate s - -instance MonadLanguage m => MonadLanguage (Literate m) where - askLanguage = liftM liftLanguageDef $ lift askLanguage - -instance MonadDiagnostic e m => MonadDiagnostic e (Literate m) where - fatalWith xs rs e = lift $ fatalWith xs rs e - errWith xs rs e = lift $ errWith xs rs e - logWith l xs rs e = lift $ logWith l xs rs e - -instance MonadState s m => MonadState s (Literate m) where - get = lift get - put = lift . put - -instance MonadReader e m => MonadReader e (Literate m) where - ask = lift ask - local f (Literate m) = Literate $ local f m - -instance MonadWriter w m => MonadWriter w (Literate m) where - tell = lift . tell - listen (Literate m) = Literate $ listen m - pass (Literate m) = Literate $ pass m diff --git a/Text/Trifecta/Parser/Literate/Prim.hs b/Text/Trifecta/Parser/Literate/Prim.hs deleted file mode 100644 --- a/Text/Trifecta/Parser/Literate/Prim.hs +++ /dev/null @@ -1,49 +0,0 @@ -module Text.Trifecta.Parser.Literate.Prim - ( LiterateState(..) - , defaultLiterateState - , LiterateMark(..) - ) where - -import Data.Functor -import Data.Foldable -import Data.Traversable -import Data.Semigroup -import Data.Semigroup.Foldable -import Data.Semigroup.Traversable -import Text.Trifecta.Rope.Bytes -import Text.Trifecta.Rope.Delta - -data LiterateState - = LiterateStart -- ^ Parsing literate syntax - | IlliterateStart -- ^ Disable literate parsing - | LiterateCode -- ^ In the midst of a @\begin{code} ... \end{code}@ block - | LiterateTrack -- ^ In the midst of a @> ...@ block - -defaultLiterateState :: LiterateState -defaultLiterateState = LiterateStart - -data LiterateMark d = LiterateMark LiterateState d - -instance Functor LiterateMark where - fmap f (LiterateMark s a) = LiterateMark s (f a) - -instance Foldable LiterateMark where - foldMap f (LiterateMark _ a) = f a - -instance Traversable LiterateMark where - traverse f (LiterateMark s a) = LiterateMark s <$> f a - -instance Foldable1 LiterateMark where - foldMap1 f (LiterateMark _ a) = f a - -instance Traversable1 LiterateMark where - traverse1 f (LiterateMark s a) = LiterateMark s <$> f a - -instance HasDelta d => HasDelta (LiterateMark d) where - delta (LiterateMark _ d) = delta d - -instance HasBytes d => HasBytes (LiterateMark d) where - bytes (LiterateMark _ d) = bytes d - -instance Semigroup d => Semigroup (LiterateMark d) where - LiterateMark _ d <> LiterateMark s e = LiterateMark s (d <> e) diff --git a/Text/Trifecta/Parser/Prim.hs b/Text/Trifecta/Parser/Prim.hs --- a/Text/Trifecta/Parser/Prim.hs +++ b/Text/Trifecta/Parser/Prim.hs @@ -43,7 +43,6 @@ import Text.Trifecta.Diagnostic.Err import Text.Trifecta.Diagnostic.Err.State import Text.Trifecta.Diagnostic.Err.Log -import Text.Trifecta.Diagnostic.Rendering.Prim import Text.Trifecta.Diagnostic.Rendering.Caret import Text.Trifecta.Highlight.Class import Text.Trifecta.Highlight.Prim @@ -101,7 +100,6 @@ instance Alternative (Parser e) where empty = Parser $ \_ ee _ _ -> ee mempty {-# INLINE empty #-} - -- Parser m <|> Parser n = Parser $ \ eo ee co ce -> m eo (n eo ee co ce) co ce Parser m <|> Parser n = Parser $ \ eo ee co ce -> m eo (\e -> n (\a e'-> eo a (e <> e')) (\e' -> ee (e <> e')) co ce) co ce @@ -127,7 +125,7 @@ {-# INLINE (>>=) #-} (>>) = (*>) {-# INLINE (>>) #-} - fail s = Parser $ \ _ ee _ _ -> ee mempty { errMessage = FailErr s } + fail s = Parser $ \ _ ee _ _ l b8 d bs -> ee mempty { errMessage = FailErr (renderingCaret d bs) s } l b8 d bs {-# INLINE fail #-} @@ -152,21 +150,18 @@ (\ e' l' -> ce e' (l <> l')) mempty {-# INLINE pass #-} + manyAccum :: (a -> [a] -> [a]) -> Parser e a -> Parser e [a] manyAccum acc (Parser p) = Parser $ \eo _ co ce -> let walk xs x _ = p manyErr (\_ -> co (acc x xs) mempty) (walk (acc x xs)) ce - -- NB: to squelch this error you can change your grammar to add a commit, if you are progressing - -- in some other fashion - manyErr _ e = ce e { errMessage = PanicErr "'many' applied to a parser that accepted an empty string" } + manyErr _ e l b8 d bs = ce e { errMessage = PanicErr (renderingCaret d bs) "'many' applied to a parser that accepted an empty string" } l b8 d bs in p manyErr (eo []) (walk []) ce instance MonadDiagnostic e (Parser e) where - fatalWith ds rs e = Parser $ \_ _ _ ce -> - ce mempty { errMessage = Err rs Fatal e ds } - errWith ds rs e = Parser $ \_ ee _ _ -> - ee mempty { errMessage = Err rs Error e ds } - logWith v ds rs e = Parser $ \eo _ _ _ l b8 d bs -> - eo () mempty l { errLog = errLog l |> Diagnostic (Right $ addCaret d $ Prelude.foldr (<>) (rendering d bs) rs) v e ds } b8 d bs + throwDiagnostic e@(Diagnostic _ l _ _) + | l == Fatal || l == Panic = Parser $ \_ _ _ ce -> ce mempty { errMessage = Err e } + | otherwise = Parser $ \_ ee _ _ -> ee mempty { errMessage = Err e } + logDiagnostic d = Parser $ \eo _ _ _ l -> eo () mempty l { errLog = errLog l |> d } instance MonadError (ErrState e) (Parser e) where throwError m = Parser $ \_ ee _ _ -> ee m @@ -185,7 +180,6 @@ {-# INLINE liftIt #-} instance MonadParser (Parser e) where - -- commit (Parser m) = Parser $ \ _ _ co ce -> m co ce co ce try (Parser m) = Parser $ \ eo ee co ce l b8 d bs -> m eo ee co (\e l' _ _ _ -> if fatalErr (errMessage e) then ce e (l <> l') b8 d bs @@ -200,7 +194,7 @@ release $ m <> d {-# INLINE skipping #-} - unexpected s = Parser $ \ _ ee _ _ -> ee mempty { errMessage = FailErr $ "unexpected " ++ s } + unexpected s = Parser $ \ _ ee _ _ l b8 d bs -> ee mempty { errMessage = FailErr (renderingCaret d bs) $ "unexpected " ++ s } l b8 d bs {-# INLINE unexpected #-} labels (Parser p) msgs = Parser $ \ eo ee -> p @@ -227,9 +221,9 @@ (\d' bs' -> co c mempty l (ascii bs') d' bs') ddc | otherwise -> co c mempty l b8 (d <> delta c) bs - else ee mempty { errMessage = FailErr "unexpected EOF" } l b8 d bs) + else ee mempty { errMessage = FailErr (renderingCaret d bs) "unexpected EOF" } l b8 d bs) else case UTF8.uncons $ Strict.drop (fromIntegral (columnByte d)) bs of - Nothing -> ee mempty { errMessage = FailErr "unexpected EOF" } l b8 d bs + Nothing -> ee mempty { errMessage = FailErr (renderingCaret d bs) "unexpected EOF" } l b8 d bs Just (c, xs) | not (f c) -> ee mempty l b8 d bs | Strict.null xs -> let !ddc = d <> delta c @@ -251,7 +245,7 @@ (\d' bs' -> co c mempty l (ascii bs') d' bs') ddc | otherwise -> co c mempty l b8 (d <> delta c) bs - else ee mempty { errMessage = FailErr "unexpected EOF" } l b8 d bs + else ee mempty { errMessage = FailErr (renderingCaret d bs) "unexpected EOF" } l b8 d bs position = Parser $ \eo _ _ _ l b8 d -> eo d mempty l b8 d {-# INLINE position #-} slicedWith f p = do @@ -299,7 +293,7 @@ why pp (ErrState ss m) hs _ d bs | Prelude.null now = explicateWith empty m | knownErr m = explicateWith (char ',' <+> ex) m - | otherwise = Diagnostic r Error ex notes + | otherwise = Diagnostic rightHere Error ex notes where ex = expect now ignoreBlanks = go . List.nub . List.sort where @@ -307,19 +301,24 @@ go [""] = ["space"] go xs = List.filter (/= "") xs expect xs = text "expected:" <+> fillSep (punctuate (char ',') (Prelude.map text $ ignoreBlanks $ Prelude.map extract xs)) - (now,later) = List.partition ((==) d . delta) $ toList ss - -- attach notes for expected tokens at remote locations, clustered by location + (now,later) = List.partition (\x -> errLoc m == Just (delta x)) $ toList ss clusters = List.groupBy ((==) `on` delta) $ List.sortBy (compare `on` delta) later - diagnoseCluster c = Diagnostic (Right $ addCaret dc $ addHighlights hs $ rendering dc bsc) Note (expect c) [] where + diagnoseCluster c = Diagnostic (Right $ addHighlights hs $ renderingCaret dc bsc) Note (expect c) [] where _ :^ Caret dc bsc = Prelude.head c notes = Prelude.map diagnoseCluster clusters + rightHere = Right $ addHighlights hs $ renderingCaret d bs - r = Right $ addCaret d $ addHighlights hs $ rendering d bs - explicateWith x EmptyErr = Diagnostic r Error ((text "unspecified error") <> x) notes - explicateWith x (FailErr s) = Diagnostic r Error ((fillSep $ text <$> words s) <> x) notes - explicateWith x (PanicErr s) = Diagnostic r Panic ((fillSep $ text <$> words s) <> x) notes - explicateWith x (Err rs l e es) = Diagnostic r' l (pp e <> x) (notes ++ fmap (addHighlights hs . fmap pp) es) - where r' = Right $ addCaret d $ Prelude.foldr (<>) (addHighlights hs $ rendering d bs) rs + explicateWith x EmptyErr = Diagnostic rightHere Error ((text "unspecified error") <> x) notes + explicateWith x (FailErr r s) = Diagnostic (Right $ addHighlights hs r) Error ((fillSep $ text <$> words s) <> x) notes + explicateWith x (PanicErr r s) = Diagnostic (Right $ addHighlights hs r) Panic ((fillSep $ text <$> words s) <> x) notes + explicateWith x (Err (Diagnostic r l e es)) = Diagnostic (addHighlights hs <$> r) l (pp e <> x) (notes ++ fmap (addHighlights hs . fmap pp) es) + + errLoc EmptyErr = Just d + errLoc (FailErr r _) = Just $ delta r + errLoc (PanicErr r _) = Just $ delta r + errLoc (Err (Diagnostic (Left _) _ _ _)) = Nothing + errLoc (Err (Diagnostic (Right r) _ _ _)) = Just $ delta r + parseTest :: Show a => Parser String a -> String -> IO () parseTest p s = case starve diff --git a/Text/Trifecta/Parser/Rich.hs b/Text/Trifecta/Parser/Rich.hs --- a/Text/Trifecta/Parser/Rich.hs +++ b/Text/Trifecta/Parser/Rich.hs @@ -15,10 +15,10 @@ ) where import Control.Monad (liftM) -import Text.Trifecta.Parser.Layout -import Text.Trifecta.Parser.Language -import Text.Trifecta.Parser.Language.Prim -import Text.Trifecta.Parser.Literate +import Text.Trifecta.Layout +import Text.Trifecta.Language +import Text.Trifecta.Language.Prim +import Text.Trifecta.Literate type Rich m = Layout (Language (Literate m)) diff --git a/trifecta.cabal b/trifecta.cabal --- a/trifecta.cabal +++ b/trifecta.cabal @@ -1,6 +1,6 @@ name: trifecta category: Text, Parsing, Diagnostics, Pretty Printer, Logging -version: 0.46 +version: 0.47 license: BSD3 cabal-version: >= 1.6 license-file: LICENSE @@ -57,6 +57,22 @@ Text.Trifecta.Highlight.Prim Text.Trifecta.Highlight.Effects Text.Trifecta.Highlight.Rendering.HTML + Text.Trifecta.Language + Text.Trifecta.Language.Class + Text.Trifecta.Language.Combinators + Text.Trifecta.Language.Prim + Text.Trifecta.Language.Monad + Text.Trifecta.Language.Style + Text.Trifecta.Layout + Text.Trifecta.Layout.Class + Text.Trifecta.Layout.Combinators + Text.Trifecta.Layout.Monad + Text.Trifecta.Layout.Prim + Text.Trifecta.Literate + Text.Trifecta.Literate.Class + Text.Trifecta.Literate.Prim + Text.Trifecta.Literate.Combinators + Text.Trifecta.Literate.Monad Text.Trifecta.Parser Text.Trifecta.Parser.ByteString Text.Trifecta.Parser.Char @@ -65,22 +81,6 @@ Text.Trifecta.Parser.Combinators Text.Trifecta.Parser.Expr Text.Trifecta.Parser.It - Text.Trifecta.Parser.Language - Text.Trifecta.Parser.Language.Class - Text.Trifecta.Parser.Language.Combinators - Text.Trifecta.Parser.Language.Prim - Text.Trifecta.Parser.Language.Monad - Text.Trifecta.Parser.Language.Style - Text.Trifecta.Parser.Literate - Text.Trifecta.Parser.Literate.Class - Text.Trifecta.Parser.Literate.Prim - Text.Trifecta.Parser.Literate.Combinators - Text.Trifecta.Parser.Literate.Monad - Text.Trifecta.Parser.Layout - Text.Trifecta.Parser.Layout.Class - Text.Trifecta.Parser.Layout.Combinators - Text.Trifecta.Parser.Layout.Monad - Text.Trifecta.Parser.Layout.Prim Text.Trifecta.Parser.Mark Text.Trifecta.Parser.Perm Text.Trifecta.Parser.Prim