on master help sign in
Add example impls of Monad*Control

This resolves #25

commitcd6db37502033ada4af6e20292140a4463d0d56f authorMichael Xavier <michael@michaelxavier.net> dateFri 13 May 2016, 13:36 (10 years ago) parentd9ae92f
2 files changed+58−9
katip/examples/example.hs+29−4 katip/examples/example_lens.hs+29−5
katip/examples/example.hs+29−4
@@ -1,19 +1,24 @@
11{-# LANGUAGE FlexibleContexts #-}
2+{-# LANGUAGE FlexibleInstances #-}
23{-# LANGUAGE GeneralizedNewtypeDeriving #-}
34{-# LANGUAGE MultiParamTypeClasses #-}
45{-# LANGUAGE OverloadedStrings #-}
56{-# LANGUAGE TemplateHaskell #-}
7+{-# LANGUAGE TypeFamilies #-}
8+{-# LANGUAGE UndecidableInstances #-}
69module Main
710 ( main
811 ) where
912
1013
1114-------------------------------------------------------------------------------
12−import qualified Control.Applicative as A
15+import qualified Control.Applicative as A
16+import Control.Monad.Base
1317import Control.Monad.Reader
18+import Control.Monad.Trans.Control
1419import Data.Aeson
15−import Data.Monoid as M
16−import System.IO (stdout)
20+import Data.Monoid as M
21+import System.IO (stdout)
1722-------------------------------------------------------------------------------
1823import Katip
1924-------------------------------------------------------------------------------
@@ -78,7 +83,27 @@ data MyState = MyState {
7883-------------------------------------------------------------------------------
7984newtype MyStack m a = MyStack {
8085 unStack :: ReaderT MyState m a
81− } deriving (MonadReader MyState, Functor, A.Applicative, Monad, MonadIO)
86+ } deriving (MonadReader MyState, Functor, A.Applicative, Monad, MonadIO, MonadTrans)
87+
88+
89+-- MonadBase, MonadTransControl, and MonadBaseControl aren't strictly
90+-- needed for this example, but they are commonly required and
91+-- MonadTransControl/MonadBaseControl are a pain to implement, so I've
92+-- included them. Note that KatipT and KatipContextT already do this work for you.
93+instance MonadBase b m => MonadBase b (MyStack m) where
94+ liftBase = liftBaseDefault
95+
96+
97+instance MonadTransControl MyStack where
98+ type StT MyStack a = StT (ReaderT Int) a
99+ liftWith = defaultLiftWith MyStack unStack
100+ restoreT = defaultRestoreT MyStack
101+
102+
103+instance MonadBaseControl b m => MonadBaseControl b (MyStack m) where
104+ type StM (MyStack m) a = ComposeSt MyStack m a
105+ liftBaseWith = defaultLiftBaseWith
106+ restoreM = defaultRestoreM
82107
83108
84109instance (MonadIO m) => Katip (MyStack m) where
katip/examples/example_lens.hs+29−5
@@ -1,20 +1,25 @@
11{-# LANGUAGE FlexibleContexts #-}
2+{-# LANGUAGE FlexibleInstances #-}
23{-# LANGUAGE GeneralizedNewtypeDeriving #-}
34{-# LANGUAGE MultiParamTypeClasses #-}
45{-# LANGUAGE OverloadedStrings #-}
56{-# LANGUAGE TemplateHaskell #-}
7+{-# LANGUAGE TypeFamilies #-}
8+{-# LANGUAGE UndecidableInstances #-}
69module Main
710 ( main
811 ) where
912
1013
1114-------------------------------------------------------------------------------
12−import Control.Applicative as A
13−import Control.Lens hiding ((.=))
15+import Control.Applicative as A
16+import Control.Lens hiding ((.=))
17+import Control.Monad.Base
1418import Control.Monad.Reader
19+import Control.Monad.Trans.Control
1520import Data.Aeson
16−import Data.Monoid as M
17−import System.IO (stdout)
21+import Data.Monoid as M
22+import System.IO (stdout)
1823-------------------------------------------------------------------------------
1924import Katip
2025-------------------------------------------------------------------------------
@@ -86,9 +91,28 @@ confrabulateWidgets = return ()
8691-------------------------------------------------------------------------------
8792newtype MyStack m a = MyStack {
8893 unStack :: ReaderT MyState m a
89− } deriving (MonadReader MyState, Functor, A.Applicative, Monad, MonadIO)
94+ } deriving (MonadReader MyState, Functor, A.Applicative, Monad, MonadIO, MonadTrans)
9095
9196
97+-- MonadBase, MonadTransControl, and MonadBaseControl aren't strictly
98+-- needed for this example, but they are commonly required and
99+-- MonadTransControl/MonadBaseControl are a pain to implement, so I've
100+-- included them. Note that KatipT and KatipContextT already do this work for you.
101+instance MonadBase b m => MonadBase b (MyStack m) where
102+ liftBase = liftBaseDefault
103+
104+
105+instance MonadTransControl MyStack where
106+ type StT MyStack a = StT (ReaderT Int) a
107+ liftWith = defaultLiftWith MyStack unStack
108+ restoreT = defaultRestoreT MyStack
109+
110+
111+instance MonadBaseControl b m => MonadBaseControl b (MyStack m) where
112+ type StM (MyStack m) a = ComposeSt MyStack m a
113+ liftBaseWith = defaultLiftBaseWith
114+ restoreM = defaultRestoreM
115+
92116instance (MonadIO m) => Katip (MyStack m) where
93117 getLogEnv = view msLogEnv
94118