robrix

module FoldsAndUnfolds where

import Data.List -- for unfoldr

class Functor f => Recursive f t | t -> f where
  project :: t -> f t

  cata :: (f a -> a) -> t -> a
  cata alg = go where go = alg . fmap go . project

robrix

newtype Mu f = Mu (forall r . (f r -> r) -> r)

foldMu :: (f a -> a) -> Mu f -> a
foldMu alg (Mu f) = f alg

unfoldMu :: Functor f => (a -> f a) -> a -> Mu f
unfoldMu coalg a = Mu $ \ alg -> refold alg coalg a

refoldMu :: Functor f => (f b -> b) -> (a -> f a) -> a -> b
refoldMu f g = foldMu f . unfoldMu g

robrix

type Name = String

-- first-order syntax
data Tm
  = Var Name
  | Abs Name Tm
  | App Tm Tm
  deriving (Eq, Ord, Show)

type Env = [(Name, Val)]

robrix

newtype Fix f = In { out :: f (Fix f) }

cata :: Functor f => (f a -> a) -> (Fix f -> a)
cata alg = go where go = alg . fmap go . out

ana :: Functor f => (a -> f a) -> (a -> Fix f)
ana coalg = go where go = In . fmap go . coalg


hylo1 :: Functor f => (f b -> b) -> (a -> f a) -> (a -> b)

robrix

import Control.Algebra

-- Failover effect

failover :: Has Failover sig m => m a -> m a -> m a
failover a b = send (Failover a b)

infixl 3 `failover`

data Failover m k where

robrix

data Ref ref (m :: K.Type -> K.Type) k where
  NewRef :: a -> Ref ref m (ref a)
  ReadRef :: ref a -> Ref ref m a
  WriteRef :: ref a -> a -> Ref ref m ()

newRef :: Has (Ref ref) sig m => a -> m (ref a)
newRef a = send (NewRef a)

readRef :: Has (Ref ref) sig m => ref a -> m a
readRef ref = send (ReadRef ref)