fork download 
  1. {-# LANGUAGE ExistentialQuantification #-}
  2. {-# LANGUAGE GADTs #-}
  3.  
  4. import Control.Monad
  5.  
  6. -- The definition of co-yoneda
  7. data Coyoneda f b = forall a. Coyoneda (a -> b) (f a)
  8.  
  9. -- Coyoneda implements Functor
  10. instance Functor (Coyoneda f) where
  11.     fmap f (Coyoneda g h) = Coyoneda (f . g) h
  12.  
  13. -- The definition of the Free monad
  14. data Free f a where
  15.   Pure :: a -> Free f a
  16.   Join :: f (Free f a) -> Free f a
  17.  
  18. instance Functor f => Functor (Free f) where
  19.   fmap = liftM
  20.  
  21. instance Functor f => Applicative (Free f) where
  22.   pure = return
  23.   (<*>) = ap
  24.  
  25. -- Free f implements Functor when f is a functor
  26. instance Functor f => Monad (Free f) where
  27.   return = Pure
  28.   Pure a >>= f = f a
  29.   Join m >>= f = Join $ fmap (>>= f) m
  30.  
  31. -- A type alias for Free (Coyoneda f)
  32. type M f = Free (Coyoneda f)
  33.  
  34. -- 'Lifts' an arbitrary f onto M f a
  35. toM :: f a -> M f a
  36. toM = Join . fmap Pure . Coyoneda id
  37.  
  38. -- A sample instruction for an operational monad
  39. data Sample a where
  40.   Get :: Sample String
  41.   Put :: String -> Sample ()
  42.  
  43. -- Make the instruction monad
  44. type SampleM = M Sample
  45.  
  46. -- Actions for each instruction
  47. get :: SampleM String
  48. get = toM Get
  49. put :: String -> SampleM ()
  50. put = toM . Put
  51.  
  52. -- Associates instructions and actual behaviours
  53. runSampleM :: SampleM a -> IO a
  54. runSampleM (Pure a) = pure a
  55. runSampleM (Join (Coyoneda f Get)) = getContents >>= runSampleM . f
  56. runSampleM (Join (Coyoneda f (Put s))) = putStrLn s >>= runSampleM . f
  57.  
  58. main :: IO ()
  59. main = runSampleM $ do
  60.   get >>= put
Success #stdin #stdout 0.01s 5608KB
comments (?)
stdin 
Hello, World
stdout 
Hello, World
https://ideone.com/l1sh9Q
language:
Haskell (ghc 8.4.4)
created:
4 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!