Skip to content

Instantly share code, notes, and snippets.

@paf31
Last active April 8, 2020 07:08
Show Gist options
  • Save paf31/3f22dbdae7050bff6100b5ec84547117 to your computer and use it in GitHub Desktop.
Save paf31/3f22dbdae7050bff6100b5ec84547117 to your computer and use it in GitHub Desktop.
ToPursTyConPoly
{-# 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 }
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment