module Evoke.Type.Field
  ( Field(..)
  , make
  , isOptional
  ) where

import qualified Evoke.Hsc as Hsc
import qualified GHC.Hs as Ghc
import qualified GhcPlugins as Ghc

data Field = Field
  { Field -> OccName
name :: Ghc.OccName
  , Field -> HsType GhcPs
type_ :: Ghc.HsType Ghc.GhcPs
  }

make
  :: Ghc.SrcSpan
  -> Ghc.LHsType Ghc.GhcPs
  -> Ghc.LFieldOcc Ghc.GhcPs
  -> Ghc.Hsc Field
make :: SrcSpan -> LHsType GhcPs -> LFieldOcc GhcPs -> Hsc Field
make SrcSpan
srcSpan LHsType GhcPs
lHsType LFieldOcc GhcPs
lFieldOcc = do
  Located RdrName
lRdrName <- case LFieldOcc GhcPs -> SrcSpanLess (LFieldOcc GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
Ghc.unLoc LFieldOcc GhcPs
lFieldOcc of
    Ghc.FieldOcc _ x -> Located RdrName -> Hsc (Located RdrName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Located RdrName
x
    SrcSpanLess (LFieldOcc GhcPs)
_ -> SrcSpan -> MsgDoc -> Hsc (Located RdrName)
forall a. SrcSpan -> MsgDoc -> Hsc a
Hsc.throwError SrcSpan
srcSpan (MsgDoc -> Hsc (Located RdrName))
-> MsgDoc -> Hsc (Located RdrName)
forall a b. (a -> b) -> a -> b
$ String -> MsgDoc
Ghc.text String
"unsupported LFieldOcc"
  OccName
occName <- case Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
Ghc.unLoc Located RdrName
lRdrName of
    Ghc.Unqual x -> OccName -> Hsc OccName
forall (f :: * -> *) a. Applicative f => a -> f a
pure OccName
x
    SrcSpanLess (Located RdrName)
_ -> SrcSpan -> MsgDoc -> Hsc OccName
forall a. SrcSpan -> MsgDoc -> Hsc a
Hsc.throwError SrcSpan
srcSpan (MsgDoc -> Hsc OccName) -> MsgDoc -> Hsc OccName
forall a b. (a -> b) -> a -> b
$ String -> MsgDoc
Ghc.text String
"unsupported RdrName"
  Field -> Hsc Field
forall (f :: * -> *) a. Applicative f => a -> f a
pure Field :: OccName -> HsType GhcPs -> Field
Field { name :: OccName
name = OccName
occName, type_ :: HsType GhcPs
type_ = LHsType GhcPs -> SrcSpanLess (LHsType GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
Ghc.unLoc LHsType GhcPs
lHsType }

isOptional :: Field -> Bool
isOptional :: Field -> Bool
isOptional Field
field = case Field -> HsType GhcPs
type_ Field
field of
  Ghc.HsAppTy XAppTy GhcPs
_ LHsType GhcPs
lHsType LHsType GhcPs
_ -> case LHsType GhcPs -> SrcSpanLess (LHsType GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
Ghc.unLoc LHsType GhcPs
lHsType of
    Ghc.HsTyVar _ _ lIdP -> case Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
Ghc.unLoc Located (IdP GhcPs)
Located RdrName
lIdP of
      Ghc.Unqual occName -> OccName -> String
Ghc.occNameString OccName
occName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Maybe"
      SrcSpanLess (Located RdrName)
_ -> Bool
False
    SrcSpanLess (LHsType GhcPs)
_ -> Bool
False
  HsType GhcPs
_ -> Bool
False