Instantly share code, notes, and snippets.

Embed
What would you like to do?
{-# LANGUAGE TupleSections #-}
module Main where
-- hide the-dot to use it from Control.Category
import Prelude hiding ((.))
import Control.Category
import Control.Monad ((<=<))
import Control.Comonad.Env
import Control.Arrow
import Data.Profunctor
-- a simple use case:
-- 1) get smallest integer from a list
-- 2) divide "some number" with this integer
-- 3) compose these functions in the spirit of functional programming
-- types are commented out just to show that the compiler really doesn't need them.
-- that is, they don't carry any necessary information, for the compiler or the reader.
-- A) The simplest case, ordinary functions.
--functionAB :: [Int] -> Int
functionAB a = minimum a
--functionBC :: Int -> Int
functionBC b = 42 `div` b
--function :: [Int] -> Int
function = functionBC . functionAB
-- B) Sometimes our values are wrapped within a context, but this is no
-- problem since we can just lift the regular function to work with
-- contextual values. As long as it's a Functor.
--liftedAB :: Maybe [Int] -> Maybe Int
liftedAB = fmap functionAB
--liftedBC :: Maybe Int -> Maybe Int
liftedBC = fmap functionBC
--lifted :: Maybe [Int] -> Maybe Int
lifted = liftedBC . liftedAB
-- C) Since the calculation can fail, we might want to encode it in the types.
-- This gives rise to a monadic version of the same use case.
--monadicAmB :: [Int] -> Maybe Int
monadicAmB [] = Nothing
monadicAmB a = Just (minimum a)
--monadicBmC :: Int -> Maybe Int
monadicBmC 0 = Nothing
monadicBmC b = Just (42 `div` b)
--monadic :: [Int] -> Maybe Int
monadic = monadicBmC <=< monadicAmB
-- In order to compose monads as a Category, they need to be wrapped to a Kleisli arrow.
-- Yes, this is somewhat silly.
--monadic2 :: Kleisli Maybe [Int] Int
monadic2 = Kleisli monadicBmC . Kleisli monadicAmB
-- D) Perhaps the dividend is really not a constant, but something to be read from an environment?
-- This gives rise to a comonadic version of the same use case.
-- Tuple2 happens to be a Comonad, so we can simply pass in the environment value as
-- the left side.
type WithEnv e = (,) e
--comonadic_mAB :: WithEnv Int [Int] -> Int
comonadic_mAB (e,[]) = e
comonadic_mAB (e,a) = minimum a
--comonadic_mBC :: WithEnv Int Int -> Int
comonadic_mBC (e,0) = e
comonadic_mBC (e,b) = e `div` b
--comonadic :: WithEnv Int [Int] -> Int
comonadic = comonadic_mBC =<= comonadic_mAB
-- In order to compose comonads as a Category, they need to be wrapped to a Cokleisli arrow.
-- Yes, this is also somewhat silly.
--comonadic2 :: Cokleisli (WithEnv Int) [Int] Int
comonadic2 = Cokleisli comonadic_mBC . Cokleisli comonadic_mAB
-- E) What about if we want to add logging to the individual parts of the calculation?
-- This could be modelled as a Writer Monad, but the simplest way would be to use an Applicative:
-- define composition for Applicatives (why is this not in hackage?)
(<.>) :: Applicative f => f (b -> c) -> f (a -> b) -> f (a -> c)
f <.> g = (.) <$> f <*> g
-- define Applicative as a Category over Cayley, or whatever. Similar to Monad/Kleisli
newtype Cayley f a b = Cayley { runCayley :: (f (a -> b)) }
instance Applicative f => Category (Cayley f) where
id = Cayley $ pure Prelude.id
Cayley g . Cayley f = Cayley $ (.) <$> g <*> f
-- Tuple2 happens to be an Applicative, so we just keep the log on its left side.
type Logged = (,) [String]
--applicativeAB :: Logged ([Int] -> Int)
applicativeAB = (["calculating minimums..."], minimum)
--applicativeBC :: Logged (Int -> Int)
applicativeBC = (["dividing by the value..."], (42 `div` ))
--applicative :: Logged ([Int] -> Int)
applicative = applicativeBC <.> applicativeAB
-- In order to compose applicatives as a Category, they need to be wrapped to a Cayley type.
-- Yes, yet again this is somewhat silly.
--applicative2 :: Cayley Logged [Int] Int
applicative2 = Cayley applicativeBC . Cayley applicativeAB
-- F) What if we need both? A contextual input and a contextual output?
--both_wAmB :: WithEnv Int [Int] -> Maybe Int
both_wAmB (e,[]) = Nothing
both_wAmB (e,a) = Just (minimum a)
--both_wBmC :: WithEnv Int Int -> Maybe Int
both_wBmC (e,0) = Nothing
both_wBmC (e,b) = Just (e `div` b)
-- Whoops, how to compose these?
--both :: WithEnv Int [Int] -> Maybe Int
both = undefined--both_wBmC . both_wAmB
-- Let's wrap out use case to its own type:
data MyFunctionType a b = MyFunctionType (WithEnv Int a -> Maybe b)
-- to provide Functor and Applicative, we need to "fix" the input type:
instance Functor (MyFunctionType a) where
fmap f (MyFunctionType g) = MyFunctionType $ fmap f . g
instance Applicative (MyFunctionType a) where
pure b = MyFunctionType $ \wa -> pure b
MyFunctionType f <*> MyFunctionType g = MyFunctionType $ \wa -> f wa <*> g wa
--cat_AB :: MyFunctionType [Int] Int
cat_AB = MyFunctionType f
where f (_,[]) = Nothing
f (_,a) = Just (minimum a)
--cat_BC :: MyFunctionType Int Int
cat_BC = MyFunctionType f
where f (_,0) = Nothing
f (e,b) = Just (e `div` b)
-- whoops, functions with different input types do not compose as Applicatives.
cat :: MyFunctionType [Int] Int
--cat = ar_BC <.> ar_AB
-- But we can make it a Category:
instance Category MyFunctionType where
id = MyFunctionType $ Just . snd
MyFunctionType g . MyFunctionType f = MyFunctionType $
\(e,a) -> case f (e,a) of
Nothing -> Nothing
Just b -> g (e,b)
-- now we got composition
cat = cat_BC . cat_AB
-- if additionally we make out type a Profunctor, that is,
-- a two-argument thing where the first argument can be considered
-- as "input" (contravariant) and second argument as "output" (covariant):
instance Profunctor MyFunctionType where
rmap f (MyFunctionType ff) = MyFunctionType $ fmap f . ff
lmap f (MyFunctionType ff) = MyFunctionType $ ff . fmap f
-- and provide "Strength", that is, capability to "drop in" values to "pass through":
instance Strong MyFunctionType where
first' f = MyFunctionType $ \p@(_,a) -> let (MyFunctionType h) = dimap fst (,snd a) f in h p
-- what can we do with these?
-- Surprisingly, these simple additions give as ability to build
-- various kinds of _component networks_!
-- e.g. "stream transformers", "simple automata", "FRP", "Music signals", ...
-- if additionally we state that our type can "choose its output type based on its input":
instance Choice MyFunctionType where
left' = dimap (\(Left a) -> a) Left
-- ...and that it can "drop out" values from input and output:
instance Costrong MyFunctionType where
unfirst = dimap (,undefined) fst
-- ...we get the power of branching and feedback!
-- These are Arrow/ArrowChoice/ArrowLoop:
instance Arrow MyFunctionType where
arr = MyFunctionType . dimap snd Just
first = first'
instance ArrowChoice MyFunctionType where
left = left'
instance ArrowLoop MyFunctionType where
loop = unfirst
-- Now we can build our networks with a common, well understood, abstraction.
arrow :: MyFunctionType [Int] Int
arrow = cat_BC <<< cat_AB
main = do
print $ function [42]
print $ lifted (Just [42])
print $ applicative <*> ([], [42])
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment