1
1
mirror of https://github.com/github/semantic.git synced 2024-12-29 01:42:43 +03:00

Fix up Data.Error

This commit is contained in:
Patrick Thomson 2018-07-17 15:48:14 -04:00
parent 3b47557794
commit 7aeb998bf3

View File

@ -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