Advertisement
Guest User

Untitled

a guest
May 24th, 2019
109
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.57 KB | None | 0 0
  1. {-# language TypeInType #-}
  2.  
  3. -- | Types which have PureScript equivalents
  4. class ToPursTyCon a where
  5. toPursTyCon :: Tagged a PursTypeConstructor
  6.  
  7. -- | The default instance uses 'G.Generic' and pattern matches on the
  8. -- type's representation to create a PureScript type.
  9. default toPursTyCon :: (G.Generic a, GenericToPursTyCon (G.Rep a)) => Tagged a PursTypeConstructor
  10. toPursTyCon = retag $ genericToPursTyConWith @(G.Rep a) defaultPursTypeOptions
  11.  
  12. -- | The kind-polymorphic version
  13. class ToPursTyConPoly k (a :: k) where
  14. toPursTyConPoly :: Tagged (a :: k) PursTypeConstructor
  15.  
  16. -- | A "type variable"
  17. data TyVar (nm :: Symbol)
  18.  
  19. -- | The base case: defer to ToPursTyCon (usually derived via Generic)
  20. instance ToPursTyCon a => ToPursTyConPoly Type (a :: Type) where
  21. toPursTyConPoly = toPursTyCon
  22.  
  23. -- | Count the number of type arguments in a kind
  24. type family CountArgs k :: Nat
  25. type instance CountArgs Type = 0
  26. type instance CountArgs (Type -> k) = 1 + CountArgs k
  27.  
  28. -- |
  29. -- Using singletons:
  30. --
  31. -- TypeVarFor Type ~ "a0"
  32. -- TypeVarFor (Type -> Type) ~ "a1"
  33. --
  34. -- etc.
  35. type TypeVarFor k = Mappend "a" (Show_ (CountArgs k))
  36.  
  37. -- | The inductive case: instantiate the first type variable and continue at the
  38. -- next kind in the chain
  39. instance
  40. forall k f.
  41. ( KnownSymbol (TypeVarFor k)
  42. , ToPursTyConPoly k (f (TyVar (TypeVarFor k)))
  43. ) => ToPursTyConPoly (Type -> k) (f :: Type -> k)
  44. where
  45. toPursTyConPoly = fmap withArgs $ retag $ toPursTyConPoly @k @(f (TyVar (TypeVarFor k))) where
  46. withArgs x = x { tyConArgs = pack (symbolVal (Proxy @(TypeVarFor k))) : tyConArgs x }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement