trifecta 0.25 → 0.26
raw patch · 10 files changed
+79/−40 lines, 10 files
Files
- Text/Trifecta/Diagnostic/Err.hs +7/−2
- Text/Trifecta/Diagnostic/Level.hs +11/−1
- Text/Trifecta/Diagnostic/Rendering/Span.hs +2/−2
- Text/Trifecta/Parser/Char.hs +4/−3
- Text/Trifecta/Parser/Class.hs +5/−6
- Text/Trifecta/Parser/Combinators.hs +3/−9
- Text/Trifecta/Parser/Literals.hs +4/−3
- Text/Trifecta/Parser/Prim.hs +39/−10
- Text/Trifecta/Rope/Delta.hs +3/−3
- trifecta.cabal +1/−1
Text/Trifecta/Diagnostic/Err.hs view
@@ -14,8 +14,9 @@ -- | unlocated error data Err e- = EmptyErr- | FailErr String+ = EmptyErr -- empty, no error specified+ | FailErr String -- a recoverable error caused by fail+ | PanicErr String -- something is bad with the grammar, fail fast | Err [Rendering] !DiagnosticLevel e [Diagnostic e] deriving Show @@ -25,17 +26,21 @@ fatalErr :: Err e -> Bool fatalErr (Err _ Fatal _ _) = True+fatalErr (PanicErr _) = True fatalErr _ = False instance Functor Err where fmap _ EmptyErr = EmptyErr fmap _ (FailErr s) = FailErr s+ fmap _ (PanicErr s) = PanicErr s fmap f (Err rs l e es) = Err rs l (f e) (fmap (fmap f) es) instance Alt Err where a <!> EmptyErr = a _ <!> a@(Err _ Fatal _ _) = a a@(Err _ Fatal _ _) <!> _ = a+ _ <!> a@PanicErr{} = a+ a@PanicErr{} <!> _ = a _ <!> b = b {-# INLINE (<!>) #-}
Text/Trifecta/Diagnostic/Level.hs view
@@ -7,7 +7,13 @@ import Text.PrettyPrint.Free import System.Console.Terminfo.PrettyPrint -data DiagnosticLevel = Verbose !Int | Note | Warning | Error | Fatal+data DiagnosticLevel + = Verbose !Int -- a comment we should only show to the excessively curious+ | Note -- a comment+ | Warning -- a warning, computation continues+ | Error -- a user specified error+ | Fatal -- a user specified fatal error + | Panic -- a non-maskable death sentence thrown by the parser itself deriving (Eq,Show,Read) instance Ord DiagnosticLevel where@@ -22,9 +28,13 @@ compare Warning _ = LT compare Error Error = EQ compare Error Fatal = LT+ compare Error Panic = LT compare Error _ = GT+ compare Fatal Panic = LT compare Fatal Fatal = EQ compare Fatal _ = GT+ compare Panic Panic = EQ+ compare Panic _ = GT instance Semigroup DiagnosticLevel where (<>) = max
Text/Trifecta/Diagnostic/Rendering/Span.hs view
@@ -36,8 +36,8 @@ drawSpan :: Delta -> Delta -> Delta -> Lines -> Lines drawSpan s e d a- | nl && nh = go (column l) (P.replicate (max (column h - column l + 1) 0) '~') a- | nl = go (column l) (P.replicate (max (snd (snd (bounds a)) - column l + 2) 0) '~') a+ | nl && nh = go (column l) (P.replicate (max (column h - column l) 0) '~') a+ | nl = go (column l) (P.replicate (max (snd (snd (bounds a)) - column l + 1) 0) '~') a | nh = go (-1) (P.replicate (max (column h + 1) 0) '~') a | otherwise = a where
Text/Trifecta/Parser/Char.hs view
@@ -23,6 +23,7 @@ import Control.Applicative import Control.Monad (guard) import Text.Trifecta.Parser.Class+import Text.Trifecta.Rope.Delta import Data.ByteString as Strict hiding (empty, all, elem) import Data.ByteString.UTF8 as UTF8 @@ -130,10 +131,10 @@ lbs = Strict.length bs guard $ lr > 0 case compare lbs lr of- LT | bs `isPrefixOf` r -> bs <$ skipping bs+ LT | bs `isPrefixOf` r -> bs <$ skipping (delta bs) | otherwise -> empty- EQ | bs == r -> bs <$ skipping bs+ EQ | bs == r -> bs <$ skipping (delta bs) | otherwise -> empty- GT | r `isPrefixOf` bs -> bs <$ skipping r *> byteString (Strict.drop lr bs)+ GT | r `isPrefixOf` bs -> bs <$ skipping (delta r) *> byteString (Strict.drop lr bs) | otherwise -> empty <?> UTF8.toString bs
Text/Trifecta/Parser/Class.hs view
@@ -14,7 +14,6 @@ module Text.Trifecta.Parser.Class ( MonadParser(..) , restOfLine- , skipping , (<?>) , slicedWith , sliced@@ -53,7 +52,12 @@ mark :: m Delta unexpected :: MonadParser m => String -> m a line :: m ByteString+ skipMany :: m a -> m ()+ skipMany p = () <$ many p + -- useful when we've just recognized something out of band using access to the current line + skipping :: Delta -> m ()+ -- actions that definitely commit release :: Delta -> m () satisfy :: (Char -> Bool) -> m Char@@ -152,11 +156,6 @@ -- instance (MonadParser m, Monoid w) => MonadParser (MaybeT m) where -- instance (Error e, MonadParser m, Monoid w) => MonadParser (ErrorT e m) where --- useful when we've just recognized something out of band using access to the current line -skipping :: (MonadParser m, HasDelta d) => d -> m d-skipping d = do- m <- mark- d <$ release (m <> delta d) -- | grab the remainder of the current line restOfLine :: MonadParser m => m ByteString
Text/Trifecta/Parser/Combinators.hs view
@@ -19,9 +19,8 @@ , skipOptional -- parsec optional , between , skipSome -- parsec skipMany1- , skipMany- , some -- from Control.Applicative, parsec many1- , many -- from Control.Applicative+ , some -- from Control.Applicative, parsec many1+ , many -- from Control.Applicative , sepBy , sepBy1 , sepEndBy1@@ -74,13 +73,8 @@ -- | @skipSome p@ applies the parser @p@ /one/ or more times, skipping -- its result. (aka skipMany1 in parsec)-skipSome :: Alternative m => m a -> m ()+skipSome :: MonadParser m => m a -> m () skipSome p = p *> skipMany p---- | @skipMany1 p@ applies the parser @p@ /one/ or more times, skipping--- its result. -skipMany :: Alternative m => m a -> m ()-skipMany p = ps where ps = (p *> ps) <|> pure () -- | @sepBy p sep@ parses /zero/ or more occurrences of @p@, separated -- by @sep@. Returns a list of values returned by @p@.
Text/Trifecta/Parser/Literals.hs view
@@ -23,6 +23,7 @@ ) where import Data.Char (digitToInt)+import Data.Foldable import Control.Applicative import Text.Trifecta.Parser.Class import Text.Trifecta.Parser.Char@@ -54,7 +55,7 @@ -- This parser does NOT swallow trailing whitespace stringLiteral' :: MonadParser m => m String stringLiteral' = lit where- lit = 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 @@ -110,7 +111,7 @@ number :: MonadParser m => Integer -> m Char -> m Integer number base baseDigit = do digits <- some baseDigit- return $! foldl (\x d -> base*x + toInteger (digitToInt d)) 0 digits+ return $! foldl' (\x d -> base*x + toInteger (digitToInt d)) 0 digits -- | This lexeme parser parses an integer (a whole number). This parser -- is like 'natural' except that it can be prefixed with@@ -153,7 +154,7 @@ fractExponent :: MonadParser m => Integer -> m Double fractExponent n = (\fract expo -> (fromInteger n + fract) * expo) <$> fraction <*> option 1.0 exponent' <|> (fromInteger n *) <$> exponent' where- fraction = foldr op 0.0 <$> (char '.' *> (some digit <?> "fraction"))+ fraction = Prelude.foldr op 0.0 <$> (char '.' *> (some digit <?> "fraction")) op d f = (f + fromIntegral (digitToInt d))/10.0 exponent' = do _ <- oneOf "eE"
Text/Trifecta/Parser/Prim.hs view
@@ -15,13 +15,15 @@ , why , stepParser , parseTest+ , manyAccum ) where import Control.Applicative import Control.Monad.Error.Class import Control.Monad.Writer.Class import Control.Monad-import Data.Functor.Plus+import qualified Data.Functor.Plus as Plus+import Data.Functor.Plus hiding (some, many) import Data.Semigroup import Data.Foldable import Data.Monoid@@ -33,6 +35,7 @@ import Text.PrettyPrint.Free hiding (line) import Text.Trifecta.Rope.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@@ -80,7 +83,10 @@ (\_ e -> n (\a e' -> co a (e <> e')) ce (\a e' -> co a (e <> e')) ce) ce {-# INLINE (*>) #-} -instance Alt (Parser e) where (<!>) = (<|>)+instance Alt (Parser e) where + (<!>) = (<|>)+ many p = Prelude.reverse <$> manyAccum (:) p+ some p = p *> many p instance Plus (Parser e) where zero = empty instance Alternative (Parser e) where empty = Parser $ \_ ee _ _ -> ee mempty@@ -90,6 +96,10 @@ m eo (\e -> n (\a e'-> eo a (e <> e')) (\e' -> ee (e <> e')) co ce) co ce {-# INLINE (<|>) #-}+ many p = Prelude.reverse <$> manyAccum (:) p+ {-# INLINE many #-}+ some p = (:) <$> p <*> many p+ instance Semigroup (Parser e a) where (<>) = (<|>) @@ -131,7 +141,14 @@ (\ e' l' -> ce e' (l <> l')) mempty {-# INLINE pass #-}-+manyAccum :: (a -> [a] -> [a]) -> Parser e a -> Parser e [a]+manyAccum acc (Parser p) = Parser $ \eo _ co ce -> + let walk xs x _ = p manyErr (\_ -> co (acc x xs) mempty) (walk (acc x xs)) ce+ -- NB: to squelch this error you can change your grammar to add a commit, if you are progressing+ -- in some other fashion+ manyErr _ e = ce e { errMessage = PanicErr "'many' applied to a parser that accepted an empty string" }+ in p manyErr (eo []) (walk []) ce+ instance MonadDiagnostic e (Parser e) where fatalWith ds rs e = Parser $ \_ _ _ ce -> ce mempty { errMessage = Err rs Fatal e ds }@@ -170,10 +187,24 @@ mbs <- rewindIt d' case mbs of Just bs' -> co () mempty l d' bs'- Nothing -> ee mempty l d bs+ Nothing + | bytes d' == bytes (rewind d) + Strict.length bs -> co () mempty l d' $ + if near d d' then bs else mempty+ | otherwise -> ee mempty l d bs+ skipping d' = Parser $ \_ ee co _ l d bs -> do+ let d'' = d <> d'+ mbs <- rewindIt d''+ case mbs of+ Just bs' -> co () mempty l d'' bs'+ Nothing + | bytes d'' == bytes (rewind d) + Strict.length bs -> co () mempty l d'' $+ if near d d'' then bs else mempty+ | otherwise -> ee mempty l d bs {-# INLINE release #-} line = Parser $ \eo _ _ _ l d bs -> eo bs mempty l d bs {-# INLINE line #-}+ skipMany p = () <$ manyAccum (\_ _ -> []) p+ {-# INLINE skipMany #-} satisfy f = Parser $ \ _ ee co _ l d bs -> case UTF8.uncons $ Strict.drop (columnByte d) bs of Nothing -> ee mempty { errMessage = FailErr "unexpected EOF" } l d bs@@ -205,13 +236,10 @@ where ju a e l d bs = Pure (JuSt a e l d bs) no e l d bs = Pure (NoSt e l d bs)- extendLog e l d bs - | knownErr (errMessage e) = l |> y e d bs- | otherwise = l- go r (Pure (JuSt a e l d bs)) = StepDone r (extendLog e (yl <$> l) d bs) a+ go r (Pure (JuSt a _ l _ _)) = StepDone r (yl <$> l) a go r (Pure (NoSt e l d bs)) = StepFail r (yl <$> l) $ y e d bs go r (It ma k) = StepCont r (case ma of- JuSt a e l d bs -> Success (extendLog e (yl <$> l) d bs) a+ JuSt a _ l _ _ -> Success (yl <$> l) a NoSt e l d bs -> Failure (yl <$> l) $ y e d bs) (go <*> k) @@ -222,8 +250,9 @@ where expected doc = doc <> text ", expected" <+> fillSep (punctuate (char ',') $ text <$> toList ss) r = addCaret d $ rendering d bs- explicate EmptyErr = Diagnostic r Error (text "error") []+ explicate EmptyErr = Diagnostic r Error (text "unspecified error") [] explicate (FailErr s) = Diagnostic r Error (fillSep $ text <$> words s) []+ explicate (PanicErr s) = Diagnostic r Fatal (fillSep $ text <$> words s) [] explicate (Err rs l e es) = Diagnostic (addCaret d $ Prelude.foldr (<>) (rendering d bs) rs) l (pp e) (fmap (fmap pp) es) parseTest :: Show a => Parser String a -> String -> IO ()
Text/Trifecta/Rope/Delta.hs view
@@ -53,14 +53,14 @@ instance PrettyTerm Delta where prettyTerm d = case d of- Columns c _ -> k f 1 c- Tab x y _ -> k f 1 (nextTab x + y)+ Columns c _ -> k f 0 c+ Tab x y _ -> k f 0 (nextTab x + y) Lines l c _ _ -> k f l c Directed (Path _ _ _ fn _ _) l c _ _ -> k (maybeFileName f unintern fn) l c -- TODO: add include path where k fn ln cn = bold (string fn) <> char ':' - <> bold (int ln) + <> bold (int (ln + 1)) <> char ':' <> bold (int (cn + 1)) f = "(interactive)"
trifecta.cabal view
@@ -1,6 +1,6 @@ name: trifecta category: Text, Parsing, Diagnostics, Pretty Printer, Logging-version: 0.25+version: 0.26 license: BSD3 cabal-version: >= 1.6 license-file: LICENSE