packages feed

trifecta 1.0 → 1.1

raw patch · 7 files changed

+32/−44 lines, 7 files

Files

src/Text/Trifecta.hs view
@@ -14,6 +14,7 @@   , module Text.Trifecta.Highlight   , module Text.Trifecta.Parser   , module Text.Trifecta.Combinators+  , module Text.Trifecta.Result   , module Text.Trifecta.Rope   , module Text.Parser.Combinators   , module Text.Parser.Char@@ -24,6 +25,7 @@ import Text.Trifecta.Highlight import Text.Trifecta.Parser import Text.Trifecta.Combinators+import Text.Trifecta.Result import Text.Trifecta.Rope import Text.Parser.Combinators import Text.Parser.Char
src/Text/Trifecta/Delta.hs view
@@ -83,6 +83,7 @@ int64 :: Int64 -> Doc int64 = pretty . show +-- | Retrieve the character offset within the current line from this 'Delta'. column :: HasDelta t => t -> Int64 column t = case delta t of   Columns c _ -> c@@ -91,6 +92,7 @@   Directed _ _ c _ _ -> c {-# INLINE column #-} +-- | Retrieve the byte offset within the current line from this 'Delta'. columnByte :: Delta -> Int64 columnByte (Columns _ b) = b columnByte (Tab _ _ b) = b@@ -128,16 +130,19 @@   Directed p l _ t _ <> Lines m d t' b      = Directed p (l + m) d                         (t + t') b   Directed _ _ _ t _ <> Directed p l c t' b = Directed p l       c                         (t + t') b +-- | Increment a column number to the next tabstop. nextTab :: Int64 -> Int64 nextTab x = x + (8 - mod x 8) {-# INLINE nextTab #-} +-- | Rewind a 'Delta' to the beginning of the line. rewind :: Delta -> Delta rewind (Lines n _ b d)      = Lines n 0 (b - d) 0 rewind (Directed p n _ b d) = Directed p n 0 (b - d) 0 rewind _                    = Columns 0 0 {-# INLINE rewind #-} +-- | Should we show two things with a 'Delta' on the same line? near :: (HasDelta s, HasDelta t) => s -> t -> Bool near s t = rewind (delta s) == rewind (delta t) {-# INLINE near #-}
src/Text/Trifecta/Highlight.hs view
@@ -41,6 +41,7 @@ import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.ByteString.Lazy.UTF8 as LazyUTF8 +-- | Convert a 'Highlight' into a coloration on a 'Doc'. withHighlight :: Highlight -> Doc -> Doc withHighlight Comment                     = blue withHighlight ReservedIdentifier          = magenta@@ -55,12 +56,7 @@ withHighlight ReservedConstructorOperator = yellow withHighlight _                           = id -{--pushToken, popToken :: Highlight -> Doc-pushToken h = Prelude.foldr (\x b -> pure (Push x) <> b) mempty (withHighlight h)-popToken h  = Prelude.foldr (\_ b -> pure Pop      <> b) mempty (withHighlight h)--}-+-- | A 'HighlightedRope' is a 'Rope' with an associated 'IntervalMap' full of highlighted regions. data HighlightedRope = HighlightedRope   { _ropeHighlights :: !(IM.IntervalMap Delta Highlight)   , _ropeContent    :: {-# UNPACK #-} !Rope@@ -122,6 +118,7 @@  makeClassy ''HighlightDoc +-- | Generate an HTML document from a title and a 'HighlightedRope'. doc :: String -> HighlightedRope -> HighlightDoc doc t r = HighlightDoc t "trifecta.css" r @@ -132,29 +129,3 @@       title $ toHtml t       link ! rel "stylesheet" ! type_ "text/css" ! href (toValue css)     body $ toHtml cs--{--newtype Highlighter m a = Highlighter { runHighlighter :: IntervalMap Map Highlight -> m (a, IntervalMap Map Highlight) }-  deriving (Functor)--instance (Functor m, Monad m) => Applicative (Highlighter m) where-  (<*>) = ap-  pure = return--instance (Functor m, MonadPlus m) => Alternative (Highlighter m) where-  (<|>) = mplus-  empty = mzero--instance Monad m => Monad (Highlighter m) where-  return a = Highlighter $ \s -> return (a, s)-  Highlighter m >>= f = Highlighter $ \s -> m s >>= \(a, s') -> runHighlighter (f a) s'--instance MonadTrans Highlighter where-  lift m = Highlighter $ \s -> fmap (\a -> (a,s)) m--instance MonadPlus m => MonadPlus (Highlighter m) where-  mplus (Highlighter m) (Highligher n) = Highlighter $ \s -> m s `mplus` n s-  mzero = Highlighter $ const mzero---- instance Parsing m => Parsing (Highlighter m) where--}
src/Text/Trifecta/Parser.hs view
@@ -114,7 +114,7 @@   {-# INLINE (>>=) #-}   (>>) = (*>)   {-# INLINE (>>) #-}-  fail s = Parser $ \ _ ee _ _ _ _ -> ee (failing s)+  fail s = Parser $ \ _ ee _ _ _ _ -> ee (failed s)   {-# INLINE fail #-}  instance MonadPlus Parser where@@ -126,7 +126,7 @@ manyAccum :: (a -> [a] -> [a]) -> Parser a -> Parser [a] manyAccum f (Parser p) = Parser $ \eo _ co ce d bs ->   let walk xs x es d' bs' = p (manyErr d' bs') (\e -> co (f x xs) (_expected e <> es) d' bs') (walk (f x xs)) ce d' bs'-      manyErr d' bs' _ e  = ce $ explain (renderingCaret d' bs') (e <> failing "'many' applied to a parser that accepted an empty string")+      manyErr d' bs' _ e  = ce $ explain (renderingCaret d' bs') (e <> failed "'many' applied to a parser that accepted an empty string")   in p (manyErr d bs) (eo []) (walk []) ce d bs  liftIt :: It Rope a -> Parser a@@ -144,7 +144,7 @@   {-# INLINE (<?>) #-}   skipMany p = () <$ manyAccum (\_ _ -> []) p   {-# INLINE skipMany #-}-  unexpected s = Parser $ \ _ ee _ _ _ _ -> ee $ failing $ "unexpected " ++ s+  unexpected s = Parser $ \ _ ee _ _ _ _ -> ee $ failed $ "unexpected " ++ s   {-# INLINE unexpected #-}   eof = notFollowedBy anyChar <?> "end of input"   {-# INLINE eof #-}@@ -156,7 +156,7 @@ instance CharParsing Parser where   satisfy f = Parser $ \ _ ee co _ d bs ->     case UTF8.uncons $ Strict.drop (fromIntegral (columnByte d)) bs of-      Nothing        -> ee (failing "unexpected EOF")+      Nothing        -> ee (failed "unexpected EOF")       Just (c, xs)         | not (f c)       -> ee mempty         | Strict.null xs  -> let !ddc = d <> delta c
src/Text/Trifecta/Result.hs view
@@ -31,7 +31,7 @@   -- * Parsing Errors   , Err(..), HasErr(..)   , explain-  , failing+  , failed   ) where  import Control.Applicative as Alternative@@ -41,13 +41,14 @@ import Data.Maybe (fromMaybe, isJust) import qualified Data.List as List import Data.Semigroup--- import Data.Sequence as Seq hiding (empty) import Data.Set as Set hiding (empty, toList) import Text.PrettyPrint.ANSI.Leijen as Pretty hiding (line, (<>), (<$>), empty) import Text.Trifecta.Instances () import Text.Trifecta.Rendering import Text.Trifecta.Delta as Delta +-- | This is used to report an error. What went wrong, some supplemental docs and a set of things expected+-- at the current location. This does not, however, include the actual location. data Err = Err   { _reason    :: Maybe Doc   , _footnotes :: [Doc]@@ -59,14 +60,20 @@ instance Semigroup Err where   Err md mds mes <> Err nd nds nes     = Err (nd <|> md) (if isJust nd then nds else if isJust md then mds else nds ++ mds) (mes <> nes)+  {-# INLINE (<>) #-}  instance Monoid Err where   mempty = Err Nothing [] mempty+  {-# INLINE mempty #-}   mappend = (<>)+  {-# INLINE mappend #-} -failing :: String -> Err-failing m = Err (Just (fillSep (pretty <$> words m))) [] mempty+-- | Generate a simple 'Err' word-wrapping the supplied message.+failed :: String -> Err+failed m = Err (Just (fillSep (pretty <$> words m))) [] mempty+{-# INLINE failed #-} +-- | Convert a location and an 'Err' into a 'Doc' explain :: Rendering -> Err -> Doc explain r (Err mm as es)   | Set.null es = report (withEx mempty)@@ -82,11 +89,13 @@              <|> pretty r <$ guard (not (nullRendering r))              <|> as +-- | The result of parsing. Either we succeeded or something went wrong. data Result a   = Success a   | Failure Doc   deriving (Show,Functor,Foldable,Traversable) +-- | A 'Prism' that lets you embed or retrieve a 'Result' in a potentially larger type. class AsResult p f s t a b | s -> a, t -> b, s b -> t, t a -> s where   _Result :: Overloaded p f s t (Result a) (Result b) @@ -94,12 +103,14 @@   _Result = id   {-# INLINE _Result #-} +-- | The 'Prism' for the 'Success' constructor of 'Result' _Success :: (AsResult p f s t a b, Choice p, Applicative f) => Overloaded p f s t a b _Success = _Result . dimap seta (either id id) . right' . rmap (fmap Success) where   seta (Success a) = Right a   seta (Failure d) = Left (pure (Failure d)) {-# INLINE _Success #-} +-- | The 'Prism' for the 'Failure' constructor of 'Result' _Failure :: (AsResult p f s s a a, Choice p, Applicative f) => Overloaded' p f s Doc _Failure = _Result . dimap seta (either id id) . right' . rmap (fmap Failure) where   seta (Failure d) = Right d
src/Text/Trifecta/Rope.hs view
@@ -30,14 +30,13 @@ import GHC.Generics import Data.Foldable (toList) import Data.Hashable-import Data.Int (Int64) import Text.Trifecta.Util.Combinators as Util import Text.Trifecta.Delta import Data.Data  data Strand   = Strand        {-# UNPACK #-} !ByteString !Delta-  | LineDirective {-# UNPACK #-} !ByteString {-# UNPACK #-} !Int64+  | Skipping !Delta   deriving (Show, Data, Typeable, Generic)  strand :: ByteString -> Strand@@ -45,7 +44,7 @@  instance Measured Delta Strand where   measure (Strand _ s) = delta s-  measure (LineDirective p l) = delta (Directed p l 0 0 0)+  measure (Skipping d) = d  instance Hashable Strand
trifecta.cabal view
@@ -1,6 +1,6 @@ name:          trifecta category:      Text, Parsing, Diagnostics, Pretty Printer, Logging-version:       1.0+version:       1.1 license:       BSD3 cabal-version: >= 1.10 license-file:  LICENSE