Lecture 13 =>> extract

Lecture plan

  • Comonad: the concept, the typeclass, & the laws
  • The List zipper
  • Algebra of ADTs
    • Type isomorphism
    • Type differentiation
    • The general notion of a Zipper
  • The three horsemen of comonads: Env, Traced, Store
  • Some more comonads

"Co" means "Dual"!

Typeclass Functions
Monad
Comonad 
return :: a -> t a
join   :: t (t a) -> t a
extract   :: t a -> a
duplicate :: t a -> t (t a)

But what about (>>=)?

(Co)Kleisli arrow

An arrow of the form (a -> t b) is called a Kleisli arrow.

Remember duality? Let's invert the arrow!

An arrow of the form (t a -> b) is called a Cokleisli arrow.

An operation dual to (>>=) 

bind   :: (a -> t b) -> (t a -> t b)
--           └┴── a Kleisli arrow
extend :: (t a -> b) -> (t a -> t b)
--             └┴── a Cokleisli arrow
Typeclass Extension operator
Monad
Comonad

Together, extract, duplicate, and extend form

the Comonad typeclass!

Comonad type class

class Functor w => Comonad w where
    extract   :: w a -> a
    duplicate :: w a -> w (w a)           -- extend id x
    extend    :: (w a -> b) -> w a -> w b -- fmap f <$> duplicate x

-- "extend" in operator form, with its arguments flipped
(=>>) :: Comonad w => w a -> (w a -> b) -> w b
(=>>) = flip extend
data Identity a = Identity { runIdentity :: a }

instance Comonad Identity where
    extract   = runIdentity
    duplicate = Identity

A trivial comonad

Are Maybe and [] well-defined comonads?

Hackage: comonad

Comonad laws

-- | The Cokleisli composition
(=<=) :: Comonad w => (w b -> c) -> (w a -> b) -> (w a -> c)
g =<= f = \x -> g (x =>> f) -- g . extend f, or g . fmap f . duplicate
Law In terms of (=<=) In terms of (=>>)
Associativity
Identity 
(h =<= g) =<= f ≡ 
h =<= (g =<= f)
extract =<= f ≡ f
f =<= extract ≡ f
w =>> f =>> g ≡ 
w =>> (\x -> g (x =>> f))
extract (x =>> f) ≡ f x
w =>> extract ≡ w

What's the difference?

Comonadic values are typically consumed in context-sensitive computations

Monadic values are typically produced in effectful computations

 a -> m b
 w a -> b

The List Zipper

The List zipper

data [a] = [] | a : [a]
data ListZipper a = LZ [a] a [a]
--                     │││ │ └┴┴── the values to the right of the focused element
--                     │││ └── the focused element
--                     └┴┴── the values to the left of the focused element
exampleAbove :: ListZipper Int
exampleAbove = LZ [-1, -2, -3] 0 [1, 2, 3]
lWrite :: a -> ListZipper a -> ListZipper a
lWrite x (LZ ls _ rs) = LZ ls x rs

toList :: ListZipper a -> Int -> [a]
toList (LZ ls x rs) n = reverse (take n ls) ++ [x] ++ take n rs

We can emulate the Turing machine with this datatype.

Shifting the focus

lLeft, lRight :: ListZipper a -> ListZipper a

lLeft  (LZ (l : ls) c rs) = LZ ls l (c : rs)
lLeft  lz = lz

lRight (LZ ls c (r : rs)) = LZ (c : ls) r rs
lRight lz = lz

A visual representation of moving one step left.

The List zipper is a comonad!

instance Functor ListZipper where
    fmap f (LZ ls x rs) = LZ (map f ls) (f x) (map f rs)
extract :: ListZipper a -> a
extract (LZ _ x _) = x
duplicate :: ListZipper a -> ListZipper (ListZipper a)
duplicate = ???

Well, this is gonna be a bit mind blowing

What we want to get

A plausible implementation

iterate :: (a -> a) -> a -> [a] -- from Prelude: apply the function infinitely
tail :: [a] -> [a]

iterateTail :: (a -> a) -> a -> [a]
iterateTail f = tail . iterate f -- "tail" will never return a bottom
lGenerator :: (a -> a)     -- ^ The left generator
           -> (a -> a)     -- ^ The right generator
           -> a            -- ^ The focus
           -> ListZipper a -- ^ The resulting list zipper
lGenerator f g x = LZ (iterateTail f x) x (iterateTail g x)
duplicate :: ListZipper a -> ListZipper (ListZipper a)
duplicate = lGenerator lLeft lRight
ghci> take 5 $ iterateTail (*2) 1
[2, 4, 8, 16, 32]

A zipper of zippers

newtype Grid a = Grid { unGrid :: ListZipper (ListZipper a) }  -- a 2D grid
gUp, gDown :: Grid a -> Grid a
gUp   (Grid g) = Grid (lLeft  g)
gDown (Grid g) = Grid (lRight g)  
gLeft, gRight :: Grid a -> Grid a
gLeft  (Grid g) = Grid (fmap lLeft  g)
gRight (Grid g) = Grid (fmap lRight g)

gWrite :: a -> Grid a -> Grid a
gWrite x (Grid g) = Grid $ lWrite newLine g
  where
    oldLine = extract g
    newLine = lWrite x oldLine

What is this, a two-dimensional Turing machine?

Grid is a comonad!

gHorizontal, gVertical :: Grid a -> ListZipper (Grid a)
gHorizontal = lGenerator left right
gVertical   = lGenerator up   down
instance Comonad Grid where
    extract :: Grid a -> a
    extract = extract . extract . unGrid

    duplicate :: Grid a -> Grid (Grid a)
    duplicate = Grid . fmap gHorizontal . gVertical

No four-dimensional illustrations will be provided.

How unfortunate.

Game of Life

neighbors :: [Grid a -> Grid a]
neighbors = horizontals ++ verticals ++ liftM2 (.) horizontals verticals
  where horizontals = [left, right]
        verticals   = [up, down]
aliveCount :: [Bool] -> Int
aliveCount = length . filter id
rule :: Grid Bool -> Bool
rule g = case aliveNeighbours g of
     2 -> extract g
     3 -> True
     _ -> False

evolve :: Grid Bool -> Grid Bool
evolve = extend rule

True means "alive", False means "dead"

aliveNeighbors :: Grid Bool -> Int
aliveNeighbors g = aliveCount 
                 $ map (\direction -> extract $ direction g) neighbors

Wildfire "simulation" with costate comonads representing cellular automata

It's a very popular opinion that comonads are used only for programming cellular automata.

Image processing I

data IArray i a = IA (Array i a) i  -- an array with a given reference index
instance Ix i => Functor (IArray i) where
  fmap f (IA a i) = IA (fmap f a) i
instance Ix i => Comonad (IArray i) where
    extract :: IArray i a -> a
    extract  (IA a i) = a ! i

    extend :: (IArray i a -> b) -> IArray i a -> IArray i b
    extend f (IA a i) = 
        let es' :: [(i, b)] = map (\j -> (j, f (IA a j))) (indices a)
        in IA (array (bounds a) es') i

Image processing II

-- | Retrieve the element at position (i + d) if within the bounds, else 0
(?) :: (Ix i, Num a, Num i) => IArray i a -> i -> a
IA a i ? d = if inRange (bounds a) (i + d) then a ! (i + d) else 0
laplacian2D :: IArray (Int, Int) Float -> Float  -- calculates the Laplacian
laplacian2D a = a ? ( 1,  0)
              + a ? ( 0,  1)
              + a ? (-1,  0)
              + a ? ( 0, -1)
              - 4 * a ? (0, 0)
ghci> extend laplace2D identityArray  -- like a 2D identity matrix
IA (array ((0, 0), (1, 1)) 
          [ ((0, 0), -4.0)
          , ((0, 1),  2.0)
          , ((1, 0),  2.0)
          , ((1, 1), -4.0) 
          ]
   ) (0, 0)

More on zippers

-- | A 2D zipper representing a grid of values with a focus.
newtype Grid a = Grid { unGrid :: ListZipper (ListZipper a) }
  deriving (Eq, Foldable, Functor, Traversable)

-- | A motion within a grid that may fail, for example if it goes out of bounds.
type Move a = Grid a -> Maybe (Grid a)

newtype Parser c a = Parser
    { runParser :: Move c 
                -> Maybe (Grid c) 
                -> Either ParseError (a, Maybe (Grid c)) 
    }

Grid data type can be used to build a 2D-parser-combinator library

And then we can parse something like this:

[ "           ╔════╗"
, "    ┌───┐  ║    ║"
, "    │   │  ╚════╝"
, "    └───┘        "
]
[ Box (Point 0 11) (Size 4 1)
, Box (Point 1 4)  (Size 3 1)
]

to retrieve data like this:

Algebra of ADTs

Types' algebraic representations

data Void

In Haskell we have sum types and product types.

So why not have type differentiation? (more on that later)

Haskell

Math. representation

1
data Bool = False | True
Bool ≡ 1 + 1 ≡ 2
data BoolPair = BP Bool Bool
BoolPair ≡ 2 * 2 ≡ 4
data Pair a = Pair a a
Pair(a) ≡ a * a
data Maybe a = Nothing | Just a
Maybe(a) ≡ 1 + a
data Either a b = Left a | Right b
Either(a, b) ≡ a + b
data Unit = Unit
0
data List a = Nil | Cons a (List a)
List(a) ≡ 1 + a * List(a)
data MaybeT m a = MaybeT (m (Maybe a))
MaybeT(m, a) ≡ m(Maybe(a)) ≡ m(1 + a)
foo :: Bool -> Unit
foo ≡ Unit^Bool ≡ 1^2 ≡ 1

Type isomorphism

-- 2 * 2 = 2 + 2 = 4
data BoolPair = BoolPair Bool Bool ⋍ Either Bool Bool

A mathematical representation of a type roughly* tells you how many values of this type you can construct.

Examples

-- e + 1
Either e () ⋍ Maybe e
[()] ⋍ data Nat = Zero | Succ Nat

In other words, its cardinality. Therefore:

* Roughly (i.e. informally), because the types may have an infinite number of possible values. Just like in set theory, the cardinality is roughly the number of elements in a set.

Two types are isomorphic iff there exists a bijection between them.

Poking holes in datatypes (1/3)

Datatype Inserting
holes at "a"		 Removing holes Result


 



 


 		 
data D a = D a a
D(a) \equiv a^2
D _ a
D a _
D1 a
D2 a
data D' a = D1 a 
          | D2 a
D'(a) \equiv 2a
data T a = D a a a
T(a) \equiv a^3
T _ a a
T a _ a
T a a _
T1 a a
T2 a a
T3 a a
data T' a = T1 a a
          | T2 a a
          | T3 a a
T'(a) \equiv 3a^2
data P a b = P a b
P(a, b) \equiv ab
P _ b
P1 b
data P' a b = P1 b
P'_a(a, b) \equiv b

Looks suspiciously like taking a derivative. Let's continue.

We poke holes one hole at a time.

Poking holes in datatypes (2/3)

Datatype Inserting
holes at "a"		 Removing holes Result


 



 


 		 
data C2 a = L a 
          | R a
C_2(a) \equiv 2a
L _
R _
L1
R1
data C2 a = L1 | R1
C_2'(a) \equiv 2
data C3 a = L a
          | C a
          | R a
C_3(a) \equiv 3a
L _
C _
R _
L1
C1
R1
data C3' a = L1
           | C1
           | R1
C_3'(a) \equiv 3
data E a b = L a 
           | R b
E(a, b) \equiv a + b
L _
L1
data E' a b = L1
E'_a(a, b) \equiv 1

For sum types, we poke holes in every constructor.

Again, one hole at a time.

Poking holes in datatypes (3/3)

Datatype Inserting
holes at "a"		 Removing holes Result


 






 		 
data O = LT 
       | EQ 
       | GT
O \equiv 3
-- *tumbleweed*
-- *ULTRATUMBLEWEED*
data O'
O' \equiv 0
data F a b
  = F (E a b) 
      (E a b)
\begin{align*} & F(a, b) \\ & \equiv(a + b)^2 \\ & \equiv a^2 + 2ab + b^2 \end{align*}
F (L _) (L a)
F (L a) (L _)
F (L _) (R b)
F (R b) (L _)
F1 a
F2 a
F3 b
F4 b
data F' a b
  = F1 a | F2 a 
  | F3 b | F4 b
\begin{align*} & F'_a(a, b) \\ & \equiv 2(a + b) \\ & \equiv 2a + 2b \end{align*}

HOLY TYPES :0

Derivative and zipper

A derivative of a type is the sum of terms corresponding to each one-hole context for a type parameter in question.

The resulting type describes the information about the location in the original type (data structure).

Unfortunately, due to the nature of the algorithm of taking the derivative of a type, the focused element has been lost. Let's retrieve it!

A zipper is a product type of the derivative of a given type and the type of the focused element.

\bm{Z_T(a) \coloneqq a \cdot T'_a(\dots, a, \dots)}

A quick example

data Pair a = Pair a a
P(a) \equiv a^2
data PairZipper a = Fst { this  :: a, other :: a }
                  | Snd { other :: a, this  :: a }
\begin{align*} Z_P(a) & \equiv a \cdot 2a \equiv 2a^2 \equiv a^2 + a^2 \\ & \equiv P(a) + P(a) \end{align*}

The List zipper returns!

data List a = Nil | Cons a (List a)
L(a) \equiv 1 + a \cdot L(a) \Rightarrow L(a) \equiv \frac{1}{1 - a}
data ListZipper a = LZ [a] a [a]
\begin{align*} Z_L(a) & \equiv a \cdot \left( \frac{1}{1 - a}\right)' \equiv a \cdot \left( \frac{1}{1 - a}\right)^2 \\ & \equiv L(a) \cdot a \cdot L(a) \end{align*}

The Tree zipper

data Tree a = Leaf | Node (Tree a) a (Tree a)
T(a) \equiv 1 + a \cdot T(a)^2
data ListEntry  a = LE Bool a (Tree a)
data TreeZipper a = TZ (Tree a) a (Tree a) [ListEntry a]
\begin{align*}& T'(a) \equiv T(a)^2 + 2a \cdot T(a) \cdot T'(a) \Rightarrow \\ & T'(a) \equiv \frac{T(a)^2}{1 - 2a \cdot T(a)} \equiv T(a)^2 \cdot L(2a \cdot T(a)) \end{align*}
Z_T(a) \equiv T(a) \cdot a \cdot T(a) \cdot L(2a \cdot T(a))

What on Earth is this and how to interpret it?!

Breadcrumbs

data Tree a = Leaf | Node (Tree a) a (Tree a)
goRight, goLeft, goUp :: TreeZipper a -> TreeZipper a
goRight (TZ left x (Node l y r) bs) = TZ l y r (LeftBranch left x : bs)
-- isomorphic to `data ListEntry  a = LE Bool a (Tree a)`
data Up a = LeftBranch  (Tree a) a
          | RightBranch a (Tree a)
data TreeZipper a = TZ (Tree a) a (Tree a) [Up a]

The Three Horsemen of Comonads

OOP patterns meet comonads

We can emulate a number of OOP patterns

1. Value with context

2. Builder pattern

3. Command pattern

Env

Environment with initial value

type Pos1D = (Int, Int)  -- starting position & current position

start :: Int -> Pos1D
start n = (n, n)
left, right :: Int -> Pos1D -> Int
left  n (_, x) = x - n
right n (_, x) = x + n
ghci> right 5 $ start 4
9
ghci> left 7 $ right 5 $ start 4  -- type Error !!!
left, right :: Int -> Pos1D -> Pos1D
left  n (z, x) = (z, x - n)
right n (z, x) = (z, x + n)
ghci> snd $ left 7 $ right 5 $ start 4
2
extract (_, x) = x  -- snd
refresh (z, _) = (z, z)
ghci> extract $ left 1 $ refresh $ left 7 $ right 5 $ start 4
3

Environment with initial value

left :: Int -> Pos1D -> Pos1D
left n (z, x) = (z - n, x - n)  -- oops! mistakes were made and tears were shed
accessor        :: Pos1D -> Int
extend accessor :: Pos1D -> Pos1D

Our solution is okay, but we can certainly do better. Since we return the initial value each time, we can accidentally break everything.

Also, this boilerplate code with the "z" parameter doesn't look good.

extend :: ((e, a) -> b) -> (e, a) -> (e, b)
extend = ??
extend f w = (fst w, f w)
ghci> extract (start 0 =>> right 3 =>> left 7)
-4
ghci> extract (start 0 =>> right 3 =>> left 7 =>> fst =>> right 5)
5

Env Comonad

data Env e a = Env e a  -- "e" is the environment, "a" is the value
instance Comonad (Env e) where
    extract :: Env e a -> a
    extract (Env _ a) = a

    extend :: (Env e a -> b) -> Env e a -> Env e b
    extend f env@(Env e _) = Env e (f env)

Coreader comonad

toStart :: Pos1D -> Int
toStart (z, x) = if abs (z - x) >= 10 then z else x

safeRight :: Int -> Pos1D -> Int
safeRight n p = extract $ p =>> right n =>> toStart
ghci> start 0 =>> safeRight 4
(0,4)
ghci> start 0 =>> safeRight 4 =>> safeRight 5
(0,9)
ghci> start 0 =>> safeRight 4 =>> safeRight 5 =>> safeRight 2
(0,0)
ghci> start 0 =>> safeRight 4 =>> safeRight 5 =>> safeRight 2 =>> safeRight 3
(0,3)

Traced

Builder pattern (1/3)

type Option = String
data Config = MakeConfig [Option] deriving (Show)

configBuilder :: [Option] -> Config
configBuilder = MakeConfig
defaultConfig :: [Option] -> Config
defaultConfig options = MakeConfig (["-Wall"] ++ options)
profile :: ConfigBuilder -> Config
profile builder = builder ["-prof", "-auto-all"]
someBuilder :: [Option] -> Config
type ConfigBuilder = [Option] -> Config
ghci> profile defaultConfig
MakeConfig ["-Wall","-prof","-auto-all"]
goFaster :: ConfigBuilder -> Config
goFaster builder = builder ["-O2"]

How to use goFaster and profile simultaneously?

Builder pattern (2/3)

builder = new DefaultConfig();  // Begin from default config file
builder.profile();              // Add profiling
builder.goFaster();             // Add optimization
config = builder.extract();     // Extract final config file

Somewhere in the imperative world

Back to Haskell (initial attempt)

profile'  :: ConfigBuilder -> ConfigBuilder
profile' builder = \options -> builder (["-prof", "-auto-all"] ++ options)
goFaster' :: ConfigBuilder -> ConfigBuilder
goFaster' builder = \options -> builder (["-O2"] ++ options)
extract :: ConfigBuilder -> Config
extract builder = builder []
ghci> let builder1 = defaultConfig & profile'
ghci> let builder2 = builder1      & goFaster'
ghci> extract builder2
MakeConfig ["-Wall","-prof","-auto-all","-O2"]

Why -O2 is last element of list?

Builder pattern (3/3)

someBuilder        :: ConfigBuilder -> Config
extend someBuilder :: ConfigBuilder -> ConfigBuilder

Once again, we can do better! We can eliminate the boilerplate code and make these functions composable.

extend :: ???
extend :: (ConfigBuilder -> Config)
       ->  ConfigBulder  -> ConfigBuilder
extend :: (([Option] -> Config) ->              Config)
       ->  ([Option] -> Config) -> ([Option] -> Config)
extend = ???
extend setter builder = \opts1 -> setter (\opts2 -> builder (opts1 ++ opts2))

We have extend and extract: let's use Comonad!

ghci> extract (defaultConfig =>> goFaster =>> profile)
MakeConfig ["-Wall","-prof","-auto-all","-O2"]
goFaster builder = builder ["-O2"]

extend goFaster builder
= \opts2 -> goFaster (\opts1 -> builder (opts1 ++ opts2))
= \opts2 -> builder (["-O2"] ++ opts2)
= goFaster' builder

Traced Comonad

newtype Traced m a = Traced { runTraced :: m -> a }

Cowriter comonad

instance Monoid m => Comonad (Traced m) where
    extract :: Traced m a -> a
    extract = ??

    extend :: (Traced m a -> b) -> Traced m a -> Traced m b
    extend  = ??
instance Monoid m => Comonad (Traced m) where
    extract :: Traced m a -> a
    extract  (Traced ma) = ma mempty

    extend :: (Traced m a -> b) -> Traced m a -> Traced m b
    extend f (Traced ma) = Traced $ \m -> f (Traced $ \m' -> ma (m <> m'))
type ConfigBuilder = Traced [Option] Config

profile :: ConfigBuilder -> Config
profile builder = runTraced builder ["-prof", "-auto-all"]

goFaster :: ConfigBuilder -> Config
goFaster builder = runTraced builder ["-O2"]
ghci> extract (Traced defaultConfig =>> goFaster =>> profile)
MakeConfig ["-Wall","-prof","-auto-all","-O2"]

The Traced m comonad gives a nice model for incremental games, in which the state increases in some monoid (like a click count).

codo-notation

method
    wa> expr1
    wb> expr2
    wc> expr3

It would be nice to have codo-notation for comonads. But it doesn't exist for now :(

Proposed model by Gabriella Gonzalez:

\wa ->
  let wb =     extend (\this -> expr1) wa
      wc =     extend (\this -> expr2) wb
  in extract $ extend (\this -> expr3) wc
-- the last line is the same as (\this -> expr3) wc

Expression

Desugars into

Coread list

Hackage: Control.Comonad

Zippers, cellular automatos and Game of Life

HaskellWiki: Zippers

HaskellForAll: You could have invented comonads

David Overton: Comonads in Haskell

Functorial Blog: Comonads as Spaces

jtobin.io: Comonadic Markov Chain Monte Carlo

LYAH: Zippers

The Algebra of Algebraic Data Types

Comonadic Game of Life

More?

Source

Store

Command pattern

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- Use a newtype so we don't accidentally mix differerent
-- representations of temperature
newtype Kelvin = Kelvin { getKelvin :: Double }
    deriving (Num, Fractional)
-- The thermostat type
type Thermostat a = (Kelvin, Kelvin -> a)
newtype Celsius = Celsius { getCelsius :: Double }
    deriving (Show)

kelvinToCelsius :: Kelvin -> Celsius
kelvinToCelsius (Kelvin t) = Celsius (t - 273.15)

initialThermostat :: Thermostat Celsius
initialThermostat = (298.15, kelvinToCelsius)
ghci> extract initialThermostat
Celsius {getCelsius = 25.0}

Command pattern

up :: Thermostat a -> a
up (t, f) = f (t + 1)

down :: Thermostat a -> a
down (t, f) = f (t - 1)
ghci> up initialThermostat 
Celsius {getCelsius = 26.0}
ghci> down initialThermostat 
Celsius {getCelsius = 24.0}
ghci> putStrLn $ toString initialThermostat 
25.0°C
toString :: Thermostat Celsius -> String
toString (t, f) = show (getCelsius (f t)) ++ "°C"
ghci> toString (up initialThermostat)  -- Type error !!!

Same story. This doesn't compose. We can solve it like as in previous examples, but let's go to extend.

Command pattern

       preview :: (Kelvin, Kelvin -> a) -> b
extend preview :: (Kelvin, Kelvin -> a) -> (Kelvin, Kelvin -> b)
extend :: ((Kelvin, Kelvin -> a) ->                    b)
       ->  (Kelvin, Kelvin -> a) -> (Kelvin, Kelvin -> b)
extend = ??
extend preview (t, f) = (t, \t' -> preview (t', f))
ghci> putStrLn $ extract (initialThermostat =>> up =>> toString)
26.0°C
up'       (t, f) = (t + 1, f)
extend up (t, f) = (t, \t' -> f (t' + 1))
up' ≠ extend up

But this actually doesn't work!

Which one is wrong?

square (t, f) = f (t ^ 2)
thermostat c  = (c, id)
toS    (t, f) = show (getKelvin (f t)) ++ " Kelvin"
ghci> putStrLn $ extract (thermostat 3 =>> up =>> toS)
4.0 Kelvin
ghci> putStrLn $ extract (thermostat 3 =>> up =>> square =>> toS)
10.0 Kelvin

Store Comonad

data Store s a = Store (s -> a) s  -- "s" is the stored value, 
                                   -- "s -> a" is the accessor/selector
instance Comonad (Store s) where
    extract :: Store s a -> a
    extract = ??

    extend :: (Store s a -> b) -> Store s a -> Store s b
    extend  = ??

Costate comonad

instance Comonad (Store s) where
    extract :: Store s a -> a
    extract  (Store f s) = f s

    extend :: (Store s a -> b) -> Store s a -> Store s b
    extend f (Store g s) = Store (f . Store g) s

Thermostat with Store 

type Thermostat a = Store Kelvin a
-- | Modify the stored value
seeks :: (s -> s) -> Store s a -> Store s a
seeks = ??

-- | Modify the stored value
seeks :: (s -> s) -> Store s a -> Store s a
seeks f (Store g s) = Store g (f s)

initialThermostat :: Thermostat Celsius
initialThermostat = store kelvinToCelsius 298.15

thermostat :: Kelvin -> Thermostat Kelvin
thermostat = store id
up, square :: Thermostat a -> a
up     = extract . seeks (+1)
square = extract . seeks (^2)

toString :: Thermostat Kelvin -> String
toString t = show (getKelvin $ extract t) ++ " K"
ghci> putStrLn $ toString =<= up $ thermostat 3
4.0°K
ghci> putStrLn $ toString =<= square =<= up $ thermostat 3
16.0°K
(=<=) :: Comonad w => (w b -> c) -> (w a -> b) -> w a -> c
(=<=) = ??
(=<=) :: Comonad w => (w b -> c) -> (w a -> b) -> w a -> c
f =<= g = f . extend g

Stream

Iterator pattern (or inf Stream)

data Iterator a = a :< Iterator a
infixr 5 :<
initialHistory :: Iterator String
initialHistory = "" :< initialHistory
exampleHistory :: Iterator String
exampleHistory =
       "^D"
    :< "^C"
    :< "eat flaming death"
    :< "hello?"
    :< "bye"
    :< "exit"
    :< "quit"
    :< "?"
    :< "help"
    :< "ed"
    :< initialHistory
extract :: Iterator a -> a
extract (cmd :< _) = cmd
ghci> extract exampleHistory
"^D"

Iterator pattern (an example)

next :: Iterator a -> a
next (_ :< (cmd :< _)) = cmd
ghci> next exampleHistory
"^C"
ghci> next (next exampleHistory)  -- type error!
-- Fortunately, we can define it in another way
next' :: Iterator a -> Iterator a
next' (_ :< iterator) = iterator
next2 :: Iterator a -> a
next2 iterator = next (next' iterator)
next2 iterator = extract (next' (next' iterator))  -- another possible variant
ghci> let history1 = exampleHistory & next'
ghci> let history2 = history1       & next'
ghci> extract history2
"eat flaming death"

Iterator pattern (the problem)

next3 :: Iterator a -> a
next3 iterator = next (next' (next' iterator)))
next3' :: Iterator a -> Iterator a
next3' iterator = next' (next' (next' iterator)))

Code duplication makes programmers sad :(

next3' :: Iterator a -> Iterator a
next3' iterator = next' (next' iterator))
-- Oops! I deleted the next and my boss
-- distracted me in the middle of the process
-- so I forgot to replace it with next'
       retrieval :: Iterator a ->          b
extend retrieval :: Iterator a -> Iterator b

extend :: (Iterator a ->          b)
       ->  Iterator a -> Iterator b
extend = ??
extend it@(_ :< xs) = f it :< extend f xs

extract = head, duplicate = tails

extend extends the function f :: Iterator a → b by applying it to all the tails to get a new Iterator b

Iterator pattern (the solution)

data Iterator a = a :< (Iterator a)
data Stream   a = Cons a (Stream a)

extend is kind of like fmap, but instead of each call to f having access only to a single element, it has access to that element and the whole tail of the list from that element onward, i.e. it has access to the element and the context.

data NonEmpty a = a :| [a]

The NonEmpty comonad

instance Comonad NonEmpty where
  extend  = ??
  extract = ??
instance Comonad NonEmpty where
  extend f w@ ~(_ :| aas) = f w :| case aas of
      []     -> []
      (a:as) -> toList (extend f (a :| as))
  extract ~(a :| _) = a
ghci> extract (exampleHistory =>> next =>> next)
"eat flaming death"
ghci> extract (3 :| [5..10] =>> take 3)
[3,5,6]
ghci> extract (3 :| [5..10] =>> take 3 =>> take 4)
[[3,5,6],[5,6,7],[6,7,8],[7,8,9]]

codo-notation (examples)

config :: Config
config = defaultConfig & method
    this & profile  -- no apostrophes, these are setters
    this & goFaster
config = defaultConfig & \_b0 ->
    let _b1 =     extend (\this -> this & profile ) _b0
    in  extract $ extend (\this -> this & goFaster) _b1
next3 :: Iterator a -> a
next3 = method
    this & next  -- Move one step forward
    this & next  -- Move another step forward
    this & next  -- Return the next value
next3 = \_i0 -> let i1 =      extend (\this -> this & next) _i0
                    i2 =      extend (\this -> this & next)  i1
                    extract $ extend (\this -> this & next)  i2

codo-notation (examples)

next123 :: Iterator a -> [a]
next123 = method
        this & next
    i1> this & next
    i2> this & next
    i3> [i1  & extract, i2 & extract, i3 & extract]
-- desugars to:
next123 =
      \_i0 ->
    let i1 =      extend (\this -> this & next) _i0
        i2 =      extend (\this -> this & next)  i1
        i3 =      extend (\this -> this & next)  i2
     in extract $ extend (\this ->
            [i1 & extract, i2 & extract, i3 & extract]) i3
-- which reduces to:
next123 = \_i0 ->
    [ next _i0
    , next (extend next _i0)
    , next (extend next (extend next i0))
    ]
Made with Slides.com