RecordWildCards and Monads

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
-- Monad.hs
{-# LANGUAGE PolymorphicComponents #-}
module Monad (Monad (..), def) where

import Prelude (String)
import qualified Prelude

data Monad m
  = M { return :: forall a . a -> m a
      , (>>=) :: forall a b . m a -> (a -> m b) -> m b
      , (>>) :: forall a b . m a -> m b -> m b
      , fail :: forall a . String -> m a
      }

def :: Prelude.Monad m => Monad m
def = M { return = Prelude.return
        , (>>=) = (Prelude.>>=)
        , (>>) = (Prelude.>>)
        , fail = Prelude.fail
        }

-- IndexedMonad.hs
{-# LANGUAGE PolymorphicComponents #-}
module IndexedMonad (IndexedMonad (..)) where

data IndexedMonad m =
  IM { return :: forall a e . a -> m e e a
     , (>>=) :: forall a b e ex x . m e ex a -> (a -> m ex x b) -> m e x b
     , (>>) :: forall a b e ex x . m e ex a -> m ex x b -> m e x b
     , fail :: forall a e x . String -> m e x a
     }

-- Main.hs
{-# LANGUAGE
    NamedFieldPuns
  , PolymorphicComponents
  , RebindableSyntax
  , RecordWildCards #-}
module Main (main) where

import Control.Category

import Prelude hiding (Monad (..), (.), id)
import qualified Prelude

import Monad
import qualified Monad
import IndexedMonad

newtype WriterT w m e x a = WriterT { runWriterT :: m (a, w e x) }

writerMonad :: (Category w, Prelude.Monad m) => IndexedMonad (WriterT w m)
writerMonad =
  IM { return
     , (>>=)
     , (>>)
     , fail
     }
  where
    return a = WriterT $ return (a, id)
      where
        M {..} = Monad.def
    m >>= k = WriterT $ do
      (a, w) <- runWriterT m
      (b, w') <- runWriterT (k a)
      return (b, w' . w)
      where
        M {..} = Monad.def
    m >> n = m >>= \ _ -> n
    fail = WriterT . fail
      where
        M {..} = Monad.def

tell :: (Category w, Prelude.Monad m) => w e x -> WriterT w m e x ()
tell w = WriterT $ return ((), w)
  where
    M {..} = Monad.def

test :: (Category w, Prelude.Monad m) => WriterT w m e e (a -> a)
test = do
  tell id
  return id
  where
    IM {..} = writerMonad

main = undefined