ToPursTyConPoly

ToPursTyConPoly.hs

{-# language TypeInType #-}

-- | Types which have PureScript equivalents
class ToPursTyCon a where
  toPursTyCon :: Tagged a PursTypeConstructor

  -- | The default instance uses 'G.Generic' and pattern matches on the
  -- type's representation to create a PureScript type.
  default toPursTyCon :: (G.Generic a, GenericToPursTyCon (G.Rep a)) => Tagged a PursTypeConstructor
  toPursTyCon = retag $ genericToPursTyConWith @(G.Rep a) defaultPursTypeOptions

-- | The kind-polymorphic version
class ToPursTyConPoly k (a :: k) where
  toPursTyConPoly :: Tagged (a :: k) PursTypeConstructor

-- | A "type variable"
data TyVar (nm :: Symbol)

-- | The base case: defer to ToPursTyCon (usually derived via Generic)
instance ToPursTyCon a => ToPursTyConPoly Type (a :: Type) where
  toPursTyConPoly = toPursTyCon

-- | Count the number of type arguments in a kind
type family CountArgs k :: Nat
type instance CountArgs Type = 0
type instance CountArgs (Type -> k) = 1 + CountArgs k

-- |
-- Using singletons:
-- 
-- TypeVarFor Type ~ "a0"
-- TypeVarFor (Type -> Type) ~ "a1"
--
-- etc.
type TypeVarFor k = Mappend "a" (Show_ (CountArgs k))

-- | The inductive case: instantiate the first type variable and continue at the 
-- next kind in the chain
instance 
    forall k f. 
    ( KnownSymbol (TypeVarFor k)
    , ToPursTyConPoly k (f (TyVar (TypeVarFor k)))
    ) => ToPursTyConPoly (Type -> k) (f :: Type -> k) 
  where
    toPursTyConPoly = fmap withArgs $ retag $ toPursTyConPoly @k @(f (TyVar (TypeVarFor k))) where
      withArgs x = x { tyConArgs = pack (symbolVal (Proxy @(TypeVarFor k))) : tyConArgs x }