Skip to content

Instantly share code, notes, and snippets.

@yuga yuga/Objective.hs
Created May 12, 2015

Embed
What would you like to do?
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
module Objective where
import Data.Functor.Identity (Identity(Identity))
-- |
-- prop> runObject obj (fmap f m) = fmap (f *** id) (runObject obj m)
--
newtype Object f g = Object
{ runObject :: forall a. f a -> g (a, Object f g)
}
newtype Mealy a b = Mealy
{ runMealy :: a -> (b, Mealy a b)
}
-- |
-- prop> runNatural nat (fmap f m) = fmap f (runNatural nat m)
--
newtype Natural f g = Natural
{ runNatural :: forall a. f a -> g a
}
fromNatural :: Functor g => Natural f g -> Object f g
fromNatural (Natural t) = lift0 t
lift0 :: Functor g => (forall x. f x -> g x) -> Object f g
lift0 t = Object $ fmap (\x -> (x, lift0 t)) . t
data Req a b r where
Req :: a -> Req a b b
fromMealy :: Mealy a b -> Object (Req a b) Identity
fromMealy (Mealy t) = Object $ \(Req a) -> let (b, m) = t a in Identity (b, fromMealy m)
data Counter a where
Print :: Counter ()
Increment :: Counter Int
counter :: Int -> Object Counter IO
counter n = Object (handle n) where
handle :: Int -> Counter a -> IO (a, Object Counter IO)
handle n' Increment = return (n', counter (n' + 1))
handle n' Print = print n >> return ((), counter n')
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.