git.iko.soy/typeable/ether
on master help sign in
Derive Tagged instances with Generics
267a7faIndex Int
ether.cabal+1
compare with master
unifiedsplit
@@ -43,6 +43,7 @@ library
43 , transformers >=0.4.0.3
43 , transformers >=0.4.0.3
44 , mtl >=2.2.1
44 , mtl >=2.2.1
45 , template-haskell >=2.10
45 , template-haskell >=2.10
46+ , newtype-generics >=0.4.1
46
47
47 hs-source-dirs: src
48 hs-source-dirs: src
48 default-language: Haskell2010
49 default-language: Haskell2010
src/Control/Ether/Tags.hs+15
@@ -3,9 +3,12 @@
3{-# LANGUAGE PolyKinds #-}
3{-# LANGUAGE PolyKinds #-}
4{-# LANGUAGE ConstraintKinds #-}
4{-# LANGUAGE ConstraintKinds #-}
5{-# LANGUAGE TypeOperators #-}
5{-# LANGUAGE TypeOperators #-}
6+{-# LANGUAGE FlexibleInstances #-}
7+{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE UndecidableInstances #-}
8{-# LANGUAGE UndecidableInstances #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
9{-# LANGUAGE MultiParamTypeClasses #-}
8{-# LANGUAGE FunctionalDependencies #-}
10{-# LANGUAGE FunctionalDependencies #-}
11+{-# LANGUAGE DefaultSignatures #-}
9module Control.Ether.Tags
12module Control.Ether.Tags
10 ( Taggable(..)
13 ( Taggable(..)
11 , Tagged(..)
14 , Tagged(..)
@@ -22,6 +25,7 @@ import qualified Control.Monad.ST.Strict as Strict (ST)
22import qualified Control.Monad.ST.Lazy as Lazy (ST)
25import qualified Control.Monad.ST.Lazy as Lazy (ST)
23import GHC.Conc (STM)
26import GHC.Conc (STM)
24import GHC.Exts (Constraint)
27import GHC.Exts (Constraint)
28+import qualified Control.Newtype as NT
25
29
26import qualified Control.Monad.Trans.Cont as Trans
30import qualified Control.Monad.Trans.Cont as Trans
27import qualified Control.Monad.Trans.Except as Trans
31import qualified Control.Monad.Trans.Except as Trans
@@ -137,6 +141,17 @@ type Tags (m :: * -> *) = MaybeToList (Tag m) ++ MaybeToList (MaybeMapTag (Inner
137-- | The 'Tagged' type class establishes a relationship between a tagged
141-- | The 'Tagged' type class establishes a relationship between a tagged
138-- monad transformer and its untagged counterpart.
142-- monad transformer and its untagged counterpart.
139class (Taggable m, Tag m ~ 'Just tag) => Tagged m tag | m -> tag where
143class (Taggable m, Tag m ~ 'Just tag) => Tagged m tag | m -> tag where
144+
140 type Untagged m :: * -> *
145 type Untagged m :: * -> *
146+
141 tagged :: proxy tag -> Untagged m a -> m a
147 tagged :: proxy tag -> Untagged m a -> m a
148+ default tagged
149+ :: (NT.Newtype (m a), NT.O (m a) ~ Untagged m a)
150+ => proxy tag -> Untagged m a -> m a
151+ tagged _ = NT.pack
152+
142 untagged :: proxy tag -> m a -> Untagged m a
153 untagged :: proxy tag -> m a -> Untagged m a
154+ default untagged
155+ :: (NT.Newtype (m a), NT.O (m a) ~ Untagged m a)
156+ => proxy tag -> m a -> Untagged m a
157+ untagged _ = NT.unpack
src/Control/Monad/Trans/Ether/Except.hs+7−3
@@ -1,3 +1,4 @@
1+{-# LANGUAGE DeriveGeneric #-}
1{-# LANGUAGE MultiParamTypeClasses #-}
2{-# LANGUAGE MultiParamTypeClasses #-}
2{-# LANGUAGE TypeFamilies #-}
3{-# LANGUAGE TypeFamilies #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FlexibleInstances #-}
@@ -37,6 +38,8 @@ import Control.Monad.Trans.Class (MonadTrans, lift)
37import Control.Monad.IO.Class (MonadIO)
38import Control.Monad.IO.Class (MonadIO)
38import Control.Ether.Tags (Taggable(..), Tagged(..))
39import Control.Ether.Tags (Taggable(..), Tagged(..))
39import qualified Control.Ether.Util as Util
40import qualified Control.Ether.Util as Util
41+import GHC.Generics (Generic)
42+import qualified Control.Newtype as NT
40
43
41import qualified Control.Monad.Signatures as Sig
44import qualified Control.Monad.Signatures as Sig
42import qualified Control.Monad.Trans.Except as Trans
45import qualified Control.Monad.Trans.Except as Trans
@@ -66,17 +69,18 @@ runExcept t = Trans.runExcept . untagged t
66-- the first exception.
69-- the first exception.
67
70
68newtype ExceptT tag e m a = ExceptT (Trans.ExceptT e m a)
71newtype ExceptT tag e m a = ExceptT (Trans.ExceptT e m a)
72+ deriving ( Generic
69− deriving ( Functor, Applicative, Alternative, Monad, MonadPlus
73+ , Functor, Applicative, Alternative, Monad, MonadPlus
70 , MonadFix, MonadTrans, MonadIO )
74 , MonadFix, MonadTrans, MonadIO )
71
75
76+instance NT.Newtype (ExceptT tag e m a)
77+
72instance Taggable (ExceptT tag e m) where
78instance Taggable (ExceptT tag e m) where
73 type Tag (ExceptT tag e m) = 'Just tag
79 type Tag (ExceptT tag e m) = 'Just tag
74 type Inner (ExceptT tag e m) = 'Just m
80 type Inner (ExceptT tag e m) = 'Just m
75
81
76instance Tagged (ExceptT tag e m) tag where
82instance Tagged (ExceptT tag e m) tag where
77 type Untagged (ExceptT tag e m) = Trans.ExceptT e m
83 type Untagged (ExceptT tag e m) = Trans.ExceptT e m
78− tagged _ = ExceptT
79− untagged _ (ExceptT a) = a
80
84
81-- | Constructor for computations in the exception monad transformer.
85-- | Constructor for computations in the exception monad transformer.
82exceptT :: proxy tag -> m (Either e a) -> ExceptT tag e m a
86exceptT :: proxy tag -> m (Either e a) -> ExceptT tag e m a
src/Control/Monad/Trans/Ether/Reader.hs+7−3
@@ -1,3 +1,4 @@
1+{-# LANGUAGE DeriveGeneric #-}
1{-# LANGUAGE MultiParamTypeClasses #-}
2{-# LANGUAGE MultiParamTypeClasses #-}
2{-# LANGUAGE TypeFamilies #-}
3{-# LANGUAGE TypeFamilies #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FlexibleInstances #-}
@@ -35,6 +36,8 @@ import Control.Monad.Fix (MonadFix)
35import Control.Monad.Trans.Class (MonadTrans, lift)
36import Control.Monad.Trans.Class (MonadTrans, lift)
36import Control.Monad.IO.Class (MonadIO)
37import Control.Monad.IO.Class (MonadIO)
37import Control.Ether.Tags (Taggable(..), Tagged(..))
38import Control.Ether.Tags (Taggable(..), Tagged(..))
39+import GHC.Generics (Generic)
40+import qualified Control.Newtype as NT
38
41
39import qualified Control.Monad.Signatures as Sig
42import qualified Control.Monad.Signatures as Sig
40import qualified Control.Monad.Trans.Reader as Trans
43import qualified Control.Monad.Trans.Reader as Trans
@@ -59,17 +62,18 @@ type Reader tag r = ReaderT tag r Identity
59-- The 'return' function ignores the environment, while '>>=' passes
62-- The 'return' function ignores the environment, while '>>=' passes
60-- the inherited environment to both subcomputations.
63-- the inherited environment to both subcomputations.
61newtype ReaderT tag r m a = ReaderT (Trans.ReaderT r m a)
64newtype ReaderT tag r m a = ReaderT (Trans.ReaderT r m a)
65+ deriving ( Generic
62− deriving ( Functor, Applicative, Alternative, Monad, MonadPlus
66+ , Functor, Applicative, Alternative, Monad, MonadPlus
63 , MonadFix, MonadTrans, MonadIO )
67 , MonadFix, MonadTrans, MonadIO )
64
68
69+instance NT.Newtype (ReaderT tag r m a)
70+
65instance Taggable (ReaderT tag r m) where
71instance Taggable (ReaderT tag r m) where
66 type Tag (ReaderT tag r m) = 'Just tag
72 type Tag (ReaderT tag r m) = 'Just tag
67 type Inner (ReaderT tag r m) = 'Just m
73 type Inner (ReaderT tag r m) = 'Just m
68
74
69instance Tagged (ReaderT tag r m) tag where
75instance Tagged (ReaderT tag r m) tag where
70 type Untagged (ReaderT tag r m) = Trans.ReaderT r m
76 type Untagged (ReaderT tag r m) = Trans.ReaderT r m
71− tagged _ = ReaderT
72− untagged _ (ReaderT a) = a
73
77
74-- | Constructor for computations in the reader monad transformer.
78-- | Constructor for computations in the reader monad transformer.
75readerT :: proxy tag -> (r -> m a) -> ReaderT tag r m a
79readerT :: proxy tag -> (r -> m a) -> ReaderT tag r m a
src/Control/Monad/Trans/Ether/State.hs+6−3
@@ -1,3 +1,4 @@
1+{-# LANGUAGE DeriveGeneric #-}
1{-# LANGUAGE MultiParamTypeClasses #-}
2{-# LANGUAGE MultiParamTypeClasses #-}
2{-# LANGUAGE TypeFamilies #-}
3{-# LANGUAGE TypeFamilies #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FlexibleInstances #-}
@@ -40,6 +41,8 @@ import Control.Monad.Fix (MonadFix)
40import Control.Monad.Trans.Class (MonadTrans, lift)
41import Control.Monad.Trans.Class (MonadTrans, lift)
41import Control.Monad.IO.Class (MonadIO)
42import Control.Monad.IO.Class (MonadIO)
42import Control.Ether.Tags (Taggable(..), Tagged(..))
43import Control.Ether.Tags (Taggable(..), Tagged(..))
44+import GHC.Generics (Generic)
45+import qualified Control.Newtype as NT
43
46
44import qualified Control.Monad.Signatures as Sig
47import qualified Control.Monad.Signatures as Sig
45import qualified Control.Monad.Trans.State.Lazy as Trans
48import qualified Control.Monad.Trans.State.Lazy as Trans
@@ -66,9 +69,11 @@ type State tag r = StateT tag r Identity
66-- the final state of the first computation as the initial state of
69-- the final state of the first computation as the initial state of
67-- the second.
70-- the second.
68newtype StateT tag s m a = StateT (Trans.StateT s m a)
71newtype StateT tag s m a = StateT (Trans.StateT s m a)
72+ deriving ( Generic
69− deriving ( Functor, Applicative, Alternative, Monad, MonadPlus
73+ , Functor, Applicative, Alternative, Monad, MonadPlus
70 , MonadFix, MonadTrans, MonadIO )
74 , MonadFix, MonadTrans, MonadIO )
71
75
76+instance NT.Newtype (StateT tag s m a)
72
77
73instance Taggable (StateT tag s m) where
78instance Taggable (StateT tag s m) where
74 type Tag (StateT tag s m) = 'Just tag
79 type Tag (StateT tag s m) = 'Just tag
@@ -76,8 +81,6 @@ instance Taggable (StateT tag s m) where
76
81
77instance Tagged (StateT tag s m) tag where
82instance Tagged (StateT tag s m) tag where
78 type Untagged (StateT tag s m) = Trans.StateT s m
83 type Untagged (StateT tag s m) = Trans.StateT s m
79− tagged _ = StateT
80− untagged _ (StateT a) = a
81
84
82-- | Constructor for computations in the state monad transformer.
85-- | Constructor for computations in the state monad transformer.
83stateT :: proxy tag -> (s -> m (a, s)) -> StateT tag s m a
86stateT :: proxy tag -> (s -> m (a, s)) -> StateT tag s m a