github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-03 13:02:37 +03:00
Code Issues Projects Releases Wiki Activity

Use DerivingStrategies to specify ErrorStack MessaField instance

Browse Source
This commit is contained in:
joshvera 2018-06-01 12:47:01 -04:00
parent ad97723cd2
commit 6d47c90271
1 changed files with 16 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/Data/Syntax.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE AllowAmbiguousTypes, DeriveAnyClass, GADTs, TypeOperators, MultiParamTypeClasses, UndecidableInstances, ScopedTypeVariables, KindSignatures, RankNTypes, ConstraintKinds #-}
{-# LANGUAGE AllowAmbiguousTypes, DeriveAnyClass, GADTs, TypeOperators, MultiParamTypeClasses, UndecidableInstances, ScopedTypeVariables, KindSignatures, RankNTypes, ConstraintKinds, GeneralizedNewtypeDeriving, DerivingStrategies #-}
{-# OPTIONS_GHC -Wno-redundant-constraints -fno-warn-orphans #-} -- For HasCallStack
module Data.Syntax where
@ -209,8 +209,21 @@ errorSyntax Error.Error{..} = Error (ErrorStack (getCallStack callStack)) errorE
unError :: Span -> Error a -> Error.Error String
unError span Error{..} = Error.withCallStack (freezeCallStack (fromCallSiteList (unErrorStack errorCallStack))) (Error.Error span errorExpected errorActual)
newtype ErrorStack = ErrorStack { unErrorStack :: [(String, SrcLoc)] }
deriving (Eq, Show)
data ErrorSite = ErrorSite { errorMessage :: ByteString, errorLocation :: SrcLoc }
deriving (Eq, Show, Generic, Named, Message)
newtype ErrorStack = ErrorStack { unErrorStack :: [ErrorSite] }
deriving stock (Eq, Show, Generic)
deriving anyclass (Named, Message)
deriving newtype (MessageField)
instance HasDefault ErrorStack where
def = ErrorStack mempty
deriving instance Generic SrcLoc
deriving instance Named SrcLoc
deriving instance MessageField SrcLoc
instance ToJSON ErrorStack where
toJSON (ErrorStack es) = toJSON (jSite <$> es) where