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

-- | 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 (L SrcSpan
l HsType GhcPs
_) -> SrcSpan
l
    UnsupportedStrategy      (L SrcSpan
l DerivStrategy GhcPs
_) -> SrcSpan
l
    InvalidDeclaration       (L SrcSpan
l HsDecl GhcPs
_) -> SrcSpan
l

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