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)

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

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

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

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

{-# LANGUAGE RankNTypes #-}
module Optics where

import           Control.Category ((>>>))
import qualified Control.Category as Cat
import           Control.Effect.Empty
import           Control.Effect.NonDet hiding (empty)
import           Control.Monad ((<=<))

-- riffing off of @serras’s post https://gist.github.com/serras/5152ec18ec5223b676cc67cac0e99b70

robrix

class Applicative f => Selective f where
  branch :: f (Either a b) -> f (a -> c) -> f (b -> c) -> f c
  branch ab f g = fmap (fmap Left) ab `select` fmap (fmap Right) f `select` g

  select :: f (Either a b) -> f (a -> b) -> f b
  select ab f = branch ab f (pure id)

  {-# MINIMAL branch | select #-} -- Defining in terms of both to double-check my work

filteredBy :: (Alternative f, Selective f) => f a -> (a -> Bool) -> f a -- from Staged Selective Parser Combinators

robrix

module Deriving
( ApplicativeInstance(..)
, MonadInstance(..)
) where

import Control.Applicative (liftA, liftA2)
import Control.Monad (ap, liftM, liftM2)

-- | 'Functor' instances derivable via an 'Applicative' instance, for use with @-XDerivingVia@.
--

robrix

{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE RankNTypes #-}
module Mendler where

class Iter b t | t -> b where
  iter :: (forall x . (x -> a) -> b x -> a) -> t -> a

data ListF a b = Nil | Cons a b

instance Iter (ListF a) [a] where