Skip to content

Instantly share code, notes, and snippets.

@clinuxrulz
Created July 10, 2016 03:28
Show Gist options
  • Save clinuxrulz/90c7ef0bcb18f583d34b968d6eb7c112 to your computer and use it in GitHub Desktop.
Save clinuxrulz/90c7ef0bcb18f583d34b968d6eb7c112 to your computer and use it in GitHub Desktop.
F-coalgebra based version.
{-# LANGUAGE RankNTypes, KindSignatures, MultiParamTypeClasses, FlexibleContexts #-}
newtype Free f a = Free (forall m. (Monad m) => f m -> m a)
runFree :: (Monad m) => forall f a. Free f a -> f m -> m a
runFree (Free k) = k
instance Functor (Free f) where
fmap f (Free k) = Free (\impl -> fmap f (k impl))
instance Applicative (Free f) where
pure a = Free (\_ -> pure a)
(Free kf) <*> (Free ka) = Free (\impl -> (kf impl) <*> (ka impl))
instance Monad (Free f) where
(Free k) >>= f = Free (\impl -> k impl >>= (\x -> runFree (f x) impl))
data ConsoleFCo m =
ConsoleFCo
(m String) -- ^ readLine
(String -> m ()) -- ^ writeLine
data NetworkFCo m =
NetworkFCo
(String -> m ()) -- ^ sendToServer
class FCoProject (f :: (* -> *) -> *) (g :: (* -> *) -> *) where
projectFCo :: forall m. f m -> g m
newtype MyFCo m = MyFCo (ConsoleFCo m, NetworkFCo m)
instance FCoProject ConsoleFCo ConsoleFCo where
projectFCo = id
instance FCoProject NetworkFCo NetworkFCo where
projectFCo = id
instance FCoProject MyFCo ConsoleFCo where
projectFCo (MyFCo (x,_)) = x
instance FCoProject MyFCo NetworkFCo where
projectFCo (MyFCo (_,x)) = x
readLine :: forall f. (FCoProject f ConsoleFCo) => Free f String
readLine = Free (\impl -> case projectFCo impl of ConsoleFCo x _ -> x)
writeLine :: forall f. (FCoProject f ConsoleFCo) => String -> Free f ()
writeLine msg = Free (\impl -> case projectFCo impl of ConsoleFCo _ x -> x msg)
sendToServer :: forall f. (FCoProject f NetworkFCo) => String -> Free f ()
sendToServer msg = Free (\impl -> case projectFCo impl of NetworkFCo x -> x msg)
myApp :: forall f. (FCoProject f ConsoleFCo, FCoProject f NetworkFCo) => Free f ()
myApp = readLine >>= sendToServer
main = return ()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment