Lecture 13 =>> extract

Lecture plan

  • What Comonad is
  • Zippers
  • Type algebra
  • Type isomorphisms
  • Comonads as OOP patterns: Env, Traced

Dual to monads

return  :: a -> m a

Monad

return

Comonad

extract :: a <- m a
(>>=) :: m a -> (a -> m b) -> m b

Monad

bind

Comonad

(=>>) :: m a <- (a <- m b) <- m b  -- «extend»
join      :: m (m a) -> m a

Monad

join

Comonad

duplicate :: m (m a) <- m a

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 arguments flipped
(=>>) :: Comonad w => w a -> (w a -> b) -> w b
data Identity a = Identity { runIdentity :: a }

instance Comonad Identity where
    extract   = runIdentity
    duplicate = Identity

Simple example

Are Maybe and [] comonads?

Hackage: comonad

Compare monads and comonads

Comonadic values are typically consumed in context-sensitive computations

Monadic values are typically produced in effectful computations

 a -> m b
 w a -> b

Zippers

From list to Zippers to Comonad

data [a] = [] | a : [a]
data ListZipper a = LZ [a] a [a]  -- allows to focus on a single element
listLeft, listRight :: ListZipper a -> ListZipper a
listLeft  (LZ (a:as) x bs) = LZ as a (x:bs)
listLeft _ = error "listLeft"

listRight (LZ as x (b:bs)) = LZ (x:as) b bs
listRight _ = error "listRight"
listWrite :: a -> ListZipper a -> ListZipper a
listWrite 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

ListZipper is 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 a little bit mind blowing

duplicate for ListZipper

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

iterateTail :: (a -> a) -> a -> [a]
iterateTail f = tail . iterate f
genericMove :: (z a -> z a)
            -> (z a -> z a)
            -> z a
            -> ListZipper (z a)
genericMove f g e = LZ (iterateTail f e) e (iterateTail g e)
duplicate :: ListZipper a -> ListZipper (ListZipper a)
duplicate = genericMove listLeft listRight
ghci> take 5 $ iterateTail (*2) 1
[2, 4, 8, 16, 32]

Zipper of Zippers

newtype Grid a = Grid { unGrid :: ListZipper (ListZipper a) }  -- 2D grid
up, down :: Grid a -> Grid a
up   (Grid g) = Grid (listLeft  g)
down (Grid g) = Grid (listRight g)  
left, right :: Grid a -> Grid a
left  (Grid g) = Grid (fmap listLeft  g)
right (Grid g) = Grid (fmap listRight g)

gridRead :: Grid a -> a
gridRead (Grid g) = extract $ extract g
 
gridWrite :: a -> Grid a -> Grid a
gridWrite x (Grid g) = Grid $ listWrite newLine g
  where
    oldLine = extract g
    newLine = listWrite x oldLine
horizontal, vertical :: Grid a -> ListZipper (Grid a)
horizontal = genericMove left right
vertical   = genericMove up   down
instance Comonad Grid where
    extract :: Grid a -> a
    extract = gridRead

    duplicate :: Grid a -> Grid (Grid a)
    duplicate = Grid . fmap horizontal . vertical

Game of Life

neighbours :: [Grid a -> Grid a]
neighbours = 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 — is alive, False — is dead

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

Wildfire «simulation» with co-state co-monads representing cellular automata

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

Image processing

data IArray i a = IA (Array i a) i  -- content with index
instance Ix i => Functor (IArray i) where
  fmap f (IA a i) = IA (fmap f a) i
(?) :: (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
laplace2D :: IArray (Int, Int) Float -> Float  -- 2D-array of Float
laplace2D a = a ? (-1,  0)
            + a ? ( 0,  1)
            + a ? ( 0, -1)
            + a ? ( 1,  0)
            - 4 * a ? (0, 0)
ghci> extend laplace2D identityArray 
IA (array ((0,0), (1,1)) 
           [ ((0,0),-4.0), ((0,1),2.0), ((1,0),2.0), ((1,1),-4.0) ]
   ) (0,0)
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' = map (\j -> (j, f (IA a j))) (indices a)
        in IA (array (bounds a) es') i

More on zippers

-- | A 2D zipper representing a grid of values with a focus.
newtype Grid a = Grid { unGrid :: Zipper (Zipper 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 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)
]

into this

Type algebra

Types as math functions

data Void

In Haskell we have sum types and product types.

So why not have type differentiation?

Haskell

Math

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

Types isomorphisms

-- 4
data BoolPair = BoolPair Bool Bool ⋍ Either Bool Bool

Basically, algebraic representation of type tells you how many values of this type you have. If types have the same number of values they are isomorphic (can represent same things).

Examples

-- e + 1
Either e () ⋍ Maybe  e
List Unit ⋍ data Nat = Zero | Succ Nat

Math analysis to the rescue

data Pair a = Pair a a
\frac{\begin{aligned} \mathrm{T}(a)\ &:\ \mathrm{Type} \\ \mathrm{Z_T}(a)\ &:\ \mathrm{Zipper}(T,\ a) \end{aligned}}{\mathrm{Z_T}(a)\ \equiv\ a \cdot \mathrm{T'_a}(a)}
\mathrm{Pair}(a) = a^2
\mathrm{Pair'_a}(a) = (a^2)'_a = 2 \cdot a
\mathrm{Z_{Pair}}(a) = a \cdot \mathrm{Pair'_a}(a) = a \cdot 2 \cdot a = 2 \cdot a^2
data PairZipper a = PZ Bool a a
data PairZipper a = Fst { this  :: a, other :: a }
                  | Snd { other :: a, this  :: a }

List derivation

data List a = Nil | Cons a (List a)
\mathrm{List}(a) = 1 + a \cdot \mathrm{List}(a) \Rightarrow \mathrm{List}(a) = \frac{1}{1 - a}
\mathrm{List'_a}(a) = \left(\frac{1}{1 - a}\right)'_a = \frac{1}{(1 - a)^2} = \left(\frac{1}{1 - a}\right)^2 = \mathrm{List}(a)^2
\mathrm{Z_{List}}(a) = a \cdot \mathrm{List'_a}(a) = a \cdot \mathrm{List}(a)^2 = a \cdot \mathrm{List}(a) \cdot \mathrm{List}(a)
data ListZipper a = LZ a (List a) (List a)

Tree zipper

data Tree a = Leaf | Node a (Tree a) (Tree a)
\mathrm{Tree}(a) = 1 + a \cdot \mathrm{Tree}(a)^2 \Rightarrow\ ???
data ListEntry  a = LE Bool a (Tree a)
data TreeZipper a = TZ a (Tree a) (Tree a) [ListEntry a]

It's not so easy to find Tree(a) but Tree(a)' is much easier to find!

\begin{aligned} \mathrm{Tree}(a) &= 1 + a \cdot \mathrm{Tree}(a)^2 \\ \mathrm{Tree'_a}(a) &= (1 + a \cdot \mathrm{Tree}(a)^2)'_a \\ \mathrm{Tree'_a}(a) &= 1'_a + (a \cdot \mathrm{Tree}(a)^2)'_a \\ \mathrm{Tree'_a}(a) &= a'_a \cdot \mathrm{Tree}(a)^2 + a \cdot (\mathrm{Tree}(a)^2)'_a \\ \mathrm{Tree'_a}(a) &= \mathrm{Tree}(a)^2 + 2 \cdot a \cdot \mathrm{Tree}(a) \cdot \mathrm{Tree}(a)'_a \end{aligned}
\mathrm{Tree'_a}(a) = \frac{\mathrm{Tree}(a)^2}{1 - 2 \cdot a \cdot \mathrm{Tree}(a)} = \mathrm{Tree}(a)^2 \cdot \mathrm{List}(2 \cdot a \cdot \mathrm{Tree}(a))
\mathrm{Z_{Tree}}(a) = a \cdot \mathrm{Tree'_a}(a) = a \cdot \mathrm{Tree}(a)^2 \cdot \mathrm{List}(2 \cdot a \cdot \mathrm{Tree}(a))

Breadcrumbs

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

Now back to boring programming and comonads...

OOP patterns meet Comonads

We can emulate some OOP patterns

1. Value with context

2. Builder pattern

3. Command pattern

Env

Environment with initial value

type Pos1D = (Int, Int)  -- current position with starting 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 $ right 3 $ 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
accessor        :: Pos1D -> Int
extend accessor :: Pos1D -> Pos1D

Our solution is good enough but not the best. We need to return initial value each time but we can accidentally break it.

And we need to write this boilerplate with `z` each time!

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  -- just a pair
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)

Builder

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 imperative world

Back to Haskell (first 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

Previous solution is not good enough :(

We want something better

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> :t (=>>)    -- flip extend
(=>>) :: Comonad w => w a -> (w a -> b) -> w b

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). We can append to the state using tell.

codo-notation

method
    wa> expr1
    wb> expr2
    wc> expr3

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

Proposed model by Gabriel Gonzales:

   \wa ->
 let wb =      extend (\this -> expr1) wa
     wc =      extend (\this -> expr2) wb
 in extract  $ extend (\this -> expr3) wc

Expression

Desugars into

method
    expr1
    expr2
    expr3
   \_wa ->
 let _wb =      extend (\this -> expr1) _wa
     _wc =      extend (\this -> expr2) _wb
 in  extract  $ extend (\this -> expr3) _wc

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

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 example, 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 actually this 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
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 Comonad

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 $ up =<= toString $ thermostat 3
4.0°K
ghci> putStrLn $ up =<= square =<= toString $ 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 (example)

next :: Iterator a -> a
next (_ :< (cmd :< _)) = cmd
ghci> next exampleHistory
"^C"
ghci> next (next exampleHistory)  -- Type error!
-- Fortunately, we are not stupid and 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 (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 tails of stream to get a new Iterator b

Iterator pattern (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 onwards, i.e. it has access to the element and a context.

data NonEmpty a = a :| [a]

NonEmpty list 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