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

import qualified Evoke.Hsc as Hsc
import qualified GHC.Hs as Ghc
import qualified GHC.Plugins 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
  LocatedN RdrName
lRdrName <- case forall l e. GenLocated l e -> e
Ghc.unLoc LFieldOcc GhcPs
lFieldOcc of
    Ghc.FieldOcc XCFieldOcc GhcPs
_ LocatedN RdrName
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure LocatedN RdrName
x
  OccName
occName <- case forall l e. GenLocated l e -> e
Ghc.unLoc LocatedN RdrName
lRdrName of
    Ghc.Unqual OccName
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure OccName
x
    RdrName
_ -> forall a. SrcSpan -> SDoc -> Hsc a
Hsc.throwError SrcSpan
srcSpan forall a b. (a -> b) -> a -> b
$ String -> SDoc
Ghc.text String
"unsupported RdrName"
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Field {name :: OccName
name = OccName
occName, type_ :: HsType GhcPs
type_ = forall l e. GenLocated l e -> e
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 forall l e. GenLocated l e -> e
Ghc.unLoc LHsType GhcPs
lHsType of
    Ghc.HsTyVar XTyVar GhcPs
_ PromotionFlag
_ LIdP GhcPs
lIdP -> case forall l e. GenLocated l e -> e
Ghc.unLoc LIdP GhcPs
lIdP of
      Ghc.Unqual OccName
occName -> OccName -> String
Ghc.occNameString OccName
occName forall a. Eq a => a -> a -> Bool
== String
"Maybe"
      RdrName
_ -> Bool
False
    HsType GhcPs
_ -> Bool
False
  HsType GhcPs
_ -> Bool
False