{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Data.Record.Internal.Plugin.Exception (
Exception(..)
, exceptionLoc
, exceptionToSDoc
) where
import Data.Record.Internal.GHC.Shim
data Exception =
UnsupportedStockDeriving (LHsType GhcPs)
| UnsupportedStrategy (LDerivStrategy GhcPs)
| InvalidDeclaration (LHsDecl GhcPs)
exceptionLoc :: Exception -> SrcSpan
exceptionLoc :: Exception -> SrcSpan
exceptionLoc = \case
UnsupportedStockDeriving LHsType GhcPs
x -> forall a. ToSrcSpan a => a -> SrcSpan
toSrcSpan LHsType GhcPs
x
UnsupportedStrategy LDerivStrategy GhcPs
x -> forall a. ToSrcSpan a => a -> SrcSpan
toSrcSpan LDerivStrategy GhcPs
x
InvalidDeclaration LHsDecl GhcPs
x -> forall a. ToSrcSpan a => a -> SrcSpan
toSrcSpan LHsDecl GhcPs
x
exceptionToSDoc :: Exception -> SDoc
exceptionToSDoc :: Exception -> SDoc
exceptionToSDoc = [SDoc] -> SDoc
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
UnsupportedStockDeriving LHsType GhcPs
ty -> [
SDoc
"Unsupported stock class: "
, forall a. Outputable a => a -> SDoc
ppr LHsType GhcPs
ty
]
UnsupportedStrategy (L SrcSpan
_ DerivStrategy GhcPs
strategy) -> [
SDoc
"Strategy "
, forall a. DerivStrategy a -> SDoc
derivStrategyName DerivStrategy GhcPs
strategy
, SDoc
" is not supported"
]
InvalidDeclaration LHsDecl GhcPs
_decl -> [
SDoc
"Unsupported declaration for large-records"
]