# Lecture 13 =>>extract

### Phil Freeman: Declarative UIs are the Future — And the Future is Comonadic!

return  :: a -> m a

### return

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

### bind

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

### join

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

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? ## 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 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

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?

### 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)
\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{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))

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) 

# 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"]

## Builder pattern (2/3)

builder = new DefaultConfig();  // Begin from default config file
config = builder.extract();     // Extract final config file

### 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"]

## 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

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

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.

# 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]

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]]

## 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

### 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

## codo-notation

method
wa> expr1
wb> expr2
wc> expr3

### 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

## 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)) ] ## More? ### Source ## Coread list ## 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