diff --git a/CHANGELOG.md b/CHANGELOG.md index a70bb2de..e87c7859 100644 --- a/CHANGELOG.md +++ b/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: diff --git a/src/Data/Reflectable.js b/src/Data/Reflectable.js new file mode 100644 index 00000000..822a20cb --- /dev/null +++ b/src/Data/Reflectable.js @@ -0,0 +1,5 @@ +// module Data.Reflectable + +export const unsafeCoerce = function (arg) { + return arg; +}; diff --git a/src/Data/Reflectable.purs b/src/Data/Reflectable.purs new file mode 100644 index 00000000..fafe5278 --- /dev/null +++ b/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 diff --git a/test/Test/Main.purs b/test/Test/Main.purs index 3ab98a44..2f819151 100644 --- a/test/Test/Main.purs +++ b/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"