diff --git a/Text/Trifecta.hs b/Text/Trifecta.hs --- a/Text/Trifecta.hs +++ b/Text/Trifecta.hs @@ -1,3 +1,14 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta +-- Copyright : (C) 2011 Edward Kmett, +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- module Text.Trifecta ( module Text.Trifecta.Diagnostic , module Text.Trifecta.Parser diff --git a/Text/Trifecta/Diagnostic.hs b/Text/Trifecta/Diagnostic.hs --- a/Text/Trifecta/Diagnostic.hs +++ b/Text/Trifecta/Diagnostic.hs @@ -1,3 +1,14 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Diagnostic +-- Copyright : (C) 2011 Edward Kmett, +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- module Text.Trifecta.Diagnostic ( -- * Diagnostics diff --git a/Text/Trifecta/Diagnostic/Class.hs b/Text/Trifecta/Diagnostic/Class.hs --- a/Text/Trifecta/Diagnostic/Class.hs +++ b/Text/Trifecta/Diagnostic/Class.hs @@ -1,4 +1,16 @@ {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies, FlexibleContexts, UndecidableInstances #-} +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Diagnostic.Class +-- Copyright : (C) 2011 Edward Kmett, +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +-- Provides a class for logging and throwing expressive diagnostics. +---------------------------------------------------------------------------- module Text.Trifecta.Diagnostic.Class ( MonadDiagnostic(..) ) where diff --git a/Text/Trifecta/Diagnostic/Combinators.hs b/Text/Trifecta/Diagnostic/Combinators.hs --- a/Text/Trifecta/Diagnostic/Combinators.hs +++ b/Text/Trifecta/Diagnostic/Combinators.hs @@ -1,3 +1,15 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Diagnostic.Combinators +-- Copyright : (C) 2011 Edward Kmett, +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +-- Combinators for throwing and logging expressive diagnostics +---------------------------------------------------------------------------- module Text.Trifecta.Diagnostic.Combinators ( fatal , err diff --git a/Text/Trifecta/Diagnostic/Err.hs b/Text/Trifecta/Diagnostic/Err.hs --- a/Text/Trifecta/Diagnostic/Err.hs +++ b/Text/Trifecta/Diagnostic/Err.hs @@ -1,3 +1,15 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Diagnostic.Err +-- Copyright : (C) 2011 Edward Kmett, +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +-- The unlocated error type used internally within the parser. +---------------------------------------------------------------------------- module Text.Trifecta.Diagnostic.Err ( Err(..) , knownErr diff --git a/Text/Trifecta/Diagnostic/Err/Log.hs b/Text/Trifecta/Diagnostic/Err/Log.hs --- a/Text/Trifecta/Diagnostic/Err/Log.hs +++ b/Text/Trifecta/Diagnostic/Err/Log.hs @@ -1,3 +1,14 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Diagnostic.Err.Log +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- module Text.Trifecta.Diagnostic.Err.Log ( ErrLog(..) ) where diff --git a/Text/Trifecta/Diagnostic/Err/State.hs b/Text/Trifecta/Diagnostic/Err/State.hs --- a/Text/Trifecta/Diagnostic/Err/State.hs +++ b/Text/Trifecta/Diagnostic/Err/State.hs @@ -1,3 +1,14 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Diagnostic.Err.State +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- module Text.Trifecta.Diagnostic.Err.State ( ErrState(..) ) where @@ -7,9 +18,10 @@ import Data.Semigroup import Text.PrettyPrint.Free import Text.Trifecta.Diagnostic.Err +import Text.Trifecta.Diagnostic.Rendering.Caret data ErrState e = ErrState - { errExpected :: !(Set String) + { errExpected :: !(Set (Careted String)) , errMessage :: !(Err e) } diff --git a/Text/Trifecta/Diagnostic/Level.hs b/Text/Trifecta/Diagnostic/Level.hs --- a/Text/Trifecta/Diagnostic/Level.hs +++ b/Text/Trifecta/Diagnostic/Level.hs @@ -1,3 +1,15 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Diagnostic.Level +-- Copyright : (C) 2011 Edward Kmett, +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +-- A fairly straightforward set of common error levels. +---------------------------------------------------------------------------- module Text.Trifecta.Diagnostic.Level ( DiagnosticLevel(..) ) where @@ -7,13 +19,14 @@ import Text.PrettyPrint.Free import System.Console.Terminfo.PrettyPrint +-- | The severity of an error (or message) 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 + = 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 @@ -36,12 +49,14 @@ compare Panic Panic = EQ compare Panic _ = GT +-- | Compute the maximum of two diagnostic levels instance Semigroup DiagnosticLevel where (<>) = max instance Pretty DiagnosticLevel where pretty p = prettyTerm p *> empty +-- | pretty print as a color coded description instance PrettyTerm DiagnosticLevel where prettyTerm (Verbose n) = blue $ text "verbose (" <> prettyTerm n <> char ')' prettyTerm Note = black $ text "note" diff --git a/Text/Trifecta/Diagnostic/Prim.hs b/Text/Trifecta/Diagnostic/Prim.hs --- a/Text/Trifecta/Diagnostic/Prim.hs +++ b/Text/Trifecta/Diagnostic/Prim.hs @@ -1,4 +1,16 @@ {-# LANGUAGE FlexibleContexts, DeriveDataTypeable #-} +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Diagnostic.Prim +-- Copyright : (C) 2011 Edward Kmett, +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +-- Rich diagnostics +---------------------------------------------------------------------------- module Text.Trifecta.Diagnostic.Prim ( Diagnostic(..) , tellDiagnostic diff --git a/Text/Trifecta/Diagnostic/Rendering.hs b/Text/Trifecta/Diagnostic/Rendering.hs --- a/Text/Trifecta/Diagnostic/Rendering.hs +++ b/Text/Trifecta/Diagnostic/Rendering.hs @@ -1,3 +1,14 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Diagnostic.Rendering +-- Copyright : (C) 2011 Edward Kmett, +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- module Text.Trifecta.Diagnostic.Rendering ( Renderable(..) , Source, rendering diff --git a/Text/Trifecta/Diagnostic/Rendering/Caret.hs b/Text/Trifecta/Diagnostic/Rendering/Caret.hs --- a/Text/Trifecta/Diagnostic/Rendering/Caret.hs +++ b/Text/Trifecta/Diagnostic/Rendering/Caret.hs @@ -1,4 +1,15 @@ {-# LANGUAGE MultiParamTypeClasses #-} +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Diagnostic.Rendering.Caret +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- module Text.Trifecta.Diagnostic.Rendering.Caret ( Caret(..) , caret @@ -81,6 +92,12 @@ instance Extend Careted where extend f as@(_ :^ s) = f as :^ s + +instance HasDelta (Careted a) where + delta (_ :^ c) = delta c + +instance HasBytes (Careted a) where + bytes (_ :^ c) = bytes c instance Comonad Careted where extract (a :^ _) = a diff --git a/Text/Trifecta/Diagnostic/Rendering/Fixit.hs b/Text/Trifecta/Diagnostic/Rendering/Fixit.hs --- a/Text/Trifecta/Diagnostic/Rendering/Fixit.hs +++ b/Text/Trifecta/Diagnostic/Rendering/Fixit.hs @@ -1,4 +1,15 @@ {-# LANGUAGE MultiParamTypeClasses #-} +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Diagnostic.Rendering.Fixit +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- module Text.Trifecta.Diagnostic.Rendering.Fixit ( Fixit(..) , drawFixit diff --git a/Text/Trifecta/Diagnostic/Rendering/Prim.hs b/Text/Trifecta/Diagnostic/Rendering/Prim.hs --- a/Text/Trifecta/Diagnostic/Rendering/Prim.hs +++ b/Text/Trifecta/Diagnostic/Rendering/Prim.hs @@ -1,10 +1,22 @@ {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} --- | Diagnostics rendering +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Diagnostic.Rendering.Prim +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) -- --- The type for Lines will very likely change over time, so we can draw lit up control --- characters for ^Z, ^[, <0xff>, etc. this will make for much nicer diagnostics when --- working with protocols! +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +-- The type for Lines will very likely change over time, to enable drawing +-- lit up multi-character versions of control characters for @^Z@, @^[@, +-- @<0xff>@, etc. This will make for much nicer diagnostics when +-- working with protocols. +-- +----------------------------------------------------------------------------- + module Text.Trifecta.Diagnostic.Rendering.Prim ( Rendering(..) , nullRendering diff --git a/Text/Trifecta/Diagnostic/Rendering/Span.hs b/Text/Trifecta/Diagnostic/Rendering/Span.hs --- a/Text/Trifecta/Diagnostic/Rendering/Span.hs +++ b/Text/Trifecta/Diagnostic/Rendering/Span.hs @@ -1,4 +1,15 @@ {-# LANGUAGE MultiParamTypeClasses #-} +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Diagnostic.Rendering.Span +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- module Text.Trifecta.Diagnostic.Rendering.Span ( Span(..) , span diff --git a/Text/Trifecta/Highlight.hs b/Text/Trifecta/Highlight.hs --- a/Text/Trifecta/Highlight.hs +++ b/Text/Trifecta/Highlight.hs @@ -1,7 +1,22 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Highlight +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- module Text.Trifecta.Highlight - ( module Text.Trifecta.Highlight.Prim - , module Text.Trifecta.Highlight.Class + ( + -- * Text.Trifecta.Highlight.Class + Highlightable(..) + -- * Text.Trifecta.Highlight.Prim + , Highlight + , Highlights ) where -import Text.Trifecta.Highlight.Prim import Text.Trifecta.Highlight.Class +import Text.Trifecta.Highlight.Prim diff --git a/Text/Trifecta/Highlight/Class.hs b/Text/Trifecta/Highlight/Class.hs --- a/Text/Trifecta/Highlight/Class.hs +++ b/Text/Trifecta/Highlight/Class.hs @@ -1,3 +1,14 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Highlight.Class +-- Copyright : (C) 2011 Edward Kmett, +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- module Text.Trifecta.Highlight.Class ( Highlightable(..) ) where diff --git a/Text/Trifecta/Highlight/Effects.hs b/Text/Trifecta/Highlight/Effects.hs --- a/Text/Trifecta/Highlight/Effects.hs +++ b/Text/Trifecta/Highlight/Effects.hs @@ -1,3 +1,14 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Highlight.Effects +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- module Text.Trifecta.Highlight.Effects ( highlightEffects , pushToken @@ -12,14 +23,17 @@ import Text.Trifecta.Highlight.Prim highlightEffects :: Highlight -> [ScopedEffect] -highlightEffects Comment = [soft $ Foreground Green] -highlightEffects ReservedIdentifier = [soft $ Foreground Blue] -highlightEffects Operator = [soft $ Foreground Yellow] -highlightEffects ReservedOperator = [soft $ Foreground Yellow] -highlightEffects EscapeCode = [soft $ Foreground Magenta, soft Bold] -highlightEffects CharLiteral = [soft $ Foreground Cyan] -highlightEffects StringLiteral = [soft $ Foreground Cyan] --- highlightEffects Identifier = [] +highlightEffects Comment = [soft $ Foreground Blue] +highlightEffects ReservedIdentifier = [soft $ Foreground Magenta, soft Bold] +highlightEffects ReservedConstructor = [soft $ Foreground Magenta, soft Bold] +highlightEffects EscapeCode = [soft $ Foreground Magenta, soft Bold] +highlightEffects Operator = [soft $ Foreground Yellow] +highlightEffects CharLiteral = [soft $ Foreground Cyan] +highlightEffects StringLiteral = [soft $ Foreground Cyan] +highlightEffects Constructor = [soft Bold] +highlightEffects ReservedOperator = [soft $ Foreground Yellow] +highlightEffects ConstructorOperator = [soft $ Foreground Yellow, soft Bold] +highlightEffects ReservedConstructorOperator = [soft $ Foreground Yellow, soft Bold] highlightEffects _ = [] pushToken, popToken :: Highlight -> TermDoc diff --git a/Text/Trifecta/Highlight/Prim.hs b/Text/Trifecta/Highlight/Prim.hs --- a/Text/Trifecta/Highlight/Prim.hs +++ b/Text/Trifecta/Highlight/Prim.hs @@ -1,3 +1,14 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Highlight.Prim +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- module Text.Trifecta.Highlight.Prim ( Highlight(..) , Highlights @@ -25,6 +36,8 @@ | ReservedConstructor | ConstructorOperator | ReservedConstructorOperator + | BadInput + | Unbound deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded) type Highlights = IntervalMap Delta Highlight diff --git a/Text/Trifecta/Highlight/Rendering/HTML.hs b/Text/Trifecta/Highlight/Rendering/HTML.hs --- a/Text/Trifecta/Highlight/Rendering/HTML.hs +++ b/Text/Trifecta/Highlight/Rendering/HTML.hs @@ -1,4 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Highlight.Rendering.HTML +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- module Text.Trifecta.Highlight.Rendering.HTML ( Doc(..) , doc diff --git a/Text/Trifecta/Parser.hs b/Text/Trifecta/Parser.hs --- a/Text/Trifecta/Parser.hs +++ b/Text/Trifecta/Parser.hs @@ -1,3 +1,14 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Parser +-- Copyright : (C) 2011 Edward Kmett, +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- module Text.Trifecta.Parser ( module Text.Trifecta.Parser.Prim , module Text.Trifecta.Parser.ByteString diff --git a/Text/Trifecta/Parser/Char.hs b/Text/Trifecta/Parser/Char.hs --- a/Text/Trifecta/Parser/Char.hs +++ b/Text/Trifecta/Parser/Char.hs @@ -1,5 +1,16 @@ {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances, FlexibleInstances, FlexibleContexts, PatternGuards #-} {-# OPTIONS_GHC -fspec-constr -fspec-constr-count=8 #-} +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Parser.Char +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- module Text.Trifecta.Parser.Char ( oneOf -- :: MonadParser m => [Char] -> m Char , noneOf -- :: MonadParser m => [Char] -> m Char diff --git a/Text/Trifecta/Parser/Class.hs b/Text/Trifecta/Parser/Class.hs --- a/Text/Trifecta/Parser/Class.hs +++ b/Text/Trifecta/Parser/Class.hs @@ -38,7 +38,6 @@ import Data.ByteString as Strict import Data.ByteString.Internal (w2c) import Data.Semigroup -import Data.Set as Set import Text.Trifecta.Rope.Delta import Text.Trifecta.Rope.Prim import Text.Trifecta.Parser.It @@ -54,7 +53,7 @@ -- | 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 -> Set String -> m a + 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 @@ -230,7 +229,7 @@ -- | label a parser with a name () :: MonadParser m => m a -> String -> m a -p msg = labels p (Set.singleton msg) +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 diff --git a/Text/Trifecta/Parser/It.hs b/Text/Trifecta/Parser/It.hs --- a/Text/Trifecta/Parser/It.hs +++ b/Text/Trifecta/Parser/It.hs @@ -1,5 +1,16 @@ {-# LANGUAGE MultiParamTypeClasses, BangPatterns, MagicHash, UnboxedTuples, TypeFamilies #-} --- | harder, better, faster, stronger... +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Parser.It +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +-- harder, better, faster, stronger... +---------------------------------------------------------------------------- module Text.Trifecta.Parser.It ( It(Pure, It) , needIt diff --git a/Text/Trifecta/Parser/Prim.hs b/Text/Trifecta/Parser/Prim.hs --- a/Text/Trifecta/Parser/Prim.hs +++ b/Text/Trifecta/Parser/Prim.hs @@ -23,10 +23,13 @@ import Control.Monad.Error.Class import Control.Monad.Writer.Class import Control.Monad +import Control.Comonad import qualified Data.Functor.Plus as Plus import Data.Functor.Plus hiding (some, many) +import Data.Function import Data.Semigroup import Data.Foldable +import qualified Data.List as List import Data.Functor.Bind (Apply(..), Bind((>>-))) import qualified Text.Trifecta.IntervalMap as IntervalMap import Data.Set as Set hiding (empty, toList) @@ -188,10 +191,11 @@ unexpected s = Parser $ \ _ ee _ _ -> ee mempty { errMessage = FailErr $ "unexpected " ++ s } labels (Parser p) msgs = Parser $ \ eo ee -> p - (\a e -> eo a $ if knownErr (errMessage e) - then e { errExpected = msgs `union` errExpected e } - else e) - (\e -> ee e { errExpected = msgs }) + (\a e l b8 d bs -> + eo a (if knownErr (errMessage e) + then e { errExpected = Set.fromList (Prelude.map (:^ Caret d bs) msgs) `union` errExpected e } + 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 @@ -274,16 +278,24 @@ why :: Pretty e => (e -> Doc t) -> ErrState e -> Highlights -> Bool -> Delta -> ByteString -> Diagnostic (Doc t) why pp (ErrState ss m) hs _ d bs - | Set.null ss = explicateWith empty m - | knownErr m = explicateWith (char ',' <+> ex) m - | otherwise = Diagnostic r Error ex [] + | Prelude.null now = explicateWith empty m + | knownErr m = explicateWith (char ',' <+> ex) m + | otherwise = Diagnostic r Error ex notes where - ex = text "expected:" <+> fillSep (punctuate (char ',') $ text <$> toList ss) -- TODO: oxford comma, "or" etc... + ex = expect now + expect xs = text "expected:" <+> fillSep (punctuate (char ',') (Prelude.map (text . extract) xs)) + (now,later) = List.partition ((==) d . delta) $ toList ss + -- attach notes for expected tokens at remote locations, clustered by location + clusters = List.groupBy ((==) `on` delta) $ List.sortBy (compare `on` delta) later + diagnoseCluster c = Diagnostic (Right $ addCaret dc $ addHighlights hs $ rendering dc bsc) Note (expect c) [] where + _ :^ Caret dc bsc = Prelude.head c + notes = Prelude.map diagnoseCluster clusters + r = Right $ addCaret d $ addHighlights hs $ rendering d bs - explicateWith x EmptyErr = Diagnostic r Error ((text "unspecified error") <> x) [] - explicateWith x (FailErr s) = Diagnostic r Error ((fillSep $ text <$> words s) <> x) [] - explicateWith x (PanicErr s) = Diagnostic r Panic ((fillSep $ text <$> words s) <> x) [] - explicateWith x (Err rs l e es) = Diagnostic r' l (pp e <> x) (fmap (addHighlights hs . fmap pp) es) + explicateWith x EmptyErr = Diagnostic r Error ((text "unspecified error") <> x) notes + explicateWith x (FailErr s) = Diagnostic r Error ((fillSep $ text <$> words s) <> x) notes + explicateWith x (PanicErr s) = Diagnostic r Panic ((fillSep $ text <$> words s) <> x) notes + explicateWith x (Err rs l e es) = Diagnostic r' l (pp e <> x) (notes ++ fmap (addHighlights hs . fmap pp) es) where r' = Right $ addCaret d $ Prelude.foldr (<>) (addHighlights hs $ rendering d bs) rs parseTest :: Show a => Parser String a -> String -> IO () diff --git a/Text/Trifecta/Parser/Result.hs b/Text/Trifecta/Parser/Result.hs --- a/Text/Trifecta/Parser/Result.hs +++ b/Text/Trifecta/Parser/Result.hs @@ -1,3 +1,14 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Parser.Result +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- module Text.Trifecta.Parser.Result ( Result(..) ) where diff --git a/Text/Trifecta/Parser/Step.hs b/Text/Trifecta/Parser/Step.hs --- a/Text/Trifecta/Parser/Step.hs +++ b/Text/Trifecta/Parser/Step.hs @@ -1,4 +1,15 @@ {-# LANGUAGE FlexibleContexts #-} +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Parser.Step +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- module Text.Trifecta.Parser.Step ( Step(..) , feed diff --git a/Text/Trifecta/Parser/Token.hs b/Text/Trifecta/Parser/Token.hs --- a/Text/Trifecta/Parser/Token.hs +++ b/Text/Trifecta/Parser/Token.hs @@ -1,9 +1,19 @@ - - +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Parser.Token +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- 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 , decimal , hexadecimal , octal @@ -15,6 +25,5 @@ import Text.Trifecta.Parser.Token.Identifier -- expected to be imported manually - -- import Text.Trifecta.Parser.Token.Style -- import Text.Trifecta.Parser.Token.Identifier.Style diff --git a/Text/Trifecta/Rope.hs b/Text/Trifecta/Rope.hs --- a/Text/Trifecta/Rope.hs +++ b/Text/Trifecta/Rope.hs @@ -1,3 +1,14 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Rope +-- Copyright : (C) 2011 Edward Kmett, +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- module Text.Trifecta.Rope ( Rope, rope, strands -- * Strands of a rope diff --git a/Text/Trifecta/Rope/Bytes.hs b/Text/Trifecta/Rope/Bytes.hs --- a/Text/Trifecta/Rope/Bytes.hs +++ b/Text/Trifecta/Rope/Bytes.hs @@ -1,3 +1,14 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Rope.Bytes +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- module Text.Trifecta.Rope.Bytes ( HasBytes(..) ) where diff --git a/Text/Trifecta/Rope/Delta.hs b/Text/Trifecta/Rope/Delta.hs --- a/Text/Trifecta/Rope/Delta.hs +++ b/Text/Trifecta/Rope/Delta.hs @@ -1,3 +1,14 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Rope.Delta +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- module Text.Trifecta.Rope.Delta ( Delta(..) , HasDelta(..) diff --git a/Text/Trifecta/Rope/Highlighted.hs b/Text/Trifecta/Rope/Highlighted.hs --- a/Text/Trifecta/Rope/Highlighted.hs +++ b/Text/Trifecta/Rope/Highlighted.hs @@ -1,4 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Rope.Highlighted +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- module Text.Trifecta.Rope.Highlighted ( HighlightedRope(..) ) where diff --git a/Text/Trifecta/Rope/Prim.hs b/Text/Trifecta/Rope/Prim.hs --- a/Text/Trifecta/Rope/Prim.hs +++ b/Text/Trifecta/Rope/Prim.hs @@ -1,4 +1,15 @@ {-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleInstances, BangPatterns, PatternGuards #-} +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Rope.Prim +-- Copyright : (C) 2011 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- module Text.Trifecta.Rope.Prim ( Rope(..) , rope diff --git a/Text/Trifecta/Util.hs b/Text/Trifecta/Util.hs --- a/Text/Trifecta/Util.hs +++ b/Text/Trifecta/Util.hs @@ -1,3 +1,14 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Trifecta.Util +-- Copyright : (C) 2011 Edward Kmett, +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : non-portable +-- +---------------------------------------------------------------------------- module Text.Trifecta.Util ( argmin , argmax diff --git a/examples/RFC2616.hs b/examples/RFC2616.hs --- a/examples/RFC2616.hs +++ b/examples/RFC2616.hs @@ -10,6 +10,7 @@ import Text.Trifecta.Parser.ByteString import Text.Trifecta.Parser.Combinators import Text.Trifecta.Parser.Char8 +import Text.Trifecta.Highlight.Prim import qualified Text.Trifecta.ByteSet as S import qualified Data.ByteString as B @@ -23,11 +24,11 @@ token :: MonadParser m => m Char token = noneOf $ ['\0'..'\31'] ++ "()<>@,;:\\\"/[]?={} \t" ++ ['\128'..'\255'] -isHorizontalSpace :: Char -> Bool -isHorizontalSpace c = c == ' ' || c == '\t' +isHSpace :: Char -> Bool +isHSpace c = c == ' ' || c == '\t' skipHSpaces :: MonadParser m => m () -skipHSpaces = skipSome (satisfy isHorizontalSpace) +skipHSpaces = skipSome (satisfy isHSpace) data Request = Request { requestMethod :: String @@ -36,11 +37,13 @@ } deriving (Eq, Ord, Show) requestLine :: MonadParser m => m Request -requestLine = Request <$!> (some token <* skipHSpaces) - <*> (some (satisfy (not . isHorizontalSpace)) <* skipHSpaces <* string "HTTP/") - <*> (many httpVersion <* endOfLine) +requestLine = Request <$!> (highlight ReservedIdentifier (some token) "request method") + <* skipHSpaces + <*> (highlight Identifier (some (satisfy (not . isHSpace))) "url") + <* skipHSpaces + <*> (try (highlight ReservedIdentifier (string "HTTP/" *> many httpVersion <* endOfLine)) "protocol") where - httpVersion = satisfy $ \c -> c == '1' || c == '0' || c == '.' + httpVersion = satisfy $ \c -> c == '1' || c == '0' || c == '.' || c == '9' endOfLine :: MonadParser m => m () endOfLine = (string "\r\n" *> pure ()) <|> (char '\n' *> pure ()) @@ -52,9 +55,10 @@ messageHeader :: MonadParser m => m Header messageHeader = (\h b c -> Header h (b : c)) - <$!> (some token <* char ':' <* skipHSpaces) - <*> (manyTill anyChar endOfLine) - <*> (many $ skipHSpaces *> manyTill anyChar endOfLine) + <$!> (highlight ReservedIdentifier (some token) "header name") + <* highlight Operator (char ':') <* skipHSpaces + <*> (highlight Identifier (manyTill anyChar endOfLine) "header value") + <*> (many (skipHSpaces *> manyTill anyChar endOfLine) "blank line") request :: MonadParser m => m (Request, [Header]) request = (,) <$> requestLine <*> many messageHeader <* endOfLine @@ -65,21 +69,5 @@ Nothing -> return () Just rs -> print (length rs) -{- -chunky arg = bracket (openFile arg ReadMode) hClose $ \h -> - loop 0 =<< B.hGetContents h - where - loop !n bs - | B.null bs = print n - | otherwise = case parse myReq arg bs of - Left err -> putStrLn $ arg ++ ": " ++ show err - Right (r,bs') -> loop (n+1) bs' - myReq :: Parser ((Request, [Header]), B.ByteString) - myReq = liftA2 (,) request getInput --} - main :: IO () -main = mapM_ f =<< getArgs - where - f = lumpy - -- f = chunky +main = mapM_ lumpy =<< getArgs diff --git a/trifecta.cabal b/trifecta.cabal --- a/trifecta.cabal +++ b/trifecta.cabal @@ -1,6 +1,6 @@ name: trifecta category: Text, Parsing, Diagnostics, Pretty Printer, Logging -version: 0.40 +version: 0.41 license: BSD3 cabal-version: >= 1.6 license-file: LICENSE