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:
parent
3b47557794
commit
7aeb998bf3
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user