trifecta 0.46 → 0.47

raw patch · 45 files changed

+1079/−982 lines, 45 files

Files

• Text/Trifecta.hs +8/−2
• Text/Trifecta/Diagnostic.hs +7/−9
• Text/Trifecta/Diagnostic/Class.hs +18/−27
• Text/Trifecta/Diagnostic/Combinators.hs +32/−32
• Text/Trifecta/Diagnostic/Err.hs +23/−21
• Text/Trifecta/Diagnostic/Level.hs +3/−3
• Text/Trifecta/Diagnostic/Prim.hs +0/−4
• Text/Trifecta/Diagnostic/Rendering.hs +1/−1
• Text/Trifecta/Diagnostic/Rendering/Caret.hs +4/−0
• Text/Trifecta/Language.hs +34/−0
• Text/Trifecta/Language/Class.hs +59/−0
• Text/Trifecta/Language/Combinators.hs +42/−0
• Text/Trifecta/Language/Monad.hs +79/−0
• Text/Trifecta/Language/Prim.hs +28/−0
• Text/Trifecta/Language/Style.hs +26/−0
• Text/Trifecta/Layout.hs +23/−0
• Text/Trifecta/Layout/Class.hs +64/−0
• Text/Trifecta/Layout/Combinators.hs +67/−0
• Text/Trifecta/Layout/Monad.hs +112/−0
• Text/Trifecta/Layout/Prim.hs +86/−0
• Text/Trifecta/Literate.hs +23/−0
• Text/Trifecta/Literate/Class.hs +54/−0
• Text/Trifecta/Literate/Combinators.hs +85/−0
• Text/Trifecta/Literate/Monad.hs +94/−0
• Text/Trifecta/Literate/Prim.hs +60/−0
• Text/Trifecta/Parser.hs +0/−6
• Text/Trifecta/Parser/Language.hs +0/−34
• Text/Trifecta/Parser/Language/Class.hs +0/−48
• Text/Trifecta/Parser/Language/Combinators.hs +0/−42
• Text/Trifecta/Parser/Language/Monad.hs +0/−69
• Text/Trifecta/Parser/Language/Prim.hs +0/−17
• Text/Trifecta/Parser/Language/Style.hs +0/−26
• Text/Trifecta/Parser/Layout.hs +0/−23
• Text/Trifecta/Parser/Layout/Class.hs +0/−53
• Text/Trifecta/Parser/Layout/Combinators.hs +0/−56
• Text/Trifecta/Parser/Layout/Monad.hs +0/−113
• Text/Trifecta/Parser/Layout/Prim.hs +0/−75
• Text/Trifecta/Parser/Literate.hs +0/−23
• Text/Trifecta/Parser/Literate/Class.hs +0/−43
• Text/Trifecta/Parser/Literate/Combinators.hs +0/−74
• Text/Trifecta/Parser/Literate/Monad.hs +0/−84
• Text/Trifecta/Parser/Literate/Prim.hs +0/−49
• Text/Trifecta/Parser/Prim.hs +26/−27
• Text/Trifecta/Parser/Rich.hs +4/−4
• trifecta.cabal +17/−17

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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 = (<!>)

@@ -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) 

@@ -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

@@ -11,7 +11,7 @@ ---------------------------------------------------------------------------- module Text.Trifecta.Diagnostic.Rendering   ( Renderable(..)-  , Source, rendering+  , Source, rendering, renderingCaret   , Caret(..), Careted(..)   , Span(..), Spanned(..)   , Fixit(..), Rendered(..)

@@ -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) 

@@ -0,0 +1,34 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Trifecta.Language+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- 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+

@@ -0,0 +1,59 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Trifecta.Language.Class+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- 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

@@ -0,0 +1,42 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Trifecta.Language.Combinators+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- 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

@@ -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 <ekmett@gmail.com>+-- 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)

@@ -0,0 +1,28 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Trifecta.Language.Prim+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- 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)

@@ -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

@@ -0,0 +1,23 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Trifecta.Parser.Layout+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- 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

@@ -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 <ekmett@gmail.com>+-- 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

@@ -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 <ekmett@gmail.com>+-- 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)+

@@ -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 <ekmett@gmail.com>+-- 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

@@ -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 <ekmett@gmail.com>+-- 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

@@ -0,0 +1,23 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Trifecta.Parser.Literate+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- 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

@@ -0,0 +1,54 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Trifecta.Literate.Class+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- 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

@@ -0,0 +1,85 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Trifecta.Literate.Combinators+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- 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

@@ -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 <ekmett@gmail.com>+-- 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

@@ -0,0 +1,60 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Trifecta.Literate.Prim+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- 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)

@@ -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

@@ -1,34 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.Trifecta.Parser.Language--- Copyright   :  (C) 2011 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- 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-

@@ -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

@@ -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 <ekmett@gmail.com>--- 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

@@ -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)

@@ -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)

@@ -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

@@ -1,23 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.Trifecta.Parser.Layout--- Copyright   :  (C) 2011 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- 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

@@ -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

@@ -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)-

@@ -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 <ekmett@gmail.com>--- 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

@@ -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

@@ -1,23 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.Trifecta.Parser.Literate--- Copyright   :  (C) 2011 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- 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

@@ -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

@@ -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

@@ -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

@@ -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)

@@ -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

@@ -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)) 

@@ -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