Last active
September 12, 2015 05:08
-
-
Save vertexcite/cd9fe0dab678299fe1c8 to your computer and use it in GitHub Desktop.
Monad instance of list where list is treated as a function (Nat -> Nat)
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module FunkyList where | |
import Control.Monad | |
instance Functor FunkyList where | |
fmap = liftM | |
instance Applicative FunkyList where | |
pure = return | |
(<*>) = ap | |
-- Probably want to add constraint: Num a | |
newtype FunkyList a = FunkyList {getFunkyList :: [a]} deriving (Eq, Ord, Show) | |
-- Make a function behave as a list. | |
convert :: Num b => (b -> a) -> [a] | |
convert f = f 0 : convert (f . (+1)) | |
wrap :: Num b => (b -> a) -> FunkyList a | |
wrap = FunkyList . convert | |
instance Monad FunkyList where | |
-- At least two equivalent ways of writing >>= | |
-- The first one was inspired by Monad instance of ((->) r) | |
-- which has | |
-- f >>= k = \ r -> k (f r) r | |
-- This is the first way: | |
-- (FunkyList xs) >>= k = wrap $ \ r -> k' (xs !! r) !! r | |
-- | |
-- The second one uses the Monad instance of ((->) r), as follows (found using blunt/pointfree) | |
(FunkyList xs) >>= k = wrap $ (k' . (xs !!)) >>= (!!) | |
where | |
k' = getFunkyList . k | |
return = wrap . const -- Or alternatively: return x = FunkyList $ repeat x | |
-- Testing (Should really use QuickCheck properties etc) | |
tester n (FunkyList lhs) (FunkyList rhs) = take n lhs == take n rhs | |
f n = map (*n) [1..] | |
f' :: Int -> FunkyList Int | |
f' = FunkyList . f | |
g n = map (+n) [1..] | |
g' :: Int -> FunkyList Int | |
g' = FunkyList . g | |
-- It is a monad, it seems | |
-- Passes Law 1 | |
-- Law 1: return x >>= k == k x | |
k = f' | |
x = 3 | |
lhs1 = return x >>= k | |
rhs1 = k x | |
test1 = tester 100 lhs1 rhs1 | |
-- Passes Law 2 | |
-- Law 2: m >>= return = m | |
m = FunkyList [1..] | |
lhs2 = m >>= return | |
rhs2 = m | |
test2 = tester 100 lhs2 rhs2 | |
-- Law 3: m >>= (\x -> k x >>= h) == (m >>= k) >>= h | |
lhs3 = m >>= (\x -> f' x >>= g') | |
rhs3 = (m >>= f') >>= g' | |
test3 = tester 100 lhs3 rhs3 | |
isMonad = and [test1, test2, test3] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment