github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-29 18:06:14 +03:00
Code Issues Projects Releases Wiki Activity

Fix up Data.Error

Browse Source
This commit is contained in:
Patrick Thomson 2018-07-17 15:48:14 -04:00
parent 3b47557794
commit 7aeb998bf3
1 changed files with 24 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
src/Data/Error.hs
View File

@ -1,31 +1,39 @@
{-# LANGUAGE GADTs, ImplicitParams, RankNTypes, StandaloneDeriving #-} {-# LANGUAGE GADTs, ImplicitParams, RankNTypes, StandaloneDeriving #-}
module Data.Error where module Data.Error
( Error (..)
, formatError
, makeError
, showExpectation
, withCallStack
, withSGRCode
) where
import Prologue import Prologue
import Data.Blob
import Data.ByteString (isSuffixOf) import Data.ByteString (isSuffixOf)
import Data.ByteString.Char8 (pack, unpack) import Data.ByteString.Char8 (pack, unpack)
import Data.Ix (inRange) import Data.Ix (inRange)
import Data.List (intersperse) import Data.List (intersperse)
import Data.Source
import Data.Span
import System.Console.ANSI 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 data Error grammar = Error
{ errorSpan :: Span { errorSpan :: Span
, errorExpected :: [grammar] , errorExpected :: [grammar]
, errorActual :: Maybe grammar , errorActual :: Maybe grammar
, errorCallStack :: CallStack , errorCallStack :: CallStack
} deriving (Typeable) } deriving (Show, Functor, Typeable)
-- | This instance does not take into account the call stack. -- | This instance does not take into account the call stack.
instance Eq grammar => Eq (Error grammar) where instance Eq grammar => Eq (Error grammar) where
(Error s e a _) == (Error s' e' a' _) = (s == s') && (e == e') && (a == a') (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) instance Exception (Error String)
makeError :: HasCallStack => Span -> [grammar] -> Maybe grammar -> Error grammar makeError :: HasCallStack => Span -> [grammar] -> Maybe grammar -> Error grammar
@ -70,11 +78,11 @@ showExpectation colourize = go
showSymbols :: Colourize -> [String] -> ShowS showSymbols :: Colourize -> [String] -> ShowS
showSymbols colourize = go showSymbols colourize = go
where go [] = showString "end of input nodes" where go [] = showString "end of input nodes"
go [symbol] = showSymbol symbol go [symbol] = showSymbol symbol
go [a, b] = showSymbol a . showString " or " . showSymbol b go [a, b] = showSymbol a . showString " or " . showSymbol b
go [a, b, c] = showSymbol a . showString ", " . showSymbol b . showString ", or " . showSymbol c 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 showSymbol = withSGRCode colourize [SetColor Foreground Vivid Red] . showString
showSpan :: Maybe FilePath -> Span -> ShowS showSpan :: Maybe FilePath -> Span -> ShowS