Implement Data.Reflectable (#289)

* Implement Data.Reflectable

* Use ordering type instead of the primitive kind

* Add tests for reflection and reification

Co-authored-by: Thomas Honeyman <[email protected]>

Author: purefunctor

CHANGELOG.md

@@ -12,6 +12,7 @@ Breaking changes:
 - Fix `Show` instance on records with duplicate labels by adding `Nub` constraint (#269 by @JordanMartinez)
 
 New features:
+- Added the `Data.Reflectable` module for type reflection (#289 by @PureFunctor)
 
 Bugfixes:
 

src/Data/Reflectable.js

@@ -0,0 +1,5 @@
+// module Data.Reflectable
+
+export const unsafeCoerce = function (arg) {
+  return arg;
+};

src/Data/Reflectable.purs

@@ -0,0 +1,57 @@
+module Data.Reflectable
+  ( class Reflectable
+  , class Reifiable
+  , reflectType
+  , reifyType
+  ) where
+
+import Data.Ord (Ordering)
+import Type.Proxy (Proxy(..))
+
+-- | A type-class for reflectable types.
+-- |
+-- | Instances for the following kinds are solved by the compiler:
+-- | * Boolean
+-- | * Int
+-- | * Ordering
+-- | * Symbol
+class Reflectable :: forall k. k -> Type -> Constraint
+class Reflectable v t | v -> t where
+  -- | Reflect a type `v` to its term-level representation.
+  reflectType :: Proxy v -> t
+
+-- | A type class for reifiable types.
+-- |
+-- | Instances of this type class correspond to the `t` synthesized
+-- | by the compiler when solving the `Reflectable` type class.
+class Reifiable :: Type -> Constraint
+class Reifiable t
+
+instance Reifiable Boolean
+instance Reifiable Int
+instance Reifiable Ordering
+instance Reifiable String
+
+-- local definition for use in `reifyType`
+foreign import unsafeCoerce :: forall a b. a -> b
+
+-- | Reify a value of type `t` such that it can be consumed by a
+-- | function constrained by the `Reflectable` type class. For
+-- | example:
+-- |
+-- | ```purs
+-- | twiceFromType :: forall v. Reflectable v Int => Proxy v -> Int
+-- | twiceFromType = (_ * 2) <<< reflectType
+-- |
+-- | twiceOfTerm :: Int
+-- | twiceOfTerm = reifyType 21 twiceFromType
+-- | ```
+reifyType :: forall t r. Reifiable t => t -> (forall v. Reflectable v t => Proxy v -> r) -> r
+reifyType s f = coerce f { reflectType: \_ -> s } Proxy
+  where
+  coerce
+    :: (forall v. Reflectable v t => Proxy v -> r)
+    -> { reflectType :: Proxy _ -> t }
+    -> Proxy _
+    -> r
+  coerce = unsafeCoerce

test/Test/Main.purs

@@ -3,8 +3,12 @@ module Test.Main where
 import Prelude
 import Data.HeytingAlgebra (ff, tt, implies)
 import Data.Ord (abs, signum)
+import Data.Reflectable (reflectType, reifyType)
+import Prim.Boolean (True, False)
+import Prim.Ordering (LT, GT, EQ)
 import Test.Data.Generic.Rep (testGenericRep)
 import Test.Utils (AlmostEff, assert)
+import Type.Proxy (Proxy(..))
 
 main :: AlmostEff
 main = do
@@ -15,6 +19,8 @@ main = do
     testIntDegree
     testRecordInstances
     testGenericRep
+    testReflectType
+    testReifyType
     testSignum
 
 foreign import testNumberShow :: (Number -> String) -> AlmostEff
@@ -153,6 +159,28 @@ testRecordInstances = do
     (top :: { a :: Boolean }).a
     == top
 
+testReflectType :: AlmostEff
+testReflectType = do
+  assert "reflectType: Symbol -> String" $ reflectType (Proxy :: _ "erin!") == "erin!"
+  assert "reflectType: Boolean -> Boolean, True" $ reflectType (Proxy :: _ True) == true
+  assert "reflectType: Boolean -> Boolean, False" $ reflectType (Proxy :: _ False) == false
+  assert "reflectType: Ordering -> Ordering, LT" $ reflectType (Proxy :: _ LT) == LT
+  assert "reflectType: Ordering -> Ordering, GT" $ reflectType (Proxy :: _ GT) == GT
+  assert "reflectType: Ordering -> Ordering, EQ" $ reflectType (Proxy :: _ EQ) == EQ
+  assert "reflectType: Int -> Int, 42" $ reflectType (Proxy :: _ 42) == 42
+  assert "reflectType: Int -> Int, -42" $ reflectType (Proxy :: _ (-42)) == -42
+
+testReifyType :: AlmostEff
+testReifyType = do
+  assert "reifyType: String -> Symbol" $ reifyType "erin!" reflectType == "erin!"
+  assert "reifyType: Boolean -> Boolean, true" $ reifyType true reflectType == true
+  assert "reifyType: Boolean -> Boolean, false" $ reifyType false reflectType == false
+  assert "reifyType: Ordering -> Ordering, LT" $ reifyType LT reflectType == LT
+  assert "reifyType: Ordering -> Ordering, GT" $ reifyType GT reflectType == GT
+  assert "reifyType: Ordering -> Ordering, EQ" $ reifyType EQ reflectType == EQ
+  assert "reifyType: Int -> Int, 42" $ reifyType 42 reflectType == 42
+  assert "reifyType: Int -> Int, -42" $ reifyType (-42) reflectType == -42
+
 testSignum :: AlmostEff
 testSignum = do
   assert "Clarifies what 'signum positive zero' test is doing" $ show (1.0/0.0) == "Infinity"