Create a gist now

Instantly share code, notes, and snippets.

@aspiwack /Reflection.hs Secret
Last active Dec 21, 2017

Embed
What would you like to do?
Sources for Tweag I/O's reflection tutorial blog post
-- | This is the source file for the blog post found at Tweag I/O's blog:
-- <http://www.tweag.io/posts/2017-12-21-reflection-tutorial.html>.
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
module Reflection where
import Data.Proxy
import Data.Reflection
-- * Sorted list abstraction
newtype SortedList a = Sorted [a]
forget :: SortedList a -> [a]
forget (Sorted l) = l
nil :: SortedList a
nil = Sorted []
singleton :: a -> SortedList a
singleton a = Sorted [a]
merge :: Ord a => SortedList a -> SortedList a -> SortedList a
merge (Sorted left0) (Sorted right0) = Sorted $ mergeList left0 right0
where
-- 'mergeList l1 l2' returns a sorted permutation of 'l1++l2' provided
-- that 'l1' and 'l2' are sorted.
mergeList :: Ord a => [a] -> [a] -> [a]
mergeList [] right = right
mergeList left [] = left
mergeList left@(a:l) right@(b:r) =
if a <= b then
a : (mergeList l right)
else
b : (mergeList left r)
-- * Safely sorting with type classes
fromList :: Ord a => [a] -> SortedList a
fromList [] = nil
fromList [a] = singleton a
fromList l = merge orderedLeft orderedRight
where
orderedLeft = fromList left
orderedRight = fromList right
(left,right) = splitAt (div (length l) 2) l
-- | Safely sorts, but bound by the 'Ord' instance
sort :: Ord a => [a] -> [a]
sort l = forget (fromList l)
-- * Generic sorting with reflection
newtype ReflectedOrd s a = ReflectOrd a
-- | Like `ReflectOrd` but takes a `Proxy` argument to help GHC with unification
reflectOrd :: Proxy s -> a -> ReflectedOrd s a
reflectOrd _ a = ReflectOrd a
unreflectOrd :: ReflectedOrd s a -> a
unreflectOrd (ReflectOrd a) = a
data ReifiedOrd a = ReifiedOrd {
reifiedEq :: a -> a -> Bool,
reifiedCompare :: a -> a -> Ordering }
instance Reifies s (ReifiedOrd a) => Eq (ReflectedOrd s a) where
(==) (ReflectOrd x) (ReflectOrd y) =
reifiedEq (reflect (Proxy :: Proxy s)) x y
instance Reifies s (ReifiedOrd a) => Ord (ReflectedOrd s a) where
compare (ReflectOrd x) (ReflectOrd y) =
reifiedCompare (reflect (Proxy :: Proxy s)) x y
-- | Creates a `ReifiedOrd` with a comparison function. The equality function
-- is deduced from the comparison.
fromCompare :: (a -> a -> Ordering) -> ReifiedOrd a
fromCompare ord = ReifiedOrd {
reifiedEq = \x y -> ord x y == EQ,
reifiedCompare = ord }
-- | The generic sorting function
sortBy :: (a->a->Ordering) -> [a] -> [a]
sortBy ord l =
reify (fromCompare ord) $ \ p ->
map unreflectOrd . sort . map (reflectOrd p) $ l
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment