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