{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns      #-}

-- | Exceptions that may be thrown by the large-records plugin.
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 -> GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a. ToSrcSpan a => a -> SrcSpan
toSrcSpan LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
x
    UnsupportedStrategy      LDerivStrategy GhcPs
x -> GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs) -> SrcSpan
forall a. ToSrcSpan a => a -> SrcSpan
toSrcSpan LDerivStrategy GhcPs
GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)
x
    InvalidDeclaration       LHsDecl GhcPs
x -> GenLocated SrcSpanAnnA (HsDecl GhcPs) -> SrcSpan
forall a. ToSrcSpan a => a -> SrcSpan
toSrcSpan LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
x

exceptionToSDoc :: Exception -> SDoc
exceptionToSDoc :: Exception -> SDoc
exceptionToSDoc = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep ([SDoc] -> SDoc) -> (Exception -> [SDoc]) -> Exception -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    UnsupportedStockDeriving LHsType GhcPs
ty -> [
        SDoc
"Unsupported stock class: "
      , GenLocated SrcSpanAnnA (HsType GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty
      ]
    UnsupportedStrategy (L SrcAnn NoEpAnns
_ DerivStrategy GhcPs
strategy) -> [
        SDoc
"Strategy "
      , DerivStrategy GhcPs -> SDoc
forall a. DerivStrategy a -> SDoc
derivStrategyName DerivStrategy GhcPs
strategy
      , SDoc
" is not supported"
      ]
    InvalidDeclaration LHsDecl GhcPs
_decl -> [
        SDoc
"Unsupported declaration for large-records"
      ]