trifecta 0.45 → 0.46

raw patch · 18 files changed

+354/−65 lines, 18 files

Files

• Text/Trifecta.hs +1/−1
• Text/Trifecta/Highlight/Prim.hs +2/−0
• Text/Trifecta/Parser.hs +16/−15
• Text/Trifecta/Parser/Haskell.hs +0/−18
• Text/Trifecta/Parser/Language.hs +1/−1
• Text/Trifecta/Parser/Language/Class.hs +1/−1
• Text/Trifecta/Parser/Language/Combinators.hs +7/−7
• Text/Trifecta/Parser/Language/Def.hs +0/−17
• Text/Trifecta/Parser/Language/Monad.hs +1/−1
• Text/Trifecta/Parser/Language/Prim.hs +17/−0
• Text/Trifecta/Parser/Language/Style.hs +1/−1
• Text/Trifecta/Parser/Literate.hs +23/−0
• Text/Trifecta/Parser/Literate/Class.hs +43/−0
• Text/Trifecta/Parser/Literate/Combinators.hs +74/−0
• Text/Trifecta/Parser/Literate/Monad.hs +84/−0
• Text/Trifecta/Parser/Literate/Prim.hs +49/−0
• Text/Trifecta/Parser/Rich.hs +26/−0
• trifecta.cabal +8/−3

@@ -9,7 +9,7 @@ -- Portability :  non-portable -- -----------------------------------------------------------------------------module Text.Trifecta +module Text.Trifecta   ( module Text.Trifecta.Diagnostic   , module Text.Trifecta.Parser   , module Text.Trifecta.Rope

@@ -40,6 +40,8 @@   | Unbound   | Layout   | MatchedSymbols+  | LiterateComment+  | LiterateSyntax   deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded)  type Highlights = IntervalMap Delta Highlight

@@ -10,17 +10,18 @@ -- ---------------------------------------------------------------------------- module Text.Trifecta.Parser-  ( module Text.Trifecta.Parser.Prim-  , module Text.Trifecta.Parser.ByteString-  , module Text.Trifecta.Parser.Class+  ( module Text.Trifecta.Parser.ByteString   , module Text.Trifecta.Parser.Char+  , module Text.Trifecta.Parser.Class   , module Text.Trifecta.Parser.Combinators   , module Text.Trifecta.Parser.Identifier-  , module Text.Trifecta.Parser.Token-  , module Text.Trifecta.Parser.Result   , module Text.Trifecta.Parser.Language   , module Text.Trifecta.Parser.Layout-  , module Text.Trifecta.Parser.Haskell+  , module Text.Trifecta.Parser.Literate+  , module Text.Trifecta.Parser.Prim+  , module Text.Trifecta.Parser.Result+  , module Text.Trifecta.Parser.Rich+  , module Text.Trifecta.Parser.Token   -- * Expressive Diagnostics   -- ** Text.Trifecta.Diagnostic.Rendering.Caret   , caret@@ -33,20 +34,20 @@    ) where -import Text.Trifecta.Parser.Prim+import Text.Trifecta.Diagnostic.Rendering.Caret (caret, careted)+import Text.Trifecta.Diagnostic.Rendering.Span  (span, spanned)+import Text.Trifecta.Diagnostic.Rendering.Fixit (fixit) import Text.Trifecta.Parser.ByteString-import Text.Trifecta.Parser.Class import Text.Trifecta.Parser.Char+import Text.Trifecta.Parser.Class import Text.Trifecta.Parser.Combinators import Text.Trifecta.Parser.Identifier-import Text.Trifecta.Parser.Token-import Text.Trifecta.Parser.Result import Text.Trifecta.Parser.Language import Text.Trifecta.Parser.Layout-import Text.Trifecta.Parser.Haskell--import Text.Trifecta.Diagnostic.Rendering.Caret (caret, careted)-import Text.Trifecta.Diagnostic.Rendering.Span  (span, spanned)-import Text.Trifecta.Diagnostic.Rendering.Fixit (fixit)+import Text.Trifecta.Parser.Literate+import Text.Trifecta.Parser.Prim+import Text.Trifecta.Parser.Result+import Text.Trifecta.Parser.Rich+import Text.Trifecta.Parser.Token  import Prelude ()

@@ -1,18 +0,0 @@-module Text.Trifecta.Parser.Haskell-  ( Haskell-  , haskell-  , haskell98-  ) where--import Data.Functor-import Text.Trifecta.Parser.Class-import Text.Trifecta.Parser.Layout-import Text.Trifecta.Parser.Language--type Haskell m = Layout (Language m)--haskell :: MonadParser m => Haskell m a -> m a-haskell p = runLanguage (fst <$> runLayout p defaultLayoutState) haskellLanguageDef--haskell98 :: MonadParser m => Haskell m a -> m a-haskell98 p = runLanguage (fst <$> runLayout p defaultLayoutState) haskell98LanguageDef

@@ -28,7 +28,7 @@  import Text.Trifecta.Parser.Language.Class import Text.Trifecta.Parser.Language.Combinators-import Text.Trifecta.Parser.Language.Def+import Text.Trifecta.Parser.Language.Prim import Text.Trifecta.Parser.Language.Monad import Text.Trifecta.Parser.Language.Style 

@@ -14,7 +14,7 @@ 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.Def+import Text.Trifecta.Parser.Language.Prim import Text.Trifecta.Parser.Class  class MonadParser m => MonadLanguage m where

@@ -20,23 +20,23 @@  import Data.ByteString import Text.Trifecta.Parser.Language.Class-import Text.Trifecta.Parser.Language.Def+import Text.Trifecta.Parser.Language.Prim import Text.Trifecta.Parser.Identifier  identifier :: MonadLanguage m => m ByteString-identifier = asksLanguage languageIdentifiers >>= ident+identifier = asksLanguage languageIdentifierStyle >>= ident  reserved :: MonadLanguage m => String -> m ()-reserved i = asksLanguage languageIdentifiers >>= \style -> reserve style i+reserved i = asksLanguage languageIdentifierStyle >>= \style -> reserve style i  reservedByteString :: MonadLanguage m => ByteString -> m ()-reservedByteString i = asksLanguage languageIdentifiers >>= \style -> reserveByteString style i+reservedByteString i = asksLanguage languageIdentifierStyle >>= \style -> reserveByteString style i  op :: MonadLanguage m => m ByteString-op = asksLanguage languageOperators >>= ident+op = asksLanguage languageOperatorStyle >>= ident  reservedOp :: MonadLanguage m => String -> m ()-reservedOp i = asksLanguage languageOperators >>= \style -> reserve style i+reservedOp i = asksLanguage languageOperatorStyle >>= \style -> reserve style i  reservedOpByteString :: MonadLanguage m => ByteString -> m ()-reservedOpByteString i = asksLanguage languageOperators >>= \style -> reserveByteString style i+reservedOpByteString i = asksLanguage languageOperatorStyle >>= \style -> reserveByteString style i

@@ -1,17 +0,0 @@-module Text.Trifecta.Parser.Language.Def-  ( 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-  , languageIdentifiers  :: IdentifierStyle m-  , languageOperators    :: IdentifierStyle m-  }--liftLanguageDef :: (MonadTrans t, Monad m) => LanguageDef m -> LanguageDef (t m)-liftLanguageDef (LanguageDef c i o) = LanguageDef c (liftIdentifierStyle i) (liftIdentifierStyle o)

@@ -15,7 +15,7 @@ import Text.Trifecta.Parser.Class import Text.Trifecta.Parser.Mark import Text.Trifecta.Parser.Token.Style-import Text.Trifecta.Parser.Language.Def+import Text.Trifecta.Parser.Language.Prim import Text.Trifecta.Parser.Language.Class  newtype Language m a = Language { unlanguage :: ReaderT (LanguageDef (Language m)) m a }

@@ -0,0 +1,17 @@+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)

@@ -18,7 +18,7 @@ import Text.Trifecta.Parser.Class import Text.Trifecta.Parser.Token.Style import Text.Trifecta.Parser.Identifier.Style-import Text.Trifecta.Parser.Language.Def+import Text.Trifecta.Parser.Language.Prim  emptyLanguageDef, haskellLanguageDef, haskell98LanguageDef :: MonadParser m => LanguageDef m emptyLanguageDef     = LanguageDef emptyCommentStyle   emptyIdents     emptyOps

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

@@ -0,0 +1,43 @@+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

@@ -0,0 +1,74 @@+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

@@ -0,0 +1,84 @@+{-# 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

@@ -0,0 +1,49 @@+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)

@@ -0,0 +1,26 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Trifecta.Parser.Rich+-- 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.Rich+  ( Rich+  , rich+  ) 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++type Rich m = Layout (Language (Literate m))++rich :: Monad m => LiterateState -> LanguageDef m -> Rich m a -> m (a, LiterateState)+rich lit def p = runLiterate (runLanguage (fst `liftM` runLayout p defaultLayoutState) (liftLanguageDef (liftLanguageDef def))) lit

@@ -1,6 +1,6 @@ name:          trifecta category:      Text, Parsing, Diagnostics, Pretty Printer, Logging-version:       0.45+version:       0.46 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -65,13 +65,17 @@     Text.Trifecta.Parser.Combinators     Text.Trifecta.Parser.Expr     Text.Trifecta.Parser.It-    Text.Trifecta.Parser.Haskell     Text.Trifecta.Parser.Language     Text.Trifecta.Parser.Language.Class     Text.Trifecta.Parser.Language.Combinators-    Text.Trifecta.Parser.Language.Def+    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@@ -81,6 +85,7 @@     Text.Trifecta.Parser.Perm     Text.Trifecta.Parser.Prim     Text.Trifecta.Parser.Result+    Text.Trifecta.Parser.Rich     Text.Trifecta.Parser.Step     Text.Trifecta.Parser.Token     Text.Trifecta.Parser.Token.Combinators