diff --git a/src/Data/Error.hs b/src/Data/Error.hs index 0a9cb9ca1..e25c34e43 100644 --- a/src/Data/Error.hs +++ b/src/Data/Error.hs @@ -1,31 +1,39 @@ {-# LANGUAGE GADTs, ImplicitParams, RankNTypes, StandaloneDeriving #-} -module Data.Error where +module Data.Error + ( Error (..) + , formatError + , makeError + , showExpectation + , withCallStack + , withSGRCode + ) where import Prologue -import Data.Blob + import Data.ByteString (isSuffixOf) import Data.ByteString.Char8 (pack, unpack) import Data.Ix (inRange) import Data.List (intersperse) -import Data.Source -import Data.Span import System.Console.ANSI +import Data.Blob +import Data.Source +import Data.Span + +-- | Rather than using the Error constructor directly, you probably +-- want to call 'makeError', which takes care of inserting the call +-- stack for you. data Error grammar = Error - { errorSpan :: Span - , errorExpected :: [grammar] - , errorActual :: Maybe grammar + { errorSpan :: Span + , errorExpected :: [grammar] + , errorActual :: Maybe grammar , errorCallStack :: CallStack - } deriving (Typeable) + } deriving (Show, Functor, Typeable) -- | This instance does not take into account the call stack. instance Eq grammar => Eq (Error grammar) where (Error s e a _) == (Error s' e' a' _) = (s == s') && (e == e') && (a == a') -deriving instance Foldable Error -deriving instance Functor Error -deriving instance Show grammar => Show (Error grammar) -deriving instance Traversable Error instance Exception (Error String) makeError :: HasCallStack => Span -> [grammar] -> Maybe grammar -> Error grammar @@ -70,11 +78,11 @@ showExpectation colourize = go showSymbols :: Colourize -> [String] -> ShowS showSymbols colourize = go - where go [] = showString "end of input nodes" - go [symbol] = showSymbol symbol - go [a, b] = showSymbol a . showString " or " . showSymbol b + where go [] = showString "end of input nodes" + go [symbol] = showSymbol symbol + go [a, b] = showSymbol a . showString " or " . showSymbol b go [a, b, c] = showSymbol a . showString ", " . showSymbol b . showString ", or " . showSymbol c - go (h:t) = showSymbol h . showString ", " . go t + go (h:t) = showSymbol h . showString ", " . go t showSymbol = withSGRCode colourize [SetColor Foreground Vivid Red] . showString showSpan :: Maybe FilePath -> Span -> ShowS