git.iko.soy/typeable/ether
on master help sign in
Drop newtype-generics
0632d78Index Int
ether.cabal−1
compare with master
unifiedsplit
@@ -64,7 +64,6 @@ library
64 , monad-control >=1.0.0.4
64 , monad-control >=1.0.0.4
65 , transformers-base >=0.4.4
65 , transformers-base >=0.4.4
66 , template-haskell >=2.9
66 , template-haskell >=2.9
67− , newtype-generics >=0.4.1
68
67
69 default-language: Haskell2010
68 default-language: Haskell2010
70 other-extensions: DeriveGeneric
69 other-extensions: DeriveGeneric
src/Control/Ether/Tagged.hs−9
@@ -7,7 +7,6 @@
7{-# LANGUAGE UndecidableInstances #-}
7{-# LANGUAGE UndecidableInstances #-}
8{-# LANGUAGE MultiParamTypeClasses #-}
8{-# LANGUAGE MultiParamTypeClasses #-}
9{-# LANGUAGE FunctionalDependencies #-}
9{-# LANGUAGE FunctionalDependencies #-}
10−{-# LANGUAGE DefaultSignatures #-}
11
10
12-- | Type-level machinery for tag manipulation.
11-- | Type-level machinery for tag manipulation.
13
12
@@ -28,7 +27,6 @@ import qualified Control.Monad.ST.Strict as Strict (ST)
28import qualified Control.Monad.ST.Lazy as Lazy (ST)
27import qualified Control.Monad.ST.Lazy as Lazy (ST)
29import GHC.Conc (STM)
28import GHC.Conc (STM)
30import GHC.Exts (Constraint)
29import GHC.Exts (Constraint)
31−import qualified Control.Newtype as NT
32import Control.Ether.Util (type (++), MaybeToList)
30import Control.Ether.Util (type (++), MaybeToList)
33
31
34import qualified Control.Monad.Trans.Cont as Trans
32import qualified Control.Monad.Trans.Cont as Trans
@@ -147,13 +145,6 @@ type Tags (m :: * -> *) = MaybeToList (Tag m) ++ ListMapTag (Inners m)
147-- | The 'Tagged' type class establishes a relationship between a tagged
145-- | The 'Tagged' type class establishes a relationship between a tagged
148-- monad transformer and its untagged counterpart.
146-- monad transformer and its untagged counterpart.
149class (Taggable m, Tag m ~ 'Just tag) => Tagged m tag | m -> tag where
147class (Taggable m, Tag m ~ 'Just tag) => Tagged m tag | m -> tag where
150−
151 type Untagged m :: * -> *
148 type Untagged m :: * -> *
152−
153 tagged :: proxy tag -> Untagged m a -> m a
149 tagged :: proxy tag -> Untagged m a -> m a
154− default tagged :: NT.Newtype (m a) => proxy tag -> NT.O (m a) -> m a
155− tagged _ = NT.pack
156−
157 untagged :: proxy tag -> m a -> Untagged m a
150 untagged :: proxy tag -> m a -> Untagged m a
158− default untagged :: NT.Newtype (m a) => proxy tag -> m a -> NT.O (m a)
159− untagged _ = NT.unpack
src/Control/Ether/Wrapped.hs+1−4
@@ -17,7 +17,7 @@ Annotating monads with tags to turn untagged constraints into tagged ones.
17>
17>
18> f :: T.MonadState Int m => m String
18> f :: T.MonadState Int m => m String
19> f = fmap show T.get
19> f = fmap show T.get
20−>
20+>
21> g :: MonadState Foo Int m => m String
21> g :: MonadState Foo Int m => m String
22> g = ethered foo f
22> g = ethered foo f
23-}
23-}
@@ -33,7 +33,6 @@ import Control.Monad (MonadPlus)
33import Control.Monad.Fix (MonadFix)
33import Control.Monad.Fix (MonadFix)
34import Control.Monad.IO.Class (MonadIO)
34import Control.Monad.IO.Class (MonadIO)
35import GHC.Generics (Generic)
35import GHC.Generics (Generic)
36−import qualified Control.Newtype as NT
37
36
38import Control.Monad.Ether.Reader.Class
37import Control.Monad.Ether.Reader.Class
39import Control.Monad.Ether.State.Class
38import Control.Monad.Ether.State.Class
@@ -51,8 +50,6 @@ newtype WrappedEther tag m a = WrapEther { unwrapEther :: m a }
51 , Functor, Applicative, Alternative, Monad, MonadPlus
50 , Functor, Applicative, Alternative, Monad, MonadPlus
52 , MonadFix, MonadIO )
51 , MonadFix, MonadIO )
53
52
54−instance NT.Newtype (WrappedEther tag m a)
55−
56-- | Annotate a polymorphic monadic computation with a tag.
53-- | Annotate a polymorphic monadic computation with a tag.
57ethered :: proxy tag -> WrappedEther tag m a -> m a
54ethered :: proxy tag -> WrappedEther tag m a -> m a
58ethered _proxy = unwrapEther
55ethered _proxy = unwrapEther
src/Control/Monad/Trans/Ether/Except.hs+21−10
@@ -22,6 +22,9 @@ module Control.Monad.Trans.Ether.Except
22 -- * Exception operations
22 -- * Exception operations
23 , throw
23 , throw
24 , catch
24 , catch
25+ -- * Newtype operations
26+ , pack
27+ , unpack
25 ) where
28 ) where
26
29
27import Data.Functor.Identity (Identity(..))
30import Data.Functor.Identity (Identity(..))
@@ -33,7 +36,7 @@ import Control.Monad.IO.Class (MonadIO)
33import Control.Monad.Morph (MFunctor, MMonad)
36import Control.Monad.Morph (MFunctor, MMonad)
34import Control.Ether.Tagged (Taggable(..), Tagged(..))
37import Control.Ether.Tagged (Taggable(..), Tagged(..))
35import GHC.Generics (Generic)
38import GHC.Generics (Generic)
36−import qualified Control.Newtype as NT
39+import Data.Coerce (coerce)
37
40
38import qualified Control.Monad.Base as MB
41import qualified Control.Monad.Base as MB
39import qualified Control.Monad.Trans.Control as MC
42import qualified Control.Monad.Trans.Control as MC
@@ -74,15 +77,21 @@ newtype ExceptT tag e m a = ExceptT (Trans.ExceptT e m a)
74 , Functor, Applicative, Alternative, Monad, MonadPlus
77 , Functor, Applicative, Alternative, Monad, MonadPlus
75 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )
78 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )
76
79
80+-- | Type-restricted `coerce`.
77−instance NT.Newtype (ExceptT tag e m a)
81+pack :: Trans.ExceptT e m a -> ExceptT tag e m a
82+pack = coerce
83+
84+-- | Type-restricted `coerce`.
85+unpack :: ExceptT tag e m a -> Trans.ExceptT e m a
86+unpack = coerce
78
87
79instance MB.MonadBase b m => MB.MonadBase b (ExceptT tag e m) where
88instance MB.MonadBase b m => MB.MonadBase b (ExceptT tag e m) where
80 liftBase = MB.liftBaseDefault
89 liftBase = MB.liftBaseDefault
81
90
82instance MC.MonadTransControl (ExceptT tag e) where
91instance MC.MonadTransControl (ExceptT tag e) where
83 type StT (ExceptT tag e) a = MC.StT (Trans.ExceptT e) a
92 type StT (ExceptT tag e) a = MC.StT (Trans.ExceptT e) a
84− liftWith = MC.defaultLiftWith NT.pack NT.unpack
93+ liftWith = MC.defaultLiftWith pack unpack
85− restoreT = MC.defaultRestoreT NT.pack
94+ restoreT = MC.defaultRestoreT pack
86
95
87instance MC.MonadBaseControl b m => MC.MonadBaseControl b (ExceptT tag e m) where
96instance MC.MonadBaseControl b m => MC.MonadBaseControl b (ExceptT tag e m) where
88 type StM (ExceptT tag e m) a = MC.ComposeSt (ExceptT tag e) m a
97 type StM (ExceptT tag e m) a = MC.ComposeSt (ExceptT tag e) m a
@@ -92,20 +101,20 @@ instance MC.MonadBaseControl b m => MC.MonadBaseControl b (ExceptT tag e m) wher
92type instance Lift.StT (ExceptT tag e) a = MC.StT (ExceptT tag e) a
101type instance Lift.StT (ExceptT tag e) a = MC.StT (ExceptT tag e) a
93
102
94instance Lift.LiftLocal (ExceptT tag e) where
103instance Lift.LiftLocal (ExceptT tag e) where
95− liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack
104+ liftLocal = Lift.defaultLiftLocal pack unpack
96
105
97instance Lift.LiftCatch (ExceptT tag e) where
106instance Lift.LiftCatch (ExceptT tag e) where
98− liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack
107+ liftCatch = Lift.defaultLiftCatch pack unpack
99
108
100instance Lift.LiftListen (ExceptT tag e) where
109instance Lift.LiftListen (ExceptT tag e) where
101− liftListen = Lift.defaultLiftListen NT.pack NT.unpack
110+ liftListen = Lift.defaultLiftListen pack unpack
102
111
103instance Lift.LiftPass (ExceptT tag e) where
112instance Lift.LiftPass (ExceptT tag e) where
104− liftPass = Lift.defaultLiftPass NT.pack NT.unpack
113+ liftPass = Lift.defaultLiftPass pack unpack
105
114
106instance Lift.LiftCallCC (ExceptT tag e) where
115instance Lift.LiftCallCC (ExceptT tag e) where
107− liftCallCC = Lift.defaultLiftCallCC NT.pack NT.unpack
116+ liftCallCC = Lift.defaultLiftCallCC pack unpack
108− liftCallCC' = Lift.defaultLiftCallCC NT.pack NT.unpack
117+ liftCallCC' = Lift.defaultLiftCallCC pack unpack
109
118
110instance Taggable (ExceptT tag e m) where
119instance Taggable (ExceptT tag e m) where
111 type Tag (ExceptT tag e m) = 'Just tag
120 type Tag (ExceptT tag e m) = 'Just tag
@@ -113,6 +122,8 @@ instance Taggable (ExceptT tag e m) where
113
122
114instance Tagged (ExceptT tag e m) tag where
123instance Tagged (ExceptT tag e m) tag where
115 type Untagged (ExceptT tag e m) = Trans.ExceptT e m
124 type Untagged (ExceptT tag e m) = Trans.ExceptT e m
125+ tagged _ = pack
126+ untagged _ = unpack
116
127
117-- | Constructor for computations in the exception monad transformer.
128-- | Constructor for computations in the exception monad transformer.
118exceptT :: proxy tag -> m (Either e a) -> ExceptT tag e m a
129exceptT :: proxy tag -> m (Either e a) -> ExceptT tag e m a
src/Control/Monad/Trans/Ether/Reader.hs+21−10
@@ -22,6 +22,9 @@ module Control.Monad.Trans.Ether.Reader
22 -- * Reader operations
22 -- * Reader operations
23 , ask
23 , ask
24 , local
24 , local
25+ -- * Newtype operations
26+ , pack
27+ , unpack
25 ) where
28 ) where
26
29
27import Data.Functor.Identity (Identity(..))
30import Data.Functor.Identity (Identity(..))
@@ -33,7 +36,7 @@ import Control.Monad.IO.Class (MonadIO)
33import Control.Monad.Morph (MFunctor, MMonad)
36import Control.Monad.Morph (MFunctor, MMonad)
34import Control.Ether.Tagged (Taggable(..), Tagged(..))
37import Control.Ether.Tagged (Taggable(..), Tagged(..))
35import GHC.Generics (Generic)
38import GHC.Generics (Generic)
36−import qualified Control.Newtype as NT
39+import Data.Coerce (coerce)
37
40
38import qualified Control.Monad.Base as MB
41import qualified Control.Monad.Base as MB
39import qualified Control.Monad.Trans.Control as MC
42import qualified Control.Monad.Trans.Control as MC
@@ -70,15 +73,21 @@ newtype ReaderT tag r m a = ReaderT (Trans.ReaderT r m a)
70 , Functor, Applicative, Alternative, Monad, MonadPlus
73 , Functor, Applicative, Alternative, Monad, MonadPlus
71 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )
74 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )
72
75
76+-- | Type-restricted `coerce`.
73−instance NT.Newtype (ReaderT tag r m a)
77+pack :: Trans.ReaderT r m a -> ReaderT tag r m a
78+pack = coerce
79+
80+-- | Type-restricted `coerce`.
81+unpack :: ReaderT tag r m a -> Trans.ReaderT r m a
82+unpack = coerce
74
83
75instance MB.MonadBase b m => MB.MonadBase b (ReaderT tag r m) where
84instance MB.MonadBase b m => MB.MonadBase b (ReaderT tag r m) where
76 liftBase = MB.liftBaseDefault
85 liftBase = MB.liftBaseDefault
77
86
78instance MC.MonadTransControl (ReaderT tag r) where
87instance MC.MonadTransControl (ReaderT tag r) where
79 type StT (ReaderT tag r) a = MC.StT (Trans.ReaderT r) a
88 type StT (ReaderT tag r) a = MC.StT (Trans.ReaderT r) a
80− liftWith = MC.defaultLiftWith NT.pack NT.unpack
89+ liftWith = MC.defaultLiftWith pack unpack
81− restoreT = MC.defaultRestoreT NT.pack
90+ restoreT = MC.defaultRestoreT pack
82
91
83instance MC.MonadBaseControl b m => MC.MonadBaseControl b (ReaderT tag r m) where
92instance MC.MonadBaseControl b m => MC.MonadBaseControl b (ReaderT tag r m) where
84 type StM (ReaderT tag r m) a = MC.ComposeSt (ReaderT tag r) m a
93 type StM (ReaderT tag r m) a = MC.ComposeSt (ReaderT tag r) m a
@@ -88,20 +97,20 @@ instance MC.MonadBaseControl b m => MC.MonadBaseControl b (ReaderT tag r m) wher
88type instance Lift.StT (ReaderT tag r) a = MC.StT (ReaderT tag r) a
97type instance Lift.StT (ReaderT tag r) a = MC.StT (ReaderT tag r) a
89
98
90instance Lift.LiftLocal (ReaderT tag r) where
99instance Lift.LiftLocal (ReaderT tag r) where
91− liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack
100+ liftLocal = Lift.defaultLiftLocal pack unpack
92
101
93instance Lift.LiftCatch (ReaderT tag r) where
102instance Lift.LiftCatch (ReaderT tag r) where
94− liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack
103+ liftCatch = Lift.defaultLiftCatch pack unpack
95
104
96instance Lift.LiftListen (ReaderT tag r) where
105instance Lift.LiftListen (ReaderT tag r) where
97− liftListen = Lift.defaultLiftListen NT.pack NT.unpack
106+ liftListen = Lift.defaultLiftListen pack unpack
98
107
99instance Lift.LiftPass (ReaderT tag r) where
108instance Lift.LiftPass (ReaderT tag r) where
100− liftPass = Lift.defaultLiftPass NT.pack NT.unpack
109+ liftPass = Lift.defaultLiftPass pack unpack
101
110
102instance Lift.LiftCallCC (ReaderT tag r) where
111instance Lift.LiftCallCC (ReaderT tag r) where
103− liftCallCC = Lift.defaultLiftCallCC NT.pack NT.unpack
112+ liftCallCC = Lift.defaultLiftCallCC pack unpack
104− liftCallCC' = Lift.defaultLiftCallCC' NT.pack NT.unpack
113+ liftCallCC' = Lift.defaultLiftCallCC' pack unpack
105
114
106instance Taggable (ReaderT tag r m) where
115instance Taggable (ReaderT tag r m) where
107 type Tag (ReaderT tag r m) = 'Just tag
116 type Tag (ReaderT tag r m) = 'Just tag
@@ -109,6 +118,8 @@ instance Taggable (ReaderT tag r m) where
109
118
110instance Tagged (ReaderT tag r m) tag where
119instance Tagged (ReaderT tag r m) tag where
111 type Untagged (ReaderT tag r m) = Trans.ReaderT r m
120 type Untagged (ReaderT tag r m) = Trans.ReaderT r m
121+ tagged _ = pack
122+ untagged _ = unpack
112
123
113-- | Constructor for computations in the reader monad transformer.
124-- | Constructor for computations in the reader monad transformer.
114readerT :: proxy tag -> (r -> m a) -> ReaderT tag r m a
125readerT :: proxy tag -> (r -> m a) -> ReaderT tag r m a
src/Control/Monad/Trans/Ether/State/Lazy.hs+21−10
@@ -26,6 +26,9 @@ module Control.Monad.Trans.Ether.State.Lazy
26 -- * State operations
26 -- * State operations
27 , get
27 , get
28 , put
28 , put
29+ -- * Newtype operations
30+ , pack
31+ , unpack
29 ) where
32 ) where
30
33
31import Data.Functor.Identity (Identity(..))
34import Data.Functor.Identity (Identity(..))
@@ -37,7 +40,7 @@ import Control.Monad.IO.Class (MonadIO)
37import Control.Monad.Morph (MFunctor)
40import Control.Monad.Morph (MFunctor)
38import Control.Ether.Tagged (Taggable(..), Tagged(..))
41import Control.Ether.Tagged (Taggable(..), Tagged(..))
39import GHC.Generics (Generic)
42import GHC.Generics (Generic)
40−import qualified Control.Newtype as NT
43+import Data.Coerce (coerce)
41
44
42import qualified Control.Monad.Base as MB
45import qualified Control.Monad.Base as MB
43import qualified Control.Monad.Trans.Control as MC
46import qualified Control.Monad.Trans.Control as MC
@@ -74,15 +77,21 @@ newtype StateT tag s m a = StateT (Trans.StateT s m a)
74 , Functor, Applicative, Alternative, Monad, MonadPlus
77 , Functor, Applicative, Alternative, Monad, MonadPlus
75 , MonadFix, MonadTrans, MonadIO, MFunctor )
78 , MonadFix, MonadTrans, MonadIO, MFunctor )
76
79
80+-- | Type-restricted `coerce`.
77−instance NT.Newtype (StateT tag s m a)
81+pack :: Trans.StateT s m a -> StateT tag s m a
82+pack = coerce
83+
84+-- | Type-restricted `coerce`.
85+unpack :: StateT tag s m a -> Trans.StateT s m a
86+unpack = coerce
78
87
79instance MB.MonadBase b m => MB.MonadBase b (StateT tag s m) where
88instance MB.MonadBase b m => MB.MonadBase b (StateT tag s m) where
80 liftBase = MB.liftBaseDefault
89 liftBase = MB.liftBaseDefault
81
90
82instance MC.MonadTransControl (StateT tag s) where
91instance MC.MonadTransControl (StateT tag s) where
83 type StT (StateT tag s) a = MC.StT (Trans.StateT s) a
92 type StT (StateT tag s) a = MC.StT (Trans.StateT s) a
84− liftWith = MC.defaultLiftWith NT.pack NT.unpack
93+ liftWith = MC.defaultLiftWith pack unpack
85− restoreT = MC.defaultRestoreT NT.pack
94+ restoreT = MC.defaultRestoreT pack
86
95
87instance MC.MonadBaseControl b m => MC.MonadBaseControl b (StateT tag s m) where
96instance MC.MonadBaseControl b m => MC.MonadBaseControl b (StateT tag s m) where
88 type StM (StateT tag s m) a = MC.ComposeSt (StateT tag s) m a
97 type StM (StateT tag s m) a = MC.ComposeSt (StateT tag s) m a
@@ -92,20 +101,20 @@ instance MC.MonadBaseControl b m => MC.MonadBaseControl b (StateT tag s m) where
92type instance Lift.StT (StateT tag s) a = MC.StT (StateT tag s) a
101type instance Lift.StT (StateT tag s) a = MC.StT (StateT tag s) a
93
102
94instance Lift.LiftLocal (StateT tag s) where
103instance Lift.LiftLocal (StateT tag s) where
95− liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack
104+ liftLocal = Lift.defaultLiftLocal pack unpack
96
105
97instance Lift.LiftCatch (StateT tag s) where
106instance Lift.LiftCatch (StateT tag s) where
98− liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack
107+ liftCatch = Lift.defaultLiftCatch pack unpack
99
108
100instance Lift.LiftListen (StateT tag s) where
109instance Lift.LiftListen (StateT tag s) where
101− liftListen = Lift.defaultLiftListen NT.pack NT.unpack
110+ liftListen = Lift.defaultLiftListen pack unpack
102
111
103instance Lift.LiftPass (StateT tag s) where
112instance Lift.LiftPass (StateT tag s) where
104− liftPass = Lift.defaultLiftPass NT.pack NT.unpack
113+ liftPass = Lift.defaultLiftPass pack unpack
105
114
106instance Lift.LiftCallCC (StateT tag s) where
115instance Lift.LiftCallCC (StateT tag s) where
107− liftCallCC = Lift.defaultLiftCallCC NT.pack NT.unpack
116+ liftCallCC = Lift.defaultLiftCallCC pack unpack
108− liftCallCC' = Lift.defaultLiftCallCC' NT.pack NT.unpack
117+ liftCallCC' = Lift.defaultLiftCallCC' pack unpack
109
118
110instance Taggable (StateT tag s m) where
119instance Taggable (StateT tag s m) where
111 type Tag (StateT tag s m) = 'Just tag
120 type Tag (StateT tag s m) = 'Just tag
@@ -113,6 +122,8 @@ instance Taggable (StateT tag s m) where
113
122
114instance Tagged (StateT tag s m) tag where
123instance Tagged (StateT tag s m) tag where
115 type Untagged (StateT tag s m) = Trans.StateT s m
124 type Untagged (StateT tag s m) = Trans.StateT s m
125+ tagged _ = pack
126+ untagged _ = unpack
116
127
117-- | Constructor for computations in the state monad transformer.
128-- | Constructor for computations in the state monad transformer.
118stateT :: proxy tag -> (s -> m (a, s)) -> StateT tag s m a
129stateT :: proxy tag -> (s -> m (a, s)) -> StateT tag s m a
src/Control/Monad/Trans/Ether/State/Strict.hs+21−10
@@ -26,6 +26,9 @@ module Control.Monad.Trans.Ether.State.Strict
26 -- * State operations
26 -- * State operations
27 , get
27 , get
28 , put
28 , put
29+ -- * Newtype operations
30+ , pack
31+ , unpack
29 ) where
32 ) where
30
33
31import Data.Functor.Identity (Identity(..))
34import Data.Functor.Identity (Identity(..))
@@ -37,7 +40,7 @@ import Control.Monad.IO.Class (MonadIO)
37import Control.Monad.Morph (MFunctor)
40import Control.Monad.Morph (MFunctor)
38import Control.Ether.Tagged (Taggable(..), Tagged(..))
41import Control.Ether.Tagged (Taggable(..), Tagged(..))
39import GHC.Generics (Generic)
42import GHC.Generics (Generic)
40−import qualified Control.Newtype as NT
43+import Data.Coerce (coerce)
41
44
42import qualified Control.Monad.Base as MB
45import qualified Control.Monad.Base as MB
43import qualified Control.Monad.Trans.Control as MC
46import qualified Control.Monad.Trans.Control as MC
@@ -74,15 +77,21 @@ newtype StateT tag s m a = StateT (Trans.StateT s m a)
74 , Functor, Applicative, Alternative, Monad, MonadPlus
77 , Functor, Applicative, Alternative, Monad, MonadPlus
75 , MonadFix, MonadTrans, MonadIO, MFunctor )
78 , MonadFix, MonadTrans, MonadIO, MFunctor )
76
79
80+-- | Type-restricted `coerce`.
77−instance NT.Newtype (StateT tag s m a)
81+pack :: Trans.StateT s m a -> StateT tag s m a
82+pack = coerce
83+
84+-- | Type-restricted `coerce`.
85+unpack :: StateT tag s m a -> Trans.StateT s m a
86+unpack = coerce
78
87
79instance MB.MonadBase b m => MB.MonadBase b (StateT tag s m) where
88instance MB.MonadBase b m => MB.MonadBase b (StateT tag s m) where
80 liftBase = MB.liftBaseDefault
89 liftBase = MB.liftBaseDefault
81
90
82instance MC.MonadTransControl (StateT tag s) where
91instance MC.MonadTransControl (StateT tag s) where
83 type StT (StateT tag s) a = MC.StT (Trans.StateT s) a
92 type StT (StateT tag s) a = MC.StT (Trans.StateT s) a
84− liftWith = MC.defaultLiftWith NT.pack NT.unpack
93+ liftWith = MC.defaultLiftWith pack unpack
85− restoreT = MC.defaultRestoreT NT.pack
94+ restoreT = MC.defaultRestoreT pack
86
95
87instance MC.MonadBaseControl b m => MC.MonadBaseControl b (StateT tag s m) where
96instance MC.MonadBaseControl b m => MC.MonadBaseControl b (StateT tag s m) where
88 type StM (StateT tag s m) a = MC.ComposeSt (StateT tag s) m a
97 type StM (StateT tag s m) a = MC.ComposeSt (StateT tag s) m a
@@ -92,20 +101,20 @@ instance MC.MonadBaseControl b m => MC.MonadBaseControl b (StateT tag s m) where
92type instance Lift.StT (StateT tag s) a = MC.StT (StateT tag s) a
101type instance Lift.StT (StateT tag s) a = MC.StT (StateT tag s) a
93
102
94instance Lift.LiftLocal (StateT tag s) where
103instance Lift.LiftLocal (StateT tag s) where
95− liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack
104+ liftLocal = Lift.defaultLiftLocal pack unpack
96
105
97instance Lift.LiftCatch (StateT tag s) where
106instance Lift.LiftCatch (StateT tag s) where
98− liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack
107+ liftCatch = Lift.defaultLiftCatch pack unpack
99
108
100instance Lift.LiftListen (StateT tag s) where
109instance Lift.LiftListen (StateT tag s) where
101− liftListen = Lift.defaultLiftListen NT.pack NT.unpack
110+ liftListen = Lift.defaultLiftListen pack unpack
102
111
103instance Lift.LiftPass (StateT tag s) where
112instance Lift.LiftPass (StateT tag s) where
104− liftPass = Lift.defaultLiftPass NT.pack NT.unpack
113+ liftPass = Lift.defaultLiftPass pack unpack
105
114
106instance Lift.LiftCallCC (StateT tag s) where
115instance Lift.LiftCallCC (StateT tag s) where
107− liftCallCC = Lift.defaultLiftCallCC NT.pack NT.unpack
116+ liftCallCC = Lift.defaultLiftCallCC pack unpack
108− liftCallCC' = Lift.defaultLiftCallCC' NT.pack NT.unpack
117+ liftCallCC' = Lift.defaultLiftCallCC' pack unpack
109
118
110instance Taggable (StateT tag s m) where
119instance Taggable (StateT tag s m) where
111 type Tag (StateT tag s m) = 'Just tag
120 type Tag (StateT tag s m) = 'Just tag
@@ -113,6 +122,8 @@ instance Taggable (StateT tag s m) where
113
122
114instance Tagged (StateT tag s m) tag where
123instance Tagged (StateT tag s m) tag where
115 type Untagged (StateT tag s m) = Trans.StateT s m
124 type Untagged (StateT tag s m) = Trans.StateT s m
125+ tagged _ = pack
126+ untagged _ = unpack
116
127
117-- | Constructor for computations in the state monad transformer.
128-- | Constructor for computations in the state monad transformer.
118stateT :: proxy tag -> (s -> m (a, s)) -> StateT tag s m a
129stateT :: proxy tag -> (s -> m (a, s)) -> StateT tag s m a
src/Control/Monad/Trans/Ether/Writer.hs+21−10
@@ -26,6 +26,9 @@ module Control.Monad.Trans.Ether.Writer
26 , tell
26 , tell
27 , listen
27 , listen
28 , pass
28 , pass
29+ -- * Newtype operations
30+ , pack
31+ , unpack
29 ) where
32 ) where
30
33
31#if __GLASGOW_HASKELL__ < 710
34#if __GLASGOW_HASKELL__ < 710
@@ -41,7 +44,7 @@ import Control.Monad.IO.Class (MonadIO)
41import Control.Monad.Morph (MFunctor, MMonad)
44import Control.Monad.Morph (MFunctor, MMonad)
42import Control.Ether.Tagged (Taggable(..), Tagged(..))
45import Control.Ether.Tagged (Taggable(..), Tagged(..))
43import GHC.Generics (Generic)
46import GHC.Generics (Generic)
44−import qualified Control.Newtype as NT
47+import Data.Coerce (coerce)
45
48
46import qualified Control.Monad.Base as MB
49import qualified Control.Monad.Base as MB
47import qualified Control.Monad.Trans.Control as MC
50import qualified Control.Monad.Trans.Control as MC
@@ -77,15 +80,21 @@ newtype WriterT tag w m a = WriterT (Trans.WriterT w m a)
77 , Functor, Applicative, Alternative, Monad, MonadPlus
80 , Functor, Applicative, Alternative, Monad, MonadPlus
78 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )
81 , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )
79
82
83+-- | Type-restricted `coerce`.
80−instance NT.Newtype (WriterT tag w m a)
84+pack :: Trans.WriterT w m a -> WriterT tag w m a
85+pack = coerce
86+
87+-- | Type-restricted `coerce`.
88+unpack :: WriterT tag w m a -> Trans.WriterT w m a
89+unpack = coerce
81
90
82instance (Monoid w, MB.MonadBase b m) => MB.MonadBase b (WriterT tag w m) where
91instance (Monoid w, MB.MonadBase b m) => MB.MonadBase b (WriterT tag w m) where
83 liftBase = MB.liftBaseDefault
92 liftBase = MB.liftBaseDefault
84
93
85instance Monoid w => MC.MonadTransControl (WriterT tag w) where
94instance Monoid w => MC.MonadTransControl (WriterT tag w) where
86 type StT (WriterT tag w) a = MC.StT (Trans.WriterT w) a
95 type StT (WriterT tag w) a = MC.StT (Trans.WriterT w) a
87− liftWith = MC.defaultLiftWith NT.pack NT.unpack
96+ liftWith = MC.defaultLiftWith pack unpack
88− restoreT = MC.defaultRestoreT NT.pack
97+ restoreT = MC.defaultRestoreT pack
89
98
90instance (Monoid w, MC.MonadBaseControl b m) => MC.MonadBaseControl b (WriterT tag w m) where
99instance (Monoid w, MC.MonadBaseControl b m) => MC.MonadBaseControl b (WriterT tag w m) where
91 type StM (WriterT tag w m) a = MC.ComposeSt (WriterT tag w) m a
100 type StM (WriterT tag w m) a = MC.ComposeSt (WriterT tag w) m a
@@ -95,20 +104,20 @@ instance (Monoid w, MC.MonadBaseControl b m) => MC.MonadBaseControl b (WriterT t
95type instance Lift.StT (WriterT tag w) a = MC.StT (WriterT tag w) a
104type instance Lift.StT (WriterT tag w) a = MC.StT (WriterT tag w) a
96
105
97instance Monoid w => Lift.LiftLocal (WriterT tag w) where
106instance Monoid w => Lift.LiftLocal (WriterT tag w) where
98− liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack
107+ liftLocal = Lift.defaultLiftLocal pack unpack
99
108
100instance Monoid w => Lift.LiftCatch (WriterT tag w) where
109instance Monoid w => Lift.LiftCatch (WriterT tag w) where
101− liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack
110+ liftCatch = Lift.defaultLiftCatch pack unpack
102
111
103instance Monoid w => Lift.LiftListen (WriterT tag w) where
112instance Monoid w => Lift.LiftListen (WriterT tag w) where
104− liftListen = Lift.defaultLiftListen NT.pack NT.unpack
113+ liftListen = Lift.defaultLiftListen pack unpack
105
114
106instance Monoid w' => Lift.LiftPass (WriterT tag w') where
115instance Monoid w' => Lift.LiftPass (WriterT tag w') where
107− liftPass = Lift.defaultLiftPass NT.pack NT.unpack
116+ liftPass = Lift.defaultLiftPass pack unpack
108
117
109instance Monoid w => Lift.LiftCallCC (WriterT tag w) where
118instance Monoid w => Lift.LiftCallCC (WriterT tag w) where
110− liftCallCC = Lift.defaultLiftCallCC NT.pack NT.unpack
119+ liftCallCC = Lift.defaultLiftCallCC pack unpack
111− liftCallCC' = Lift.defaultLiftCallCC NT.pack NT.unpack
120+ liftCallCC' = Lift.defaultLiftCallCC pack unpack
112
121
113instance Taggable (WriterT tag w m) where
122instance Taggable (WriterT tag w m) where
114 type Tag (WriterT tag w m) = 'Just tag
123 type Tag (WriterT tag w m) = 'Just tag
@@ -116,6 +125,8 @@ instance Taggable (WriterT tag w m) where
116
125
117instance Tagged (WriterT tag w m) tag where
126instance Tagged (WriterT tag w m) tag where
118 type Untagged (WriterT tag w m) = Trans.WriterT w m
127 type Untagged (WriterT tag w m) = Trans.WriterT w m
128+ tagged _ = pack
129+ untagged _ = unpack
119
130
120-- | Constructor for computations in the writer monad transformer.
131-- | Constructor for computations in the writer monad transformer.
121writerT :: proxy tag -> m (a, w) -> WriterT tag w m a
132writerT :: proxy tag -> m (a, w) -> WriterT tag w m a
stack-ghc-7.8.4.yamlnew file+34
@@ -0,0 +1,34 @@
1+flags:
2+ text:
3+ integer-simple: false
4+ QuickCheck:
5+ base4point8: false
6+packages:
7+- '.'
8+extra-deps:
9+- QuickCheck-2.8.1
10+- ansi-terminal-0.6.2.3
11+- ansi-wl-pprint-0.6.7.3
12+- async-2.0.2
13+- clock-0.5.1
14+- mmorph-1.0.4
15+- monad-control-1.0.0.4
16+- mtl-2.2.1
17+- optparse-applicative-0.12.0.0
18+- parsec-3.1.9
19+- primitive-0.6.1.0
20+- random-1.1
21+- regex-base-0.93.2
22+- regex-tdfa-rc-1.1.8.3
23+- stm-2.4.4
24+- tagged-0.8.1
25+- tasty-0.11.0.1
26+- tasty-quickcheck-0.8.4
27+- text-1.2.1.3
28+- tf-random-0.5
29+- transformers-0.4.3.0
30+- transformers-base-0.4.4
31+- transformers-compat-0.4.0.4
32+- transformers-lift-0.1.0.0
33+- unbounded-delays-0.1.0.9
34+resolver: ghc-7.8.4