Random notes.

Notes.hs

{-# LANGUAGE 
    LambdaCase, DeriveFunctor, FlexibleContexts, 
    RankNTypes, TemplateHaskell, NoMonomorphismRestriction #-}

-- golfing the state monad with free

import Control.Monad
import Control.Monad.Free
import Control.Monad.Free.TH
 
data S s k = P s k | G (s -> k) deriving (Functor)
runState = iter (\case P s k -> \_ -> k s; G k -> join k) . fmap (,)
$(makeFree ''S)
modify f = p . f =<< g
 
main = print $ runState (replicateM_ 100 $ modify succ) 0


-- *******************************************

{-# LANGUAGE RankNTypes, DeriveFunctor #-}

import Control.Monad
import Control.Applicative
import Control.Monad.Free
import Data.Traversable (Traversable, traverse)

-- http://comonad.com/reader/2011/free-monads-for-less-3/


newtype Coroutine i o a = Coroutine {
    unCoroutine :: forall r. (a -> r) -> (o -> (i -> r) -> r) -> r} deriving (Functor)

data Result i o a = Done a | Yield o (i -> Result i o a) deriving (Functor)

instance Monad (Coroutine i o) where
    return a          = Coroutine (\ret yld -> ret a)
    Coroutine m >>= f = Coroutine (\ret yld -> m (\a -> unCoroutine (f a) ret yld) yld)

instance Applicative (Coroutine i o) where
    pure  = return
    Coroutine mf <*> Coroutine ma = Coroutine (\ret yld ->
        mf (\f -> ma (\a -> ret (f a)) yld) yld)

yield :: o -> Coroutine i o i
yield o = Coroutine (\ret yld -> yld o ret)

walk :: Traversable t => t o -> Coroutine i o (t i)
walk = traverse yield

runCoroutine :: Coroutine i o a -> Result i o a
runCoroutine (Coroutine m) = m Done Yield

next :: i -> Result i o a -> Result i o a
next i (Yield _ k) = k i
next _ other       = other

toCoroutine :: Result i o a -> Coroutine i o a
toCoroutine (Done a)    = return a
toCoroutine (Yield o k) = 
    Coroutine (\ret yld -> yld o (\i -> unCoroutine (toCoroutine (k i)) ret yld))

-- existential vect filter

{-# LANGUAGE
    DataKinds, GADTs, PolyKinds, TypeOperators, StandaloneDeriving,
    TemplateHaskell, ScopedTypeVariables, TypeFamilies, RankNTypes,
    FlexibleInstances, UndecidableInstances #-}

import Data.Singletons.TH

$(singletons [d| data Nat = Z | S Nat|])

data Vect a n where
    Nil :: Vect a Z
    (:|) :: a -> Vect a n -> Vect a (S n)
infixr 5 :|

data Exists p where
    E :: SingI x => p x -> Exists p

deriving instance Show a => Show (Vect a n)
deriving instance Show a => Show (Exists (Vect a))

vfilter :: (a -> Bool) -> Vect a n -> Exists (Vect a)
vfilter f (x :| xs) = case vfilter f xs of
    E xs' | f x  -> E (x :| xs')
    other        -> other
vfilter f Nil = E Nil