module Evoke.Type.Type
  ( Type (..),
    make,
    qualifiedName,
  )
where

import qualified Control.Monad as Monad
import qualified Evoke.Hsc as Hsc
import qualified Evoke.Type.Constructor as Constructor
import qualified GHC.Hs as Ghc
import qualified GHC.Plugins as Ghc

data Type = Type
  { Type -> IdP GhcPs
name :: Ghc.IdP Ghc.GhcPs,
    Type -> [IdP GhcPs]
variables :: [Ghc.IdP Ghc.GhcPs],
    Type -> [Constructor]
constructors :: [Constructor.Constructor]
  }

make ::
  Ghc.LIdP Ghc.GhcPs ->
  Ghc.LHsQTyVars Ghc.GhcPs ->
  [Ghc.LConDecl Ghc.GhcPs] ->
  Ghc.SrcSpan ->
  Ghc.Hsc Type
make :: LIdP GhcPs
-> LHsQTyVars GhcPs -> [LConDecl GhcPs] -> SrcSpan -> Hsc Type
make LIdP GhcPs
lIdP LHsQTyVars GhcPs
lHsQTyVars [LConDecl GhcPs]
lConDecls SrcSpan
srcSpan = do
  [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
lHsTyVarBndrs <- case LHsQTyVars GhcPs
lHsQTyVars of
    Ghc.HsQTvs XHsQTvs GhcPs
_ [LHsTyVarBndr () GhcPs]
hsq_explicit -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [LHsTyVarBndr () GhcPs]
hsq_explicit
  [RdrName]
theVariables <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
Monad.forM [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
lHsTyVarBndrs forall a b. (a -> b) -> a -> b
$ \GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
lHsTyVarBndr ->
    case forall l e. GenLocated l e -> e
Ghc.unLoc GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
lHsTyVarBndr of
      Ghc.UserTyVar XUserTyVar GhcPs
_ ()
_ LIdP GhcPs
var -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
Ghc.unLoc LIdP GhcPs
var
      HsTyVarBndr () GhcPs
_ -> forall a. SrcSpan -> SDoc -> Hsc a
Hsc.throwError SrcSpan
srcSpan forall a b. (a -> b) -> a -> b
$ String -> SDoc
Ghc.text String
"unknown LHsTyVarBndr"
  [Constructor]
theConstructors <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (SrcSpan -> LConDecl GhcPs -> Hsc Constructor
Constructor.make SrcSpan
srcSpan) [LConDecl GhcPs]
lConDecls
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Type
      { name :: IdP GhcPs
name = forall l e. GenLocated l e -> e
Ghc.unLoc LIdP GhcPs
lIdP,
        variables :: [IdP GhcPs]
variables = [RdrName]
theVariables,
        constructors :: [Constructor]
constructors = [Constructor]
theConstructors
      }

qualifiedName :: Ghc.ModuleName -> Type -> String
qualifiedName :: ModuleName -> Type -> String
qualifiedName ModuleName
moduleName Type
type_ =
  forall a. Monoid a => [a] -> a
mconcat
    [ ModuleName -> String
Ghc.moduleNameString ModuleName
moduleName,
      String
".",
      OccName -> String
Ghc.occNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
Ghc.rdrNameOcc forall a b. (a -> b) -> a -> b
$ Type -> IdP GhcPs
name Type
type_
    ]