packages feed

trifecta 0.44 → 0.45

raw patch · 28 files changed

+627/−563 lines, 28 files

Files

Text/Trifecta/Diagnostic/Rendering/Caret.hs view
@@ -61,11 +61,11 @@ addCaret p r = drawCaret p .# r  caret :: MonadParser m => m Caret-caret = Caret <$> mark <*> line+caret = Caret <$> position <*> line    careted :: MonadParser m => m a -> m (Careted a) careted p = do-  m <- mark+  m <- position   l <- line   a <- p   return $ a :^ Caret m l
Text/Trifecta/Diagnostic/Rendering/Span.hs view
@@ -95,13 +95,13 @@      b :~ t -> b :~ (s <> t)  instance Foldable Spanned where-  foldMap f (a :~ _) = f a +  foldMap f (a :~ _) = f a  instance Traversable Spanned where   traverse f (a :~ s) = (:~ s) <$> f a  instance Foldable1 Spanned where-  foldMap1 f (a :~ _) = f a +  foldMap1 f (a :~ _) = f a  instance Traversable1 Spanned where   traverse1 f (a :~ s) = (:~ s) <$> f a@@ -118,8 +118,8 @@ instance Hashable a => Hashable (Spanned a) where   hash (a :~ s) = hash a `hashWithSalt` s -span :: MonadParser m => m a -> m Span -span p = (\s l e -> Span s e l) <$> mark <*> line <*> (p *> mark)-  +span :: MonadParser m => m a -> m Span+span p = (\s l e -> Span s e l) <$> position <*> line <*> (p *> position)+ spanned :: MonadParser m => m a -> m (Spanned a)-spanned p = (\s l a e -> a :~ Span s e l) <$> mark <*> line <*> p <*> mark+spanned p = (\s l a e -> a :~ Span s e l) <$> position <*> line <*> p <*> position
Text/Trifecta/Parser.hs view
@@ -15,6 +15,7 @@   , module Text.Trifecta.Parser.Class   , module Text.Trifecta.Parser.Char   , 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@@ -37,6 +38,7 @@ import Text.Trifecta.Parser.Class import Text.Trifecta.Parser.Char 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
Text/Trifecta/Parser/ByteString.hs view
@@ -5,11 +5,11 @@ -- Module      :  Text.Trifecta.Parser.ByteString -- Copyright   :  (c) Edward Kmett 2011 -- License     :  BSD-style (see the LICENSE file)--- +-- -- Maintainer  :  ekmett@gmail.com -- Stability   :  experimental -- Portability :  non-portable (mptcs, fundeps)--- +-- -- Loading a file as a strict bytestring in one step. -- -----------------------------------------------------------------------------@@ -26,7 +26,7 @@ import Data.Foldable import qualified Data.ByteString as B import System.Console.Terminfo.PrettyPrint-import Text.Trifecta.Parser.Class+import Text.Trifecta.Parser.Mark import Text.Trifecta.Parser.Prim import Text.Trifecta.Parser.Step import Text.Trifecta.Rope.Delta@@ -48,9 +48,9 @@ -- >     Just a  -> print $ sum a  parseFromFile :: Show a => Parser String a -> String -> IO (Maybe a)-parseFromFile p fn = do +parseFromFile p fn = do   result <- parseFromFileEx p fn-  case result of +  case result of      Success xs a -> Just a  <$ unless (Seq.null xs) (displayLn (toList xs))      Failure xs   -> Nothing <$ unless (Seq.null xs) (displayLn (toList xs)) @@ -62,19 +62,19 @@ -- >   result <- parseFromFileEx (many number) "digits.txt" -- >   case result of -- >     Failure xs -> unless (Seq.null xs) $ displayLn xs--- >     Success xs a  -> +-- >     Success xs a  -> -- >       unless (Seq.null xs) $ displayLn xs -- >       print $ sum a -- >  parseFromFileEx :: Show a => Parser String a -> String -> IO (Result TermDoc a)-parseFromFileEx p fn = k <$> B.readFile fn where -  k i = starve +parseFromFileEx p fn = k <$> B.readFile fn where+  k i = starve       $ feed (rope (F.fromList [LineDirective (UTF8.fromString fn) 0, strand i]))-      $ stepParser (fmap prettyTerm) -                   (why prettyTerm) -                   (release (Directed (UTF8.fromString fn) 0 0 0 0) *> p) -                   mempty -                   True -                   mempty -                   mempty +      $ stepParser (fmap prettyTerm)+                   (why prettyTerm)+                   (release (Directed (UTF8.fromString fn) 0 0 0 0) *> p)+                   mempty+                   True+                   mempty+                   mempty
Text/Trifecta/Parser/Class.hs view
@@ -1,25 +1,24 @@ {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances, FlexibleInstances, FlexibleContexts #-}- ----------------------------------------------------------------------------- -- | -- Module      :  Text.Trifecta.Parser.Class -- Copyright   :  (c) Edward Kmett 2011 -- License     :  BSD3--- +-- -- Maintainer  :  ekmett@gmail.com -- Stability   :  experimental -- Portability :  non-portable--- +-- ------------------------------------------------------------------------------module Text.Trifecta.Parser.Class +module Text.Trifecta.Parser.Class   ( MonadParser(..)   , satisfyAscii   , restOfLine   , (<?>)-  , skipping-  , slicedWith   , sliced   , rend+  , whiteSpace+  , highlight   ) where  import Control.Applicative@@ -36,216 +35,254 @@ import Data.Functor.Yoneda import Data.Word import Data.ByteString as Strict+import Data.Char (isSpace) import Data.ByteString.Internal (w2c) import Data.Semigroup import Text.Trifecta.Rope.Delta-import Text.Trifecta.Rope.Prim-import Text.Trifecta.Parser.It import Text.Trifecta.Highlight.Prim import Text.Trifecta.Diagnostic.Rendering.Prim--- import Control.Monad.Trans.Maybe.Strict as Strict--- import Control.Monad.Trans.Either.Strict as Strict--- import Control.Monad.Codensity  infix 0 <?> -class ( Alternative m, MonadPlus m) => MonadParser m where+class (Alternative m, MonadPlus m) => MonadParser m where   -- | Take a parser that may consume input, and on failure, go back to where we started and fail as if we didn't consume input.   try :: m a -> m a+   -- Used to implement (<?>), runs the parser then sets the 'expected' tokens to the list supplied   labels :: m a -> [String] -> m a+   -- | A version of many that discards its input. Specialized because it can often be implemented more cheaply.-  skipMany   :: m a -> m ()-  skipMany p = () <$ many p +  skipMany :: m a -> m ()+  skipMany p = () <$ many p+   -- | Parse a single character of the input, with UTF-8 decoding-  satisfy  :: (Char -> Bool) -> m Char+  satisfy :: (Char -> Bool) -> m Char+   -- | Parse a single byte of the input, without UTF-8 decoding   satisfy8 :: (Word8 -> Bool) -> m Word8-  -- | @highlight@ is called internally in the token parsers.-  -- It delimits ranges of the input recognized by certain parsers that -  -- are useful for syntax highlighting. An interested monad could-  -- choose to listen to these events and construct an interval tree-  -- for later pretty printing purposes.-  highlight :: Highlight -> m a -> m a-  highlight _ m = m +  -- | Usually, someSpace consists of /one/ or more occurrences of a 'space'.+  -- Some parsers may choose to recognize line comments or block (multi line)+  -- comments as white space as well.+  someSpace :: m ()+  someSpace = space *> skipMany space+    where space = satisfy isSpace +  -- | Called when we enter a nested pair of symbols.+  -- Overloadable to disable layout or highlight nested contexts.+  nesting :: m a -> m a+  nesting = id -  -- | Lift an operation from the primitive It monad-  liftIt     :: It Rope a -> m a-  -- | mark the current location so it can be used in constructing a span, or for later seeking-  mark       :: m Delta+  -- | Lexeme parser |semi| parses the character \';\' and skips any+  -- trailing white space. Returns the character \';\'.+  semi :: m Char+  semi = satisfyAscii (';'==) <?> ";"+   -- | Used to emit an error on an unexpected token-  unexpected :: MonadParser m => String -> m a+  unexpected :: String -> m a+   -- | Retrieve the contents of the current line (from the beginning of the line)-  line       :: m ByteString-  -- | Seek back to previously marked location-  release  :: Delta -> m ()+  line :: m ByteString +  skipping :: Delta -> m () +  -- | @highlightInterval@ is called internally in the token parsers.+  -- It delimits ranges of the input recognized by certain parsers that+  -- are useful for syntax highlighting. An interested monad could+  -- choose to listen to these events and construct an interval tree+  -- for later pretty printing purposes.+  highlightInterval :: Highlight -> Delta -> Delta -> m ()+  highlightInterval _ _ _ = pure () +  position :: m Delta +  -- | run a parser, grabbing all of the text between its start and end points+  slicedWith :: (a -> Strict.ByteString -> r) -> m a -> m r++  -- | @lookAhead p@ parses @p@ without consuming any input.+  lookAhead :: m a -> m a++ instance MonadParser m => MonadParser (Lazy.StateT s m) where   try (Lazy.StateT m) = Lazy.StateT $ try . m   labels (Lazy.StateT m) ss = Lazy.StateT $ \s -> labels (m s) ss   line = lift line-  liftIt = lift . liftIt-  mark = lift mark -  release = lift . release   unexpected = lift . unexpected   satisfy = lift . satisfy   satisfy8 = lift . satisfy8-  highlight t (Lazy.StateT m) = Lazy.StateT $ \e -> highlight t (m e) +  someSpace = lift someSpace+  semi = lift semi+  highlightInterval h s e  = lift $ highlightInterval h s e+  nesting (Lazy.StateT m) = Lazy.StateT $ nesting . m+  skipping = lift . skipping+  position = lift position+  slicedWith f (Lazy.StateT m) = Lazy.StateT $ \s -> slicedWith (\(a,s') b -> (f a b, s')) $ m s+  lookAhead (Lazy.StateT m) = Lazy.StateT $ lookAhead . m  instance MonadParser m => MonadParser (Strict.StateT s m) where   try (Strict.StateT m) = Strict.StateT $ try . m   labels (Strict.StateT m) ss = Strict.StateT $ \s -> labels (m s) ss   line = lift line-  liftIt = lift . liftIt-  mark = lift mark -  release = lift . release   unexpected = lift . unexpected   satisfy = lift . satisfy   satisfy8 = lift . satisfy8-  highlight t (Strict.StateT m) = Strict.StateT $ \e -> highlight t (m e) +  someSpace = lift someSpace+  semi = lift semi+  highlightInterval h s e  = lift $ highlightInterval h s e+  nesting (Strict.StateT m) = Strict.StateT $ nesting . m+  skipping = lift . skipping+  position = lift position+  slicedWith f (Strict.StateT m) = Strict.StateT $ \s -> slicedWith (\(a,s') b -> (f a b, s')) $ m s+  lookAhead (Strict.StateT m) = Strict.StateT $ lookAhead . m  instance MonadParser m => MonadParser (ReaderT e m) where   try (ReaderT m) = ReaderT $ try . m   labels (ReaderT m) ss = ReaderT $ \s -> labels (m s) ss   line = lift line-  liftIt = lift . liftIt-  mark = lift mark -  release = lift . release   unexpected = lift . unexpected   satisfy = lift . satisfy   satisfy8 = lift . satisfy8-  highlight t (ReaderT m) = ReaderT $ \e -> highlight t (m e) +  someSpace = lift someSpace+  semi = lift semi+  highlightInterval h s e  = lift $ highlightInterval h s e+  nesting (ReaderT m) = ReaderT $ nesting . m+  skipping = lift . skipping+  position = lift position+  slicedWith f (ReaderT m) = ReaderT $ slicedWith f . m+  lookAhead (ReaderT m) = ReaderT $ lookAhead . m  instance (MonadParser m, Monoid w) => MonadParser (Strict.WriterT w m) where   try (Strict.WriterT m) = Strict.WriterT $ try m   labels (Strict.WriterT m) ss = Strict.WriterT $ labels m ss   line = lift line-  liftIt = lift . liftIt-  mark = lift mark -  release = lift . release   unexpected = lift . unexpected   satisfy = lift . satisfy   satisfy8 = lift . satisfy8-  highlight t (Strict.WriterT m) = Strict.WriterT $ highlight t m+  someSpace = lift someSpace+  semi = lift semi+  highlightInterval h s e  = lift $ highlightInterval h s e+  nesting (Strict.WriterT m) = Strict.WriterT $ nesting m+  skipping = lift . skipping+  position = lift position+  slicedWith f (Strict.WriterT m) = Strict.WriterT $ slicedWith (\(a,s') b -> (f a b, s')) m+  lookAhead (Strict.WriterT m) = Strict.WriterT $ lookAhead m  instance (MonadParser m, Monoid w) => MonadParser (Lazy.WriterT w m) where   try (Lazy.WriterT m) = Lazy.WriterT $ try m   labels (Lazy.WriterT m) ss = Lazy.WriterT $ labels m ss   line = lift line-  liftIt = lift . liftIt-  mark = lift mark -  release = lift . release   unexpected = lift . unexpected   satisfy = lift . satisfy   satisfy8 = lift . satisfy8-  highlight t (Lazy.WriterT m) = Lazy.WriterT $ highlight t m+  someSpace = lift someSpace+  semi = lift semi+  highlightInterval h s e  = lift $ highlightInterval h s e+  nesting (Lazy.WriterT m) = Lazy.WriterT $ nesting m+  skipping = lift . skipping+  position = lift position+  slicedWith f (Lazy.WriterT m) = Lazy.WriterT $ slicedWith (\(a,s') b -> (f a b, s')) m+  lookAhead (Lazy.WriterT m) = Lazy.WriterT $ lookAhead m  instance (MonadParser m, Monoid w) => MonadParser (Lazy.RWST r w s m) where   try (Lazy.RWST m) = Lazy.RWST $ \r s -> try (m r s)   labels (Lazy.RWST m) ss = Lazy.RWST $ \r s -> labels (m r s) ss   line = lift line-  liftIt = lift . liftIt-  mark = lift mark -  release = lift . release   unexpected = lift . unexpected   satisfy = lift . satisfy   satisfy8 = lift . satisfy8-  highlight t (Lazy.RWST m) = Lazy.RWST $ \r s -> highlight t (m r s)+  someSpace = lift someSpace+  semi = lift semi+  highlightInterval h s e  = lift $ highlightInterval h s e+  nesting (Lazy.RWST m) = Lazy.RWST $ \r s -> nesting (m r s)+  skipping = lift . skipping+  position = lift position+  slicedWith f (Lazy.RWST m) = Lazy.RWST $ \r s -> slicedWith (\(a,s',w) b -> (f a b, s',w)) $ m r s+  lookAhead (Lazy.RWST m) = Lazy.RWST $ \r s -> lookAhead $ m r s  instance (MonadParser m, Monoid w) => MonadParser (Strict.RWST r w s m) where   try (Strict.RWST m) = Strict.RWST $ \r s -> try (m r s)   labels (Strict.RWST m) ss = Strict.RWST $ \r s -> labels (m r s) ss   line = lift line-  liftIt = lift . liftIt-  mark = lift mark -  release = lift . release   unexpected = lift . unexpected   satisfy = lift . satisfy   satisfy8 = lift . satisfy8-  highlight t (Strict.RWST m) = Strict.RWST $ \r s -> highlight t (m r s)+  someSpace = lift someSpace+  semi = lift semi+  highlightInterval h s e  = lift $ highlightInterval h s e+  nesting (Strict.RWST m) = Strict.RWST $ \r s -> nesting (m r s)+  skipping = lift . skipping+  position = lift position+  slicedWith f (Strict.RWST m) = Strict.RWST $ \r s -> slicedWith (\(a,s',w) b -> (f a b, s',w)) $ m r s+  lookAhead (Strict.RWST m) = Strict.RWST $ \r s -> lookAhead $ m r s  instance MonadParser m => MonadParser (IdentityT m) where-  try (IdentityT m) = IdentityT $ try m-  labels (IdentityT m) = IdentityT . labels m+  try = IdentityT . try . runIdentityT+  labels (IdentityT m) ss = IdentityT $ labels m ss   line = lift line-  liftIt = lift . liftIt-  mark = lift mark -  release = lift . release   unexpected = lift . unexpected   satisfy = lift . satisfy   satisfy8 = lift . satisfy8-  highlight t (IdentityT m) = IdentityT $ highlight t m+  someSpace = lift someSpace+  semi = lift semi+  highlightInterval h s e  = lift $ highlightInterval h s e+  nesting (IdentityT m) = IdentityT $ nesting m+  skipping = lift . skipping+  position = lift position+  slicedWith f (IdentityT m) = IdentityT $ slicedWith f m+  lookAhead (IdentityT m) = IdentityT $ lookAhead m  instance MonadParser m => MonadParser (Yoneda m) where   try = lift . try . lowerYoneda   labels m ss = lift $ labels (lowerYoneda m) ss   line = lift line-  liftIt = lift . liftIt-  mark = lift mark -  release = lift . release   unexpected = lift . unexpected   satisfy = lift . satisfy   satisfy8 = lift . satisfy8-  highlight t (Yoneda m) = Yoneda $ \f -> highlight t (m f)+  someSpace = lift someSpace+  semi = lift semi+  highlightInterval h s e  = lift $ highlightInterval h s e+  nesting (Yoneda m) = Yoneda $ \f -> nesting (m f)+  skipping = lift . skipping+  position = lift position+  slicedWith f = lift . slicedWith f . lowerYoneda+  lookAhead = lift . lookAhead . lowerYoneda -{--instance MonadParser m => MonadParser (Codensity m) where-  try = lift . try . lowerCodensity-  labels m ss = lift $ labels (lowerCodensity m) ss-  line = lift line-  liftIt = lift . liftIt-  mark = lift mark -  release = lift . release-  unexpected = lift . unexpected-  satisfy = lift . satisfy-  satisfy8 = lift . satisfy8--}--- instance (MonadParser m, Monoid w) => MonadParser (MaybeT m) where--- instance (Error e, MonadParser m, Monoid w) => MonadParser (ErrorT e m) where+-- | Skip zero or more bytes worth of white space. More complex parsers are +-- free to consider comments as white space.+whiteSpace :: MonadParser m => m ()+whiteSpace = someSpace <|> return ()+{-# INLINE whiteSpace #-}  satisfyAscii :: MonadParser m => (Char -> Bool) -> m Char satisfyAscii p = w2c <$> satisfy8 (\w -> w <= 0x7f && p (w2c w)) {-# INLINE satisfyAscii #-} ---- useful when we've just recognized something out of band using access to the current line -skipping :: MonadParser m => Delta -> m ()-skipping d = do-  m <- mark-  release (m <> d)-{-# INLINE skipping #-}- -- | grab the remainder of the current line restOfLine :: MonadParser m => m ByteString restOfLine = do-  m <- mark+  m <- position   Strict.drop (fromIntegral (columnByte m)) <$> line {-# INLINE restOfLine #-}  -- | label a parser with a name (<?>) :: MonadParser m => m a -> String -> m a p <?> msg = labels p [msg]---- | run a parser, grabbing all of the text between its start and end points-slicedWith :: MonadParser m => (a -> Strict.ByteString -> r) -> m a -> m r-slicedWith f pa = do-  m <- mark-  a <- pa-  r <- mark-  liftIt $ f a <$> sliceIt m r-{-# INLINE slicedWith #-}+{-# INLINE (<?>) #-}  -- | run a parser, grabbing all of the text between its start and end points and discarding the original result sliced :: MonadParser m => m a -> m ByteString sliced = slicedWith (\_ bs -> bs)-  +{-# INLINE sliced #-}+ rend :: MonadParser m => m Rendering-rend = rendering <$> mark <*> line+rend = rendering <$> position <*> line {-# INLINE rend #-} -+-- | run a parser, highlighting all of the text between its start and end points.+highlight :: MonadParser m => Highlight -> m a -> m a+highlight h p = do+  m <- position+  x <- p+  r <- position+  x <$ highlightInterval h m r+{-# INLINE highlight #-}
Text/Trifecta/Parser/Combinators.hs view
@@ -3,16 +3,16 @@ -- Module      :  Text.Trifecta.Parser.Combinators -- Copyright   :  (c) Edward Kmett 2011 -- License     :  BSD3--- +-- -- Maintainer  :  ekmett@gmail.com -- Stability   :  experimental -- Portability :  non-portable--- +-- -- Commonly used generic combinators--- +-- ----------------------------------------------------------------------------- -module Text.Trifecta.Parser.Combinators +module Text.Trifecta.Parser.Combinators   ( choice   , option   , optional -- from Control.Applicative, parsec optionMaybe@@ -35,7 +35,6 @@   , eof   , manyTill   , notFollowedBy-  , lookAhead   ) where  import Data.Traversable@@ -55,7 +54,7 @@ -- returned by @p@. -- -- >  priority  = option 0 (do{ d <- digit--- >                          ; return (digitToInt d) +-- >                          ; return (digitToInt d) -- >                          }) option :: Alternative m => a -> m a -> m a option x p = p <|> pure x@@ -86,13 +85,13 @@ sepBy p sep = sepBy1 p sep <|> pure []  -- | @sepBy1 p sep@ parses /one/ or more occurrences of @p@, separated--- by @sep@. Returns a list of values returned by @p@. +-- by @sep@. Returns a list of values returned by @p@. sepBy1 :: Alternative m => m a -> m sep -> m [a] sepBy1 p sep = (:) <$> p <*> many (sep *> p)  -- | @sepEndBy1 p sep@ parses /one/ or more occurrences of @p@, -- separated and optionally ended by @sep@. Returns a list of values--- returned by @p@. +-- returned by @p@. sepEndBy1 :: Alternative m => m a -> m sep -> m [a] sepEndBy1 p sep = flip id <$> p <*> ((flip (:) <$> (sep *> sepEndBy p sep)) <|> pure pure) @@ -105,7 +104,7 @@ sepEndBy p sep = sepEndBy1 p sep <|> pure []  -- | @endBy1 p sep@ parses /one/ or more occurrences of @p@, seperated--- and ended by @sep@. Returns a list of values returned by @p@. +-- and ended by @sep@. Returns a list of values returned by @p@. endBy1 :: Alternative m => m a -> m sep -> m [a] endBy1 p sep = some (p <* sep) @@ -116,15 +115,13 @@ endBy :: Alternative m => m a -> m sep -> m [a] endBy p sep = many (p <* sep) - -- | @count n p@ parses @n@ occurrences of @p@. If @n@ is smaller or -- equal to zero, the parser equals to @return []@. Returns a list of--- @n@ values returned by @p@. +-- @n@ values returned by @p@. count :: Applicative m => Int -> m a -> m [a] count n p | n <= 0    = pure []           | otherwise = sequenceA (replicate n p) - -- | @chainr p op x@ parser /zero/ or more occurrences of @p@, -- separated by @op@ Returns a value obtained by a /right/ associative -- application of all functions returned by @op@ to the values returned@@ -181,15 +178,9 @@ --    Note the overlapping parsers @anyChar@ and @string \"-->\"@, and --    therefore the use of the 'try' combinator. manyTill :: (Alternative m, MonadPlus m) => m a -> m end -> m [a]-{--manyTill p end = scan-  where -    scan = do end; return [] -       <|> do x <- p; xs <- scan; return (x:xs)--} manyTill p end = go where go = ([] <$ end) <|> ((:) <$> p <*> go) --- * MonadParsers +-- * MonadParsers  -- | This parser only succeeds at the end of the input. This is not a -- primitive parser but it is defined using 'notFollowedBy'.@@ -197,7 +188,7 @@ -- >  eof  = notFollowedBy anyChar <?> "end of input" eof :: MonadParser m => m () eof = do-   l <- restOfLine +   l <- restOfLine    guard $ B.null l  <?> "end of input" @@ -214,10 +205,3 @@ -- >                       }) notFollowedBy :: (MonadParser m, Show a) => m a -> m () notFollowedBy p = try ((try p >>= unexpected . show) <|> pure ())---- | @lookAhead p@ parses @p@ without consuming any input.-lookAhead :: MonadParser m => m a -> m a-lookAhead p = try $ do -  m <- mark-  p <* release m-
+ Text/Trifecta/Parser/Identifier.hs view
@@ -0,0 +1,67 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Trifecta.Parser.Identifier+-- Copyright   :  (c) Edward Kmett 2011+-- License     :  BSD3+-- +-- Maintainer  :  ekmett@gmail.com+-- Stability   :  provisional+-- Portability :  non-portable+--+-- > idStyle = haskellIdentifierStyle { styleReserved = ... }+-- > identifier = ident haskellIdentifierStyle+-- > reserved   = reserve haskellIdentifierStyle+--+-----------------------------------------------------------------------------+module Text.Trifecta.Parser.Identifier+  ( IdentifierStyle(..)+  , liftIdentifierStyle+  , ident+  , reserve+  , reserveByteString+  ) where++import Data.ByteString as Strict hiding (map, zip, foldl, foldr)+import Data.ByteString.UTF8 as UTF8+import Data.HashSet as HashSet+import Control.Applicative+import Control.Monad (when)+import Control.Monad.Trans.Class+import Text.Trifecta.Parser.Class+import Text.Trifecta.Parser.Char+import Text.Trifecta.Parser.Combinators+import Text.Trifecta.Parser.Token.Combinators+import Text.Trifecta.Highlight.Prim++data IdentifierStyle m = IdentifierStyle+  { styleName              :: String+  , styleStart             :: m ()+  , styleLetter            :: m ()+  , styleReserved          :: HashSet ByteString+  , styleHighlight         :: Highlight+  , styleReservedHighlight :: Highlight+  }++-- | Lift an identifier style into a monad transformer+liftIdentifierStyle :: (MonadTrans t, Monad m) => IdentifierStyle m -> IdentifierStyle (t m)+liftIdentifierStyle s =+  s { styleStart  = lift (styleStart s)+    , styleLetter = lift (styleLetter s)+    }++-- | parse a reserved operator or identifier using a given style+reserve :: MonadParser m => IdentifierStyle m -> String -> m ()+reserve s name = reserveByteString s $! UTF8.fromString name++-- | parse a reserved operator or identifier using a given style specified by bytestring+reserveByteString :: MonadParser m => IdentifierStyle m -> ByteString -> m ()+reserveByteString s name = lexeme $ try $ do+   _ <- highlight (styleReservedHighlight s) $ byteString name+   notFollowedBy (styleLetter s) <?> "end of " ++ show name++-- | parse an non-reserved identifier or symbol+ident :: MonadParser m => IdentifierStyle m -> m ByteString+ident s = lexeme $ try $ do+  name <- highlight (styleHighlight s) (sliced (styleStart s *> skipMany (styleLetter s))) <?> styleName s+  when (member name (styleReserved s)) $ unexpected $ "reserved " ++ styleName s ++ " " ++ show name+  return name
+ Text/Trifecta/Parser/Identifier/Style.hs view
@@ -0,0 +1,70 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Trifecta.Parser.Identifier.Style+-- Copyright   :  (c) Edward Kmett 2011+-- License     :  BSD3+--+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  provisional+-- Portability :  non-portable+--+-----------------------------------------------------------------------------+module Text.Trifecta.Parser.Identifier.Style+  (+  -- identifier styles+    emptyIdents, haskellIdents, haskell98Idents+  -- operator styles+  , emptyOps, haskellOps, haskell98Ops+  ) where++import Data.ByteString as Strict hiding (map, zip, foldl, foldr)+import Data.ByteString.UTF8 as UTF8+import Data.HashSet as HashSet+import Data.Monoid+import Control.Applicative+import Text.Trifecta.Parser.Class+import Text.Trifecta.Parser.Char+import Text.Trifecta.Parser.Identifier+import Text.Trifecta.Highlight.Prim++set :: [String] -> HashSet ByteString+set = HashSet.fromList . fmap UTF8.fromString++emptyOps, haskell98Ops, haskellOps :: MonadParser m => IdentifierStyle m+emptyOps = IdentifierStyle+  { styleName     = "operator"+  , styleStart    = styleLetter emptyOps+  , styleLetter   = () <$ oneOf ":!#$%&*+./<=>?@\\^|-~"+  , styleReserved = mempty+  , styleHighlight = Operator+  , styleReservedHighlight = ReservedOperator+  }+haskell98Ops = emptyOps+  { styleReserved = set ["::","..","=","\\","|","<-","->","@","~","=>"]+  }+haskellOps = haskell98Ops++emptyIdents, haskell98Idents, haskellIdents :: MonadParser m => IdentifierStyle m+emptyIdents = IdentifierStyle+  { styleName     = "identifier"+  , styleStart    = () <$ (letter <|> char '_')+  , styleLetter   = () <$ (alphaNum <|> oneOf "_'")+  , styleReserved = set []+  , styleHighlight = Identifier+  , styleReservedHighlight = ReservedIdentifier }++haskell98Idents = emptyIdents+  { styleReserved = set haskell98ReservedIdents }+haskellIdents = haskell98Idents+  { styleLetter   = styleLetter haskell98Idents <|> () <$ char '#'+  , styleReserved = set $ haskell98ReservedIdents +++      ["foreign","import","export","primitive","_ccall_","_casm_" ,"forall"]+  }++haskell98ReservedIdents :: [String]+haskell98ReservedIdents =+  ["let","in","case","of","if","then","else","data","type"+  ,"class","default","deriving","do","import","infix"+  ,"infixl","infixr","instance","module","newtype"+  ,"where","primitive" -- "as","qualified","hiding"+  ]
Text/Trifecta/Parser/Language/Class.hs view
@@ -15,9 +15,9 @@ import qualified Control.Monad.Trans.RWS.Lazy as Lazy import Data.Monoid import Text.Trifecta.Parser.Language.Def-import Text.Trifecta.Parser.Token.Class+import Text.Trifecta.Parser.Class -class MonadTokenParser m => MonadLanguage m where+class MonadParser m => MonadLanguage m where   askLanguage :: m (LanguageDef m)  asksLanguage :: MonadLanguage m => (LanguageDef m -> r) -> m r
Text/Trifecta/Parser/Language/Combinators.hs view
@@ -21,7 +21,7 @@ import Data.ByteString import Text.Trifecta.Parser.Language.Class import Text.Trifecta.Parser.Language.Def-import Text.Trifecta.Parser.Token.Identifier+import Text.Trifecta.Parser.Identifier  identifier :: MonadLanguage m => m ByteString identifier = asksLanguage languageIdentifiers >>= ident
Text/Trifecta/Parser/Language/Def.hs view
@@ -5,7 +5,7 @@  import Control.Monad.Trans.Class import Text.Trifecta.Parser.Token.Style-import Text.Trifecta.Parser.Token.Identifier+import Text.Trifecta.Parser.Identifier  data LanguageDef m = LanguageDef   { languageCommentStyle :: CommentStyle
Text/Trifecta/Parser/Language/Monad.hs view
@@ -13,14 +13,13 @@ import Control.Monad.Cont.Class import Text.Trifecta.Diagnostic.Class import Text.Trifecta.Parser.Class-import Text.Trifecta.Parser.Token.Class-import Text.Trifecta.Parser.Token.Combinators+import Text.Trifecta.Parser.Mark import Text.Trifecta.Parser.Token.Style import Text.Trifecta.Parser.Language.Def import Text.Trifecta.Parser.Language.Class  newtype Language m a = Language { unlanguage :: ReaderT (LanguageDef (Language m)) m a }-  deriving (Functor,Applicative,Alternative,Monad,MonadPlus,MonadParser,MonadCont)+  deriving (Functor,Applicative,Alternative,Monad,MonadPlus,MonadCont)  runLanguage :: Language m a -> LanguageDef (Language m) -> m a runLanguage = runReaderT . unlanguage@@ -31,11 +30,26 @@ instance MonadTrans Language where   lift = Language . lift -instance MonadParser m => MonadTokenParser (Language m) where-  whiteSpace = asksLanguage languageCommentStyle >>= buildWhiteSpaceParser-  nesting = id-  semi = symbolic ';'+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@@ -43,7 +57,7 @@  instance MonadState s m => MonadState s (Language m) where   get = Language $ lift get-  put = Language . lift . put+  put s = Language $ lift $ put s  instance MonadWriter w m => MonadWriter w (Language m) where   tell = Language . lift . tell
Text/Trifecta/Parser/Language/Style.hs view
@@ -15,12 +15,12 @@   , haskell98LanguageDef   ) where -import Text.Trifecta.Parser.Token.Class+import Text.Trifecta.Parser.Class import Text.Trifecta.Parser.Token.Style-import Text.Trifecta.Parser.Token.Identifier.Style+import Text.Trifecta.Parser.Identifier.Style import Text.Trifecta.Parser.Language.Def -emptyLanguageDef, haskellLanguageDef, haskell98LanguageDef :: MonadTokenParser m => LanguageDef m+emptyLanguageDef, haskellLanguageDef, haskell98LanguageDef :: MonadParser m => LanguageDef m emptyLanguageDef     = LanguageDef emptyCommentStyle   emptyIdents     emptyOps haskellLanguageDef   = LanguageDef haskellCommentStyle haskellIdents   haskellOps haskell98LanguageDef = LanguageDef haskellCommentStyle haskell98Idents haskell98Ops
Text/Trifecta/Parser/Layout.hs view
@@ -11,7 +11,9 @@ ---------------------------------------------------------------------------- module Text.Trifecta.Parser.Layout   ( Layout(..)-  , MonadLayoutParser(..)+  , LayoutMark(..)+  , MonadLayout(..)+  , LayoutState(..)   , runLayout   , defaultLayoutState   ) where
Text/Trifecta/Parser/Layout/Class.hs view
@@ -1,9 +1,8 @@ {-# LANGUAGE MultiParamTypeClasses #-} module Text.Trifecta.Parser.Layout.Class-  ( MonadLayoutParser(..)+  ( MonadLayout(..)   ) where -import Data.Lens.Common import Data.Monoid import Control.Monad.Trans.Class import Control.Monad.Trans.Reader@@ -15,58 +14,40 @@ 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.Token.Class+import Text.Trifecta.Parser.Class -class MonadTokenParser m => MonadLayoutParser m where+class MonadParser m => MonadLayout m where   layout    :: m LayoutToken-  getLayout :: Lens LayoutState t -> m t-  setLayout :: Lens LayoutState t -> t -> m ()-  modLayout :: Lens LayoutState t -> (t -> t) -> m ()+  layoutState :: (LayoutState -> (a, LayoutState)) -> m a -instance MonadLayoutParser m => MonadLayoutParser (Strict.StateT s m) where+instance MonadLayout m => MonadLayout (Strict.StateT s m) where   layout = lift layout-  getLayout l = lift $ getLayout l-  setLayout l t = lift $ setLayout l t-  modLayout l f = lift $ modLayout l f+  layoutState = lift . layoutState -instance MonadLayoutParser m => MonadLayoutParser (Lazy.StateT s m) where+instance MonadLayout m => MonadLayout (Lazy.StateT s m) where   layout = lift layout-  getLayout l = lift $ getLayout l-  setLayout l t = lift $ setLayout l t-  modLayout l f = lift $ modLayout l f+  layoutState = lift . layoutState -instance MonadLayoutParser m => MonadLayoutParser (ReaderT e m) where+instance MonadLayout m => MonadLayout (ReaderT e m) where   layout = lift layout-  getLayout l = lift $ getLayout l-  setLayout l t = lift $ setLayout l t-  modLayout l f = lift $ modLayout l f+  layoutState = lift . layoutState -instance (Monoid w, MonadLayoutParser m) => MonadLayoutParser (Strict.WriterT w m) where+instance (Monoid w, MonadLayout m) => MonadLayout (Strict.WriterT w m) where   layout = lift layout-  getLayout l = lift $ getLayout l-  setLayout l t = lift $ setLayout l t-  modLayout l f = lift $ modLayout l f+  layoutState = lift . layoutState -instance (Monoid w, MonadLayoutParser m) => MonadLayoutParser (Lazy.WriterT w m) where+instance (Monoid w, MonadLayout m) => MonadLayout (Lazy.WriterT w m) where   layout = lift layout-  getLayout l = lift $ getLayout l-  setLayout l t = lift $ setLayout l t-  modLayout l f = lift $ modLayout l f+  layoutState = lift . layoutState -instance (Monoid w, MonadLayoutParser m) => MonadLayoutParser (Strict.RWST r w s m) where+instance (Monoid w, MonadLayout m) => MonadLayout (Strict.RWST r w s m) where   layout = lift layout-  getLayout l = lift $ getLayout l-  setLayout l t = lift $ setLayout l t-  modLayout l f = lift $ modLayout l f+  layoutState = lift . layoutState -instance (Monoid w, MonadLayoutParser m) => MonadLayoutParser (Lazy.RWST r w s m) where+instance (Monoid w, MonadLayout m) => MonadLayout (Lazy.RWST r w s m) where   layout = lift layout-  getLayout l = lift $ getLayout l-  setLayout l t = lift $ setLayout l t-  modLayout l f = lift $ modLayout l f+  layoutState = lift . layoutState -instance MonadLayoutParser m => MonadLayoutParser (IdentityT m) where+instance MonadLayout m => MonadLayout (IdentityT m) where   layout = lift layout-  getLayout l = lift $ getLayout l-  setLayout l t = lift $ setLayout l t-  modLayout l f = lift $ modLayout l f+  layoutState = lift . layoutState
Text/Trifecta/Parser/Layout/Combinators.hs view
@@ -1,6 +1,9 @@ {-# LANGUAGE MultiParamTypeClasses #-} module Text.Trifecta.Parser.Layout.Combinators   ( layoutEq+  , getLayout+  , setLayout+  , modLayout   , disableLayout   , enableLayout   , laidout@@ -8,6 +11,7 @@  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@@ -15,7 +19,16 @@ import Text.Trifecta.Parser.Layout.Class import Text.Trifecta.Parser.Layout.Prim -disableLayout :: MonadLayoutParser m => m a -> m a+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:)@@ -25,7 +38,7 @@     DisabledLayout r':xs | delta r == delta r' -> result <$ setLayout layoutStack xs     _ -> unexpected "layout" -enableLayout :: MonadLayoutParser m => m a -> m a+enableLayout :: MonadLayout m => m a -> m a enableLayout p = do   result <- highlight Highlight.Layout $ do     r <- rend@@ -33,12 +46,11 @@     p   result <$ layout <?> "virtual right brace" -laidout :: MonadLayoutParser m => m a -> m a+laidout :: MonadLayout m => m a -> m a laidout p = braces p <|> enableLayout p -layoutEq :: MonadLayoutParser m => LayoutToken -> m LayoutToken+layoutEq :: MonadLayout m => LayoutToken -> m () layoutEq s = try $ do   r <- layout   guard (s == r)-  return r
Text/Trifecta/Parser/Layout/Monad.hs view
@@ -16,6 +16,7 @@   ) where  import Control.Applicative+import Control.Category import Control.Monad import Control.Monad.State.Class import Control.Monad.Trans.State.Strict (StateT(..))@@ -23,68 +24,70 @@ import Control.Monad.Reader.Class import Control.Monad.Cont.Class import Control.Monad.Trans.Class-import Data.Lens+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.Token.Class 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 MonadTokenParser m => MonadParser (Layout m) where+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-  mark        = lift mark-  release     = lift . release-  liftIt      = lift . liftIt   unexpected  = lift . unexpected   try         = Layout . try . unlayout   labels m s  = Layout $ labels (unlayout m) s   skipMany    = Layout . skipMany . unlayout-  highlight h = Layout . highlight h . 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 MonadTokenParser m => MonadTokenParser (Layout m) where-  whiteSpace = skipOptional $ 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+instance MonadParser m => MonadLayout (Layout m) where+  layout = buildLayoutParser (lift whiteSpace)+  layoutState f = Layout . StateT $ return . f -instance MonadTokenParser m => MonadLayoutParser (Layout m) where-  getLayout l = Layout $ access l-  setLayout l t = () <$ (Layout $ l ~= t)-  modLayout l f = () <$ (Layout $ l %= f)-  layout = do-    bol <- getLayout layoutBol-    m <- mark-    lift whiteSpace-    r <- mark-    if near m r && not bol-      then onside m r-      else do-        stk <- getLayout layoutStack-        case compare (column r) (depth stk) of-          LT -> case stk of-            (IndentedLayout _:xs) -> VirtualRightBrace <$ setLayout layoutStack xs <* setLayout layoutBol True-            [] -> unexpected "empty layout"-            _  -> unexpected "layout"-          EQ -> return VirtualSemi-          GT -> onside m r+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@@ -92,7 +95,6 @@       trailing = getLayout layoutStack >>= \ stk -> case stk of           (IndentedLayout _:xs) -> setLayout layoutStack xs           _ -> empty-       depth []                   = 0       depth (IndentedLayout r:_) = column r       depth (DisabledLayout _:_) = -1
Text/Trifecta/Parser/Layout/Prim.hs view
@@ -3,12 +3,18 @@   ( 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@@ -44,3 +50,26 @@  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
+ Text/Trifecta/Parser/Mark.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances, FlexibleInstances, FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Trifecta.Parser.Mark+-- Copyright   :  (c) Edward Kmett 2011+-- License     :  BSD3+--+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  non-portable+--+-----------------------------------------------------------------------------+module Text.Trifecta.Parser.Mark+  ( MonadMark(..)+  ) where++import Control.Monad.Trans.Class+import Control.Monad.Trans.State.Lazy as Lazy+import Control.Monad.Trans.State.Strict as Strict+import Control.Monad.Trans.Writer.Lazy as Lazy+import Control.Monad.Trans.Writer.Strict as Strict+import Control.Monad.Trans.RWS.Lazy as Lazy+import Control.Monad.Trans.RWS.Strict as Strict+import Control.Monad.Trans.Reader+import Control.Monad.Trans.Identity+import Data.Functor.Yoneda+import Data.Monoid+import Text.Trifecta.Rope.Delta+import Text.Trifecta.Parser.Class++class (MonadParser m, HasDelta d) => MonadMark d m | m -> d where+  -- | mark the current location so it can be used in constructing a span, or for later seeking+  mark :: m d+  -- | Seek a previously marked location+  release :: d -> m ()++instance MonadMark d m => MonadMark d (Lazy.StateT s m) where+  mark = lift mark+  release = lift . release++instance MonadMark d m => MonadMark d (Strict.StateT s m) where+  mark = lift mark+  release = lift . release++instance MonadMark d m => MonadMark d (ReaderT e m) where+  mark = lift mark+  release = lift . release++instance (MonadMark d m, Monoid w) => MonadMark d (Strict.WriterT w m) where+  mark = lift mark+  release = lift . release++instance (MonadMark d m, Monoid w) => MonadMark d (Lazy.WriterT w m) where+  mark = lift mark+  release = lift . release++instance (MonadMark d m, Monoid w) => MonadMark d (Lazy.RWST r w s m) where+  mark = lift mark+  release = lift . release++instance (MonadMark d m, Monoid w) => MonadMark d (Strict.RWST r w s m) where+  mark = lift mark+  release = lift . release++instance MonadMark d m => MonadMark d (IdentityT m) where+  mark = lift mark+  release = lift . release++instance MonadMark d m => MonadMark d (Yoneda m) where+  mark = lift mark+  release = lift . release
Text/Trifecta/Parser/Prim.hs view
@@ -37,9 +37,6 @@ import Data.Sequence as Seq hiding (empty) import Data.ByteString.UTF8 as UTF8 import Text.PrettyPrint.Free hiding (line)-import Text.Trifecta.Rope.Delta as Delta-import Text.Trifecta.Rope.Prim-import Text.Trifecta.Rope.Bytes import Text.Trifecta.Diagnostic.Class import Text.Trifecta.Diagnostic.Prim import Text.Trifecta.Diagnostic.Level@@ -52,8 +49,12 @@ import Text.Trifecta.Highlight.Prim import Text.Trifecta.Parser.Class import Text.Trifecta.Parser.It+import Text.Trifecta.Parser.Mark import Text.Trifecta.Parser.Step import Text.Trifecta.Parser.Result+import Text.Trifecta.Rope.Delta as Delta+import Text.Trifecta.Rope.Prim+import Text.Trifecta.Rope.Bytes import System.Console.Terminfo.PrettyPrint  data Parser e a = Parser@@ -177,6 +178,12 @@ ascii :: ByteString -> Bool ascii = Strict.all (<=0x7f) +liftIt :: It Rope a -> Parser e a+liftIt m = Parser $ \ eo _ _ _ l b8 d bs -> do+  a <- m+  eo a mempty l b8 d bs+{-# 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' _ _ _ ->@@ -185,10 +192,16 @@      else ee e (l <> l') b8 d bs      ) l b8 d bs   {-# INLINE try #-}-  highlight t (Parser m) = Parser $ \eo ee co ce l b8 d bs ->-    m eo ee (\a e l' b8' d' -> co a e l' { errHighlights = IntervalMap.insert d d' t (errHighlights l') } b8' d') ce l b8 d bs+  highlightInterval h s e = Parser $ \eo _ _ _ l -> eo () mempty l { errHighlights = IntervalMap.insert s e h (errHighlights l) }+  {-# INLINE highlightInterval #-} +  skipping d = do+    m <- mark+    release $ m <> d+  {-# INLINE skipping #-}+   unexpected s = Parser $ \ _ ee _ _ -> ee mempty { errMessage = FailErr $ "unexpected " ++ s }+  {-# INLINE unexpected #-}    labels (Parser p) msgs = Parser $ \ eo ee -> p      (\a e l b8 d bs ->@@ -197,21 +210,6 @@              else e) l b8 d bs)      (\e l b8 d bs -> ee e { errExpected = Set.fromList $ Prelude.map (:^ Caret d bs) msgs } l b8 d bs)   {-# INLINE labels #-}-  liftIt m = Parser $ \ eo _ _ _ l b8 d bs -> do-     a <- m-     eo a mempty l b8 d bs-  {-# INLINE liftIt #-}-  mark = Parser $ \eo _ _ _ l b8 d -> eo d mempty l b8 d-  {-# INLINE mark #-}-  release d' = Parser $ \_ ee co _ l b8 d bs -> do-    mbs <- rewindIt d'-    case mbs of-      Just bs' -> co () mempty l (ascii bs') d' bs'-      Nothing-        | bytes d' == bytes (rewind d) + fromIntegral (Strict.length bs) -> if near d d'-            then co () mempty l (ascii bs) d' bs-            else co () mempty l True d' mempty-        | otherwise -> ee mempty l b8 d bs   line = Parser $ \eo _ _ _ l b8 d bs -> eo bs mempty l b8 d bs   {-# INLINE line #-}   skipMany p = () <$ manyAccum (\_ _ -> []) p@@ -254,9 +252,30 @@                                                         ddc         | otherwise                 -> co c mempty l b8 (d <> delta c) bs     else ee mempty { errMessage = FailErr "unexpected EOF" } l b8 d bs+  position = Parser $ \eo _ _ _ l b8 d -> eo d mempty l b8 d+  {-# INLINE position #-}+  slicedWith f p = do+    m <- position+    a <- p+    r <- position+    f a <$> liftIt (sliceIt m r)+  {-# INLINE slicedWith #-}+  lookAhead (Parser m) = Parser $ \eo ee _ ce l b8 d bs ->+    m eo ee (\a e l' _ _ _ -> eo a e (l <> l') b8 d bs) ce l b8 d bs+  {-# INLINE lookAhead #-} --- instance MonadHighlight (Parser e) where---  highlights = Parser $ \eo _ _ _ l -> eo (errHighlights l) mempty l+instance MonadMark Delta (Parser e) where+  mark = position+  {-# INLINE mark #-}+  release d' = Parser $ \_ ee co _ l b8 d bs -> do+    mbs <- rewindIt d'+    case mbs of+      Just bs' -> co () mempty l (ascii bs') d' bs'+      Nothing+        | bytes d' == bytes (rewind d) + fromIntegral (Strict.length bs) -> if near d d'+            then co () mempty l (ascii bs) d' bs+            else co () mempty l True d' mempty+        | otherwise -> ee mempty l b8 d bs  data St e a = JuSt a !(ErrState e) !(ErrLog e) !Bool !Delta !ByteString             | NoSt !(ErrState e) !(ErrLog e) !Bool !Delta !ByteString
Text/Trifecta/Parser/Token.hs view
@@ -10,20 +10,15 @@ -- ---------------------------------------------------------------------------- module Text.Trifecta.Parser.Token-  ( module Text.Trifecta.Parser.Token.Class-  , module Text.Trifecta.Parser.Token.Combinators-  , module Text.Trifecta.Parser.Token.Identifier-  -- * Text.Trifecta.Parser.Prim+  ( module Text.Trifecta.Parser.Token.Combinators+  -- * Text.Trifecta.Parser.Token.Prim   , decimal   , hexadecimal   , octal   ) where -import Text.Trifecta.Parser.Token.Class import Text.Trifecta.Parser.Token.Prim import Text.Trifecta.Parser.Token.Combinators-import Text.Trifecta.Parser.Token.Identifier  -- expected to be imported manually -- import Text.Trifecta.Parser.Token.Style--- import Text.Trifecta.Parser.Token.Identifier.Style
− Text/Trifecta/Parser/Token/Class.hs 
@@ -1,81 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.Trifecta.Parser.Token.Class--- Copyright   :  (c) Edward Kmett 2011--- License     :  BSD3--- --- Maintainer  :  ekmett@gmail.com--- Stability   :  experimental--- Portability :  non-portable--- -------------------------------------------------------------------------------module Text.Trifecta.Parser.Token.Class-  ( MonadTokenParser(..)-  ) where--import Control.Monad.Trans.Class-import Control.Monad.Trans.State.Lazy as Lazy-import Control.Monad.Trans.State.Strict as Strict-import Control.Monad.Trans.Writer.Lazy as Lazy-import Control.Monad.Trans.Writer.Strict as Strict-import Control.Monad.Trans.RWS.Lazy as Lazy-import Control.Monad.Trans.RWS.Strict as Strict-import Control.Monad.Trans.Reader-import Control.Monad.Trans.Identity-import Data.Monoid-import Text.Trifecta.Parser.Class--class MonadParser m => MonadTokenParser m where-  -- | Parses any white space. White space consists of /zero/ or more-  -- occurrences of a 'space', a line comment or a block (multi-  -- line) comment. Block comments may be nested. How comments are-  -- started and ended is defined by this method.-  whiteSpace :: m ()--  -- | Called when we enter a nested pair of symbols. Used to disable-  -- layout or highlight nested contexts.-  nesting :: m a -> m a--  -- | Lexeme parser |semi| parses the character \';\' and skips any-  -- trailing white space. Returns the character \';\'.‗-  semi :: m Char--instance MonadTokenParser m => MonadTokenParser (ReaderT r m) where-  whiteSpace = lift whiteSpace-  nesting (ReaderT m) = ReaderT $ \r -> nesting (m r)-  semi = lift semi--instance MonadTokenParser m => MonadTokenParser (Lazy.StateT s m) where-  whiteSpace = lift whiteSpace-  nesting (Lazy.StateT m) = Lazy.StateT $ \s -> nesting (m s)-  semi = lift semi--instance MonadTokenParser m => MonadTokenParser (Strict.StateT s m) where-  whiteSpace = lift whiteSpace-  nesting (Strict.StateT m) = Strict.StateT $ \s -> nesting (m s)-  semi = lift semi--instance (MonadTokenParser m, Monoid w) => MonadTokenParser (Lazy.WriterT w m) where-  whiteSpace = lift whiteSpace-  nesting (Lazy.WriterT m) = Lazy.WriterT $ nesting m-  semi = lift semi--instance (MonadTokenParser m, Monoid w) => MonadTokenParser (Strict.WriterT w m) where-  whiteSpace = lift whiteSpace-  nesting (Strict.WriterT m) = Strict.WriterT $ nesting m-  semi = lift semi--instance (MonadTokenParser m, Monoid w) => MonadTokenParser (Lazy.RWST r w s m) where-  whiteSpace = lift whiteSpace-  nesting (Lazy.RWST m) = Lazy.RWST $ \r s -> nesting (m r s)-  semi = lift semi--instance (MonadTokenParser m, Monoid w) => MonadTokenParser (Strict.RWST r w s m) where-  whiteSpace = lift whiteSpace-  nesting (Strict.RWST m) = Strict.RWST $ \r s -> nesting (m r s)-  semi = lift semi--instance MonadTokenParser m => MonadTokenParser (IdentityT m) where-  whiteSpace = lift whiteSpace-  nesting (IdentityT m) = IdentityT (nesting m)-  semi = lift semi
Text/Trifecta/Parser/Token/Combinators.hs view
@@ -38,7 +38,6 @@ import Text.Trifecta.Parser.Class import Text.Trifecta.Parser.Char import Text.Trifecta.Parser.Combinators-import Text.Trifecta.Parser.Token.Class import Text.Trifecta.Parser.Token.Prim import Text.Trifecta.Highlight.Prim @@ -57,7 +56,7 @@ -- >                     ; eof -- >                     ; return (sum ds) -- >                     }-lexeme :: MonadTokenParser m => m a -> m a+lexeme :: MonadParser m => m a -> m a lexeme p = p <* whiteSpace  -- | This lexeme parser parses a single literal character. Returns the@@ -65,7 +64,7 @@ -- sequences. The literal character is parsed according to the grammar -- rules defined in the Haskell report (which matches most programming -- languages quite closely). -charLiteral :: MonadTokenParser m => m Char+charLiteral :: MonadParser m => m Char charLiteral = lexeme charLiteral'  -- | This lexeme parser parses a literal string. Returns the literal@@ -74,7 +73,7 @@ -- defined in the Haskell report (which matches most programming -- languages quite closely).  -stringLiteral :: MonadTokenParser m => m String+stringLiteral :: MonadParser m => m String stringLiteral = lexeme stringLiteral'  -- | This lexeme parser parses a natural number (a positive whole@@ -83,7 +82,7 @@ -- 'octal'. The number is parsed according to the grammar -- rules in the Haskell report.  -natural :: MonadTokenParser m => m Integer+natural :: MonadParser m => m Integer natural = lexeme natural'  -- | This lexeme parser parses an integer (a whole number). This parser@@ -92,8 +91,8 @@ -- number can be specified in 'decimal', 'hexadecimal' -- or 'octal'. The number is parsed according -- to the grammar rules in the Haskell report. -        -integer :: MonadTokenParser m => m Integer++integer :: MonadParser m => m Integer integer = lexeme int <?> "integer"   where   sign = negate <$ char '-'@@ -105,7 +104,7 @@ -- of the number. The number is parsed according to the grammar rules -- defined in the Haskell report.  -double :: MonadTokenParser m => m Double+double :: MonadParser m => m Double double = lexeme double'  -- | This lexeme parser parses either 'natural' or a 'float'.@@ -113,86 +112,86 @@ -- any overlap in the grammar rules for naturals and floats. The number -- is parsed according to the grammar rules defined in the Haskell report.  -naturalOrDouble :: MonadTokenParser m => m (Either Integer Double)+naturalOrDouble :: MonadParser m => m (Either Integer Double) naturalOrDouble = lexeme naturalOrDouble'  -- | Lexeme parser @symbol s@ parses 'string' @s@ and skips -- trailing white space.  -symbol :: MonadTokenParser m => ByteString -> m ByteString+symbol :: MonadParser m => ByteString -> m ByteString symbol name = lexeme (highlight Symbol (byteString name))  -- | Lexeme parser @symbolic s@ parses 'char' @s@ and skips -- trailing white space.  -symbolic :: MonadTokenParser m => Char -> m Char+symbolic :: MonadParser m => Char -> m Char symbolic name = lexeme (highlight Symbol (char name))  -- | Lexeme parser @parens p@ parses @p@ enclosed in parenthesis, -- returning the value of @p@. -parens :: MonadTokenParser m => m a -> m a+parens :: MonadParser m => m a -> m a parens = nesting . between (symbolic '(') (symbolic ')')  -- | Lexeme parser @braces p@ parses @p@ enclosed in braces (\'{\' and -- \'}\'), returning the value of @p@.  -braces :: MonadTokenParser m => m a -> m a+braces :: MonadParser m => m a -> m a braces = nesting . between (symbolic '{') (symbolic '}')  -- | Lexeme parser @angles p@ parses @p@ enclosed in angle brackets (\'\<\' -- and \'>\'), returning the value of @p@.  -angles :: MonadTokenParser m => m a -> m a+angles :: MonadParser m => m a -> m a angles = nesting . between (symbolic '<') (symbolic '>')  -- | Lexeme parser @brackets p@ parses @p@ enclosed in brackets (\'[\' -- and \']\'), returning the value of @p@.  -brackets :: MonadTokenParser m => m a -> m a+brackets :: MonadParser m => m a -> m a brackets = nesting . between (symbolic '[') (symbolic ']')  -- | Lexeme parser @comma@ parses the character \',\' and skips any -- trailing white space. Returns the string \",\".  -comma :: MonadTokenParser m => m Char+comma :: MonadParser m => m Char comma = symbolic ','  -- | Lexeme parser @colon@ parses the character \':\' and skips any -- trailing white space. Returns the string \":\".  -colon :: MonadTokenParser m => m Char+colon :: MonadParser m => m Char colon = symbolic ':'  -- | Lexeme parser @dot@ parses the character \'.\' and skips any -- trailing white space. Returns the string \".\".  -dot :: MonadTokenParser m => m Char+dot :: MonadParser m => m Char dot = symbolic '.'  -- | Lexeme parser @semiSep p@ parses /zero/ or more occurrences of @p@ -- separated by 'semi'. Returns a list of values returned by -- @p@. -semiSep :: MonadTokenParser m => m a -> m [a]+semiSep :: MonadParser m => m a -> m [a] semiSep p = sepBy p semi  -- | Lexeme parser @semiSep1 p@ parses /one/ or more occurrences of @p@ -- separated by 'semi'. Returns a list of values returned by @p@.  -semiSep1 :: MonadTokenParser m => m a -> m [a]+semiSep1 :: MonadParser m => m a -> m [a] semiSep1 p = sepBy1 p semi  -- | Lexeme parser @commaSep p@ parses /zero/ or more occurrences of -- @p@ separated by 'comma'. Returns a list of values returned -- by @p@.  -commaSep :: MonadTokenParser m => m a -> m [a]+commaSep :: MonadParser m => m a -> m [a] commaSep p = sepBy p comma  -- | Lexeme parser @commaSep1 p@ parses /one/ or more occurrences of -- @p@ separated by 'comma'. Returns a list of values returned -- by @p@.  -commaSep1 :: MonadTokenParser m => m a -> m [a]+commaSep1 :: MonadParser m => m a -> m [a] commaSep1 p = sepBy p comma
− Text/Trifecta/Parser/Token/Identifier.hs 
@@ -1,68 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.Trifecta.Parser.Token.Identifier--- Copyright   :  (c) Edward Kmett 2011--- License     :  BSD3--- --- Maintainer  :  ekmett@gmail.com--- Stability   :  provisional--- Portability :  non-portable------ > idStyle = haskellIdentifierStyle { styleReserved = ... }--- > identifier = ident haskellIdentifierStyle--- > reserved   = reserve haskellIdentifierStyle----------------------------------------------------------------------------------module Text.Trifecta.Parser.Token.Identifier-  ( IdentifierStyle(..)-  , liftIdentifierStyle-  , ident-  , reserve-  , reserveByteString-  ) where--import Data.ByteString as Strict hiding (map, zip, foldl, foldr)-import Data.ByteString.UTF8 as UTF8-import Data.HashSet as HashSet-import Control.Applicative-import Control.Monad (when)-import Control.Monad.Trans.Class-import Text.Trifecta.Parser.Class-import Text.Trifecta.Parser.Char-import Text.Trifecta.Parser.Combinators-import Text.Trifecta.Parser.Token.Class-import Text.Trifecta.Parser.Token.Combinators-import Text.Trifecta.Highlight.Prim--data IdentifierStyle m = IdentifierStyle-  { styleName              :: String-  , styleStart             :: m ()-  , styleLetter            :: m ()-  , styleReserved          :: HashSet ByteString-  , styleHighlight         :: Highlight-  , styleReservedHighlight :: Highlight-  }---- | Lift an identifier style into a monad transformer-liftIdentifierStyle :: (MonadTrans t, Monad m) => IdentifierStyle m -> IdentifierStyle (t m)-liftIdentifierStyle s =-  s { styleStart  = lift (styleStart s)-    , styleLetter = lift (styleLetter s)-    }---- | parse a reserved operator or identifier using a given style-reserve :: MonadTokenParser m => IdentifierStyle m -> String -> m ()-reserve s name = reserveByteString s $! UTF8.fromString name---- | parse a reserved operator or identifier using a given style specified by bytestring-reserveByteString :: MonadTokenParser m => IdentifierStyle m -> ByteString -> m ()-reserveByteString s name = lexeme $ try $ do-   _ <- highlight (styleReservedHighlight s) $ byteString name-   notFollowedBy (styleLetter s) <?> "end of " ++ show name---- | parse an non-reserved identifier or symbol-ident :: MonadTokenParser m => IdentifierStyle m -> m ByteString-ident s = lexeme $ try $ do-  name <- highlight (styleHighlight s) (sliced (styleStart s *> skipMany (styleLetter s))) <?> styleName s-  when (member name (styleReserved s)) $ unexpected $ "reserved " ++ styleName s ++ " " ++ show name-  return name
− Text/Trifecta/Parser/Token/Identifier/Style.hs 
@@ -1,70 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.Trifecta.Parser.Token.Identifier.Style--- Copyright   :  (c) Edward Kmett 2011--- License     :  BSD3--- --- Maintainer  :  ekmett@gmail.com--- Stability   :  provisional--- Portability :  non-portable--- -------------------------------------------------------------------------------module Text.Trifecta.Parser.Token.Identifier.Style-  ( -  -- identifier styles-    emptyIdents, haskellIdents, haskell98Idents-  -- operator styles-  , emptyOps, haskellOps, haskell98Ops-  ) where--import Data.ByteString as Strict hiding (map, zip, foldl, foldr)-import Data.ByteString.UTF8 as UTF8-import Data.HashSet as HashSet-import Data.Monoid-import Control.Applicative-import Text.Trifecta.Parser.Char-import Text.Trifecta.Parser.Token.Class-import Text.Trifecta.Parser.Token.Identifier-import Text.Trifecta.Highlight.Prim--set :: [String] -> HashSet ByteString-set = HashSet.fromList . fmap UTF8.fromString--emptyOps, haskell98Ops, haskellOps :: MonadTokenParser m => IdentifierStyle m-emptyOps = IdentifierStyle-  { styleName     = "operator"-  , styleStart    = styleLetter emptyOps-  , styleLetter   = () <$ oneOf ":!#$%&*+./<=>?@\\^|-~"-  , styleReserved = mempty-  , styleHighlight = Operator-  , styleReservedHighlight = ReservedOperator-  }-haskell98Ops = emptyOps -  { styleReserved = set ["::","..","=","\\","|","<-","->","@","~","=>"]-  }-haskellOps = haskell98Ops--emptyIdents, haskell98Idents, haskellIdents :: MonadTokenParser m => IdentifierStyle m-emptyIdents = IdentifierStyle-  { styleName     = "identifier"-  , styleStart    = () <$ (letter <|> char '_')-  , styleLetter   = () <$ (alphaNum <|> oneOf "_'")-  , styleReserved = set []-  , styleHighlight = Identifier-  , styleReservedHighlight = ReservedIdentifier } --haskell98Idents = emptyIdents-  { styleReserved = set haskell98ReservedIdents }-haskellIdents = haskell98Idents-  { styleLetter	  = styleLetter haskell98Idents <|> () <$ char '#'-  , styleReserved = set $ haskell98ReservedIdents ++-      ["foreign","import","export","primitive","_ccall_","_casm_" ,"forall"]-  }--haskell98ReservedIdents :: [String]-haskell98ReservedIdents = -  ["let","in","case","of","if","then","else","data","type"-  ,"class","default","deriving","do","import","infix"-  ,"infixl","infixr","instance","module","newtype"-  ,"where","primitive" -- "as","qualified","hiding"-  ]
Text/Trifecta/Parser/Token/Prim.hs view
@@ -4,11 +4,11 @@ -- Copyright   :  (c) Edward Kmett 2011, --                (c) Daan Leijen 1999-2001 -- License     :  BSD3--- +-- -- Maintainer  :  ekmett@gmail.com -- Stability   :  provisional -- Portability :  non-portable--- +-- ----------------------------------------------------------------------------- module Text.Trifecta.Parser.Token.Prim   ( charLiteral'@@ -35,12 +35,12 @@ -- literal character value. This parsers deals correctly with escape -- sequences. The literal character is parsed according to the grammar -- rules defined in the Haskell report (which matches most programming--- languages quite closely). +-- languages quite closely). ----- This parser does NOT swallow trailing whitespace. +-- This parser does NOT swallow trailing whitespace. charLiteral' :: MonadParser m => m Char charLiteral' = highlight CharLiteral (between (char '\'') (char '\'' <?> "end of character") characterChar)-          <?> "character" +          <?> "character"  characterChar, charEscape, charLetter :: MonadParser m => m Char characterChar = charLetter <|> charEscape@@ -52,21 +52,21 @@ -- string value. This parsers deals correctly with escape sequences and -- gaps. The literal string is parsed according to the grammar rules -- defined in the Haskell report (which matches most programming--- languages quite closely). +-- languages quite closely). -- -- This parser does NOT swallow trailing whitespace stringLiteral' :: MonadParser m => m String stringLiteral' = highlight StringLiteral lit where-  lit = Prelude.foldr (maybe id (:)) "" <$> between (char '"') (char '"' <?> "end of string") (many stringChar) +  lit = Prelude.foldr (maybe id (:)) "" <$> between (char '"') (char '"' <?> "end of string") (many stringChar)     <?> "literal string"-  stringChar = Just <$> stringLetter -           <|> stringEscape +  stringChar = Just <$> stringLetter+           <|> stringEscape        <?> "string character"   stringLetter    = satisfy (\c -> (c /= '"') && (c /= '\\') && (c > '\026'))    stringEscape = highlight EscapeCode $ char '\\' *> esc where-    esc = Nothing <$ escapeGap -      <|> Nothing <$ escapeEmpty +    esc = Nothing <$ escapeGap+      <|> Nothing <$ escapeEmpty       <|> Just <$> escapeCode   escapeEmpty = char '&'   escapeGap = do skipSome space@@ -74,10 +74,10 @@  escapeCode :: MonadParser m => m Char escapeCode = (charEsc <|> charNum <|> charAscii <|> charControl) <?> "escape code"-  where +  where   charControl = (\c -> toEnum (fromEnum c - fromEnum 'A')) <$> (char '^' *> upper)   charNum     = toEnum . fromInteger <$> num where-    num = decimal +    num = decimal       <|> (char 'o' *> number 8 octDigit)       <|> (char 'x' *> number 16 hexDigit)   charEsc = choice $ parseEsc <$> escMap@@ -98,15 +98,15 @@   ascii3 = ['\NUL','\SOH','\STX','\ETX','\EOT','\ENQ','\ACK'            ,'\BEL','\DLE','\DC1','\DC2','\DC3','\DC4','\NAK'            ,'\SYN','\ETB','\CAN','\SUB','\ESC','\DEL']-   + -- | This parser parses a natural number (a positive whole -- number). Returns the value of the number. The number can be -- specified in 'decimal', 'hexadecimal' or -- 'octal'. The number is parsed according to the grammar--- rules in the Haskell report. +-- rules in the Haskell report. ----- This parser does NOT swallow trailing whitespace. +-- This parser does NOT swallow trailing whitespace. natural' :: MonadParser m => m Integer natural' = highlight Number nat <?> "natural" @@ -120,13 +120,13 @@ -- sign (i.e. \'-\' or \'+\'). Returns the value of the number. The -- number can be specified in 'decimal', 'hexadecimal' -- or 'octal'. The number is parsed according--- to the grammar rules in the Haskell report. +-- to the grammar rules in the Haskell report. ----- This parser does NOT swallow trailing whitespace. +-- This parser does NOT swallow trailing whitespace. -- -- Also, unlike the 'integer' parser, this parser does not admit spaces -- between the sign and the number.-        + integer' :: MonadParser m => m Integer integer' = int <?> "integer" @@ -144,9 +144,9 @@  -- | This parser parses a floating point value. Returns the value -- of the number. The number is parsed according to the grammar rules--- defined in the Haskell report. +-- defined in the Haskell report. ----- This parser does NOT swallow trailing whitespace. +-- This parser does NOT swallow trailing whitespace.  double' :: MonadParser m => m Double double' = highlight Number floating <?> "double"@@ -165,7 +165,7 @@        e <- decimal <?> "exponent"        return (power (f e))     <?> "exponent"-  power e  +  power e     | e < 0     = 1.0/power(-e)     | otherwise = fromInteger (10^e) @@ -173,15 +173,15 @@ -- | This parser parses either 'natural' or a 'double'. -- Returns the value of the number. This parsers deals with -- any overlap in the grammar rules for naturals and floats. The number--- is parsed according to the grammar rules defined in the Haskell report. +-- is parsed according to the grammar rules defined in the Haskell report. ----- This parser does NOT swallow trailing whitespace. +-- This parser does NOT swallow trailing whitespace.  naturalOrDouble' :: MonadParser m => m (Either Integer Double) naturalOrDouble' = highlight Number natDouble <?> "number"  natDouble, zeroNumFloat, decimalFloat :: MonadParser m => m (Either Integer Double)-natDouble +natDouble     = char '0' *> zeroNumFloat   <|> decimalFloat zeroNumFloat@@ -189,7 +189,7 @@   <|> decimalFloat   <|> fractFloat 0   <|> return (Left 0)-decimalFloat = do +decimalFloat = do   n <- decimal   option (Left n) (fractFloat n) @@ -197,21 +197,21 @@ fractFloat n = Right <$> fractExponent n  -- | Parses a positive whole number in the decimal system. Returns the--- value of the number. +-- value of the number.  decimal :: MonadParser m => m Integer decimal = number 10 digit  -- | Parses a positive whole number in the hexadecimal system. The number -- should be prefixed with \"x\" or \"X\". Returns the value of the--- number. +-- number.  hexadecimal :: MonadParser m => m Integer hexadecimal = oneOf "xX" *> number 16 hexDigit  -- | Parses a positive whole number in the octal system. The number -- should be prefixed with \"o\" or \"O\". Returns the value of the--- number. +-- number.  octal :: MonadParser m => m Integer octal = oneOf "oO" *> number 8 octDigit
Text/Trifecta/Parser/Token/Style.hs view
@@ -3,21 +3,20 @@ -- Module      :  Text.Trifecta.Parser.Token.Style -- Copyright   :  (c) Edward Kmett 2011 -- License     :  BSD3--- +-- -- Maintainer  :  ekmett@gmail.com -- Stability   :  provisional -- Portability :  non-portable--- +-- ----------------------------------------------------------------------------- module Text.Trifecta.Parser.Token.Style   ( CommentStyle(..)   , emptyCommentStyle   , javaCommentStyle   , haskellCommentStyle-  , buildWhiteSpaceParser+  , buildSomeSpaceParser   ) where -import Data.Char (isSpace) import Control.Applicative import Data.List (nub) import qualified Data.ByteString.Char8 as B@@ -39,17 +38,17 @@ javaCommentStyle    = CommentStyle "/*" "*/" "//" True haskellCommentStyle = CommentStyle "{-" "-}" "--" True --- | Use this to easily build the definition of whiteSpace for your MonadTokenParser-buildWhiteSpaceParser :: MonadParser m => CommentStyle -> m ()-buildWhiteSpaceParser (CommentStyle startStyle endStyle lineStyle nestingStyle)-  | noLine && noMulti  = skipMany (simpleSpace <?> "")-  | noLine             = skipMany (simpleSpace <|> multiLineComment <?> "")-  | noMulti            = skipMany (simpleSpace <|> oneLineComment <?> "")-  | otherwise          = skipMany (simpleSpace <|> oneLineComment <|> multiLineComment <?> "")+-- | Use this to easily build the definition of whiteSpace for your MonadParser+--   given a comment style and an underlying someWhiteSpace parser+buildSomeSpaceParser :: MonadParser m => m () -> CommentStyle -> m ()+buildSomeSpaceParser simpleSpace (CommentStyle startStyle endStyle lineStyle nestingStyle)+  | noLine && noMulti  = skipSome (simpleSpace <?> "")+  | noLine             = skipSome (simpleSpace <|> multiLineComment <?> "")+  | noMulti            = skipSome (simpleSpace <|> oneLineComment <?> "")+  | otherwise          = skipSome (simpleSpace <|> oneLineComment <|> multiLineComment <?> "")   where     noLine  = null lineStyle     noMulti = null startStyle-    simpleSpace = skipSome (satisfy isSpace)     oneLineComment = highlight Comment $ do       _ <- try $ string lineStyle       r <- restOfLine
trifecta.cabal view
@@ -1,6 +1,6 @@ name:          trifecta category:      Text, Parsing, Diagnostics, Pretty Printer, Logging-version:       0.44+version:       0.45 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -77,17 +77,17 @@     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     Text.Trifecta.Parser.Result     Text.Trifecta.Parser.Step     Text.Trifecta.Parser.Token-    Text.Trifecta.Parser.Token.Class     Text.Trifecta.Parser.Token.Combinators     Text.Trifecta.Parser.Token.Prim     Text.Trifecta.Parser.Token.Style-    Text.Trifecta.Parser.Token.Identifier-    Text.Trifecta.Parser.Token.Identifier.Style+    Text.Trifecta.Parser.Identifier+    Text.Trifecta.Parser.Identifier.Style    other-modules:     Text.Trifecta.Util