Instantly share code, notes, and snippets.

# aspiwack/Reflection.hsSecret Last active Dec 21, 2017

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: -- . {-# 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
to join this conversation on GitHub. Already have an account? Sign in to comment