Notes for a Hacker School talk on functors, applicatives, etc.

Family.hs

{-# LANGUAGE DeriveFunctor #-}

module Family where

import Control.Applicative
import Data.Monoid

-- Functors
-- 
-- Lift a function (a -> b) to (f a -> f b)
--
-- (a -> b) -> ([] a -> [] b)
-- (a -> b) -> (Maybe a -> Maybe b)
-- (a -> b) -> (Either x a -> Either x b)
-- (a -> b) -> (IO a -> IO b)
-- (a -> b) -> (Parser a -> Parser b)
-- (a -> b) -> (Random a -> Random b)
--
-- Weirder...
-- (a -> b) -> ((e -> a) -> (e -> b))
--
-- might look more familiar like this...
-- (a -> b) -> (e -> a) -> e -> b
--
-- instance Functor ((->) e) where
--     fmap f a = f . a
--
-- Composition!
-- IO [a] = IO ([] a)
--
-- IO is a functor, and so is []. Is their composition a functor too?
--
-- fmap (fmap toUpper) getLine

newtype Compose f g a = Compose { getCompose :: (f (g a)) }

instance (Functor f, Functor g) => Functor (Compose f g) where
    fmap f (Compose x) = Compose $ fmap (fmap f) x

-- Wait a minute. What isn't a functor?
--
-- One nice example: (a -> a)
--
-- Given an (a -> a) and an (a -> b), can you get a (b -> b)? Nope! There's
-- just no where to put a b input.
--

-- Applicatives
--
-- Functors let you lift an (a -> b) to an (f a -> f b).
--
-- Applicatives extend this idea to arbitrary arities.
--
-- a -> f a
-- (a -> b) -> (f a -> f b), just like fmap
-- (a -> b -> c) -> (f a -> f b -> f c)
-- etc.
--
-- Recall that with a functor, you can take an f a, tweak it with (a -> b), and
-- get an f b.  But unfortunately no way to combine multiple functory values,
-- at least not with just the abstract functor interface. (Specific examples of
-- functors may of course come with means of combination.)
--
-- Applicatives let you combine multiple functory values with a pure function.
--
-- liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c
--

data User = User
    { userName :: String
    , userId   :: Int
    } deriving Show

-- randomUser :: Random User
-- randomUser = liftA2 User randomString randomInt
--
-- userParser :: Parser User
-- userParser = liftA2 User parseString parseInt
--
-- userFromTheOutsideWorld :: IO User
-- userFromTheOutsideWorld = liftA2 User getLine readLine
--
-- lotsOfUsers :: [] User
-- lotsOfUsers = liftA2 User someNames someNumbers
--
-- almostAUser :: (String, Int) -> User
-- almostAUser = liftA2 User fst snd

-- Composition!
--
-- Suppose we have a [IO String] and a [IO Int]
--
-- Can we get a [IO User]?
-- What about an IO [User]?
--
-- What if we have an IO [String] and an IO [Int]?
--
-- We've seen how you can squint and think of an IO a as "more or less" an a,
-- and how you can squint and think of an [a] as "more or less" an "a" (in a
-- "many worlds" kind of way).
--
-- So presumably you ought to be able to "squint twice":
--
-- ??? :: IO [String] -> IO [Int] -> IO [User]
--

instance (Applicative f, Applicative g) => Applicative (Compose f g) where
    pure = Compose . pure . pure
    (Compose f) <*> (Compose x) = Compose $ liftA2 (<*>) f x

class MultiFunctor f where
    liftZero :: a -> f a
    liftTwo  :: (a -> b -> c) -> f a -> f b -> f c -- aka liftA2
    -- pure = liftZero
    -- f <*> x = liftTwo ($) f x

instance (MultiFunctor f, MultiFunctor g) => MultiFunctor (Compose f g) where
    liftZero = Compose . liftZero . liftZero
    liftTwo f (Compose a) (Compose b) = Compose $ liftTwo (liftTwo f) a b

-- Interestingly, we only need liftZero and liftTwo to lift all the other
-- arities. E.g. here's lifting three things.
liftThree :: MultiFunctor f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftThree f fa fb fc = liftTwo (\a (b, c) -> f a b c) fa (liftTwo (,) fb fc)

-- Wait a minute. When is a functor *not* an applicative too?
--
-- One nice example: tagged values (aka tuples)
--
-- Think of a value of type (t, a) as an a tagged with a t.
--
-- instance Functor ((,) t) where
--     fmap f (t, a) = (t, f a)
--
-- In order for tagged values to be applicatives, you'd need to be able to
-- combine them somehow. If you have a (t, a) and a (t, b) lying around, and a
-- function (a -> b -> c), you could use the function to transform the a and
-- the b into a c, but what do you do with their tags? And even if you could
-- figure out how to combine them, what would liftZero :: a -> (t, a) do? Which
-- tag would it pick?
--
-- If the tags are monoids though...

instance Monoid t => MultiFunctor ((,) t) where
    liftZero a = (mempty, a)
    liftTwo f (t, a) (t', b) = (t <> t', f a b)

-- instance Monoid t => Applicative ((,) t) where
--     pure a = (mempty, a)
--     (t, f) <*> (t', x) = (t <> t', f x)

-- Here's a related (although admittedly weird-looking) idea about linking
-- monoids and applicatives.

newtype Constant x a = Constant { getConstant :: x } -- c.f. Const

-- A Constant x a is a weird value that doesn't contain anything a-related at
-- all. It's the "trivial" functor.
instance Functor (Constant x) where
    fmap f (Constant x) = Constant x

-- By itself, Constant x isn't an applicative, because pure would have to pick
-- an x. If the x parameter is a monoid though...
instance Monoid x => Applicative (Constant x) where
    pure _ = Constant mempty
    (Constant x) <*> (Constant x') = Constant (x <> x')

-- Attach pure values to a functor.
data Lift f a = Pure a | Other (f a)

instance Functor f => Functor (Lift f) where
    fmap f (Pure a) = Pure (f a)
    fmap f (Other a) = Other (fmap f a)

instance Applicative f => Applicative (Lift f) where
    pure = Pure
    (Pure f) <*> (Pure x) = Pure (f x)
    (Pure f) <*> (Other x) = Other (fmap f x)
    (Other f) <*> (Pure x) = Other (fmap ($ x) f)
    (Other f) <*> (Other x) = Other (f <*> x)

-- We can use the Constant applicative to accumulate a monoid representing
-- errors (say, [String]). We basically add pure (aka successful) values to an
-- applicative that accumulates the errors.
type Errors e a = Lift (Constant e) a

getErrors :: Errors e a -> Either e a
getErrors (Pure a) = Right a
getErrors (Other (Constant e)) = Left e

-- We've just shown that every monoid gives us a trivial applicative. The
-- reverse works too! You just lift the monoid stuff into the applicative.

-- instance (Applicative f, Monoid m) => Monoid (f m) where
--     mempty = pure mempty
--     mappend = liftA2 mappend

-- In addition to lifting monoids, applicatives also lift numbers!
--
-- {-# FlexibleInstances #-}
-- instance (Applicative f, Num a) => Num (f a) where
--     (+) = liftA2 (+)
--     (*) = liftA2 (*)
--     (-) = liftA2 (-)
--     abs = fmap abs
--     fromInteger i = pure (fromInteger i)

-- Not sure if this is a good idea or not, but it works :)
instance Num a => Num (IO a) where
    (+) = liftA2 (+)
    (*) = liftA2 (*)
    (-) = liftA2 (-)
    abs = fmap abs
    signum = fmap signum
    fromInteger = pure . fromInteger

intFromTheOutsideWorld :: IO Int
intFromTheOutsideWorld = 1 + readLn