# Lecture 13 =>>extract

## Dual to monads

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

## Comonad type class

class Functor w => Comonad w where
extract   :: w a -> a
duplicate :: w a -> w (w a)
extend    :: (w a -> b) -> w a -> w b

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

### Monadic values are typically produced in effectful computations

 a -> m b
 w a -> b

## 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)
listRight (LZ as x (b:bs)) = LZ (x:as) b bs
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 = ???

## 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 z = LZ (iterateTail f z) z (iterateTail g z)
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 Z 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 ## Game of Life dispLine :: ListZipper Bool -> String dispLine z = map dispC$ toList z 6
where
dispC True  = '*'
dispC False = ' '

disp :: Z Bool -> String
disp (Z z) =
unlines $map dispLine$ toList z 6
glider :: Grid Bool
glider = Grid LZ (repeat fz) fz rs where rs = [ line [f, t, f] , line [f, f, t] , line [t, t, t] ] ++ repeat fz t = True f = False fl = repeat f fz = LZ fl f fl line l = LZ fl f (l ++ fl) ### The Zipper comonad provides a model for breadcrumb components, pagination controls, or undo/redo. ### 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> identity =>> laplace2D 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 -> (IArray i a -> b) -> 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)} \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^2$ \mathrm{Pair'_a}(a) = (a^2)'_a = 2 \cdot a $\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 $\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)} \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) = 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{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) $\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\ ??? $\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} \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{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)) $\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))$ And what the heck does this mean??? ## 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. Iterator pattern (or infinite streams) ### 4. 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

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)

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) ## Real life example of Env {-# LANGUAGE DeriveFunctor #-} import Control.Comonad (Comonad (extract, duplicate), (=>=)) -- | Value with index of line data LineRow a = LineRow !Int a deriving (Functor, Show) We want to parse CSV format and represent errors with row index. instance Comonad LineRow where extract :: LineRow a -> a extract (LineRow _ a) = a duplicate :: LineRow a -> LineRow (LineRow a) duplicate (LineRow row x) = LineRow row (LineRow row x) validateRow1 :: LineRow [a] -> [b] validateRow1 = undefined validateRow2 :: LineRow [b] -> [c] validateRow2 = undefined (=>=) :: Comonad w => (w a -> b) -> (w b -> c) -> w a -> c validateRow :: LineRow [a] -> [c] validateRow = validateRow1 =>= validateRow2 # 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 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"] ## 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. ## Real life usage of Traced Context-dependent object builders: in your lab assignments. # 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]] ## 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 !!!

## 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))
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  ### Another equivalent definition of Lens type Lens s a = a -> Store s a ### Hence the statement that lenses are ### «the coalgebras of the costate comonad». ## 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

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

-- Monad transformers
class MonadTrans t where
lift :: Monad m => m a -> t m a
-- Comonad transformers
class ComonadTrans t where
lower :: Comonad w => t w a -> w a
data    EnvT    e w a = EnvT    e (w a)
newtype TracedT m w a = TracedT { runTracedT :: w (m -> a) }
data    StoreT  s w a = StoreT  (w (s -> a)) s

class Comonad w => ComonadEnv e w | w -> e where
ask :: w a -> e

class Comonad w => ComonadTraced m w | w -> m where
trace :: m -> w a -> a

class Comonad w => ComonadStore s w | w -> s where
pos        :: w a -> s
peek       :: s -> w a -> a
peeks      :: (s -> s) -> w a -> a
seek       :: s -> w a -> w a
seeks      :: (s -> s) -> w a -> w a
experiment :: Functor f => (s -> f s) -> w a -> f a