{-# 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 -> 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"
      ]