From 6d47c9027150cbefa8907ef43fd4397055de1ed5 Mon Sep 17 00:00:00 2001 From: joshvera Date: Fri, 1 Jun 2018 12:47:01 -0400 Subject: [PATCH] Use DerivingStrategies to specify ErrorStack MessaField instance --- src/Data/Syntax.hs | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs index 02651fa8d..b1da6e3f5 100644 --- a/src/Data/Syntax.hs +++ b/src/Data/Syntax.hs @@ -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