267a7fa · typeable/ether

git.iko.soy/typeable/ether

Derive Tagged instances with Generics

commit267a7fa7ac5b41b51496e452fbe7ed3f1fe6e7cb authorIndex Int <vlad.z.4096@gmail.com> dateFri 12 Jun 2015, 22:04 (11 years ago) parenta38910f

5 files changed+36−9

compare with master

unifiedsplit

ether.cabal+1 src/Control/Ether/Tags.hs+15 src/Control/Monad/Trans/Ether/Except.hs+7−3 src/Control/Monad/Trans/Ether/Reader.hs+7−3 src/Control/Monad/Trans/Ether/State.hs+6−3

ether.cabal+1

@@ -43,6 +43,7 @@ library

4343 , transformers >=0.4.0.3

4444 , mtl >=2.2.1

4545 , template-haskell >=2.10

46+ , newtype-generics >=0.4.1

4647

4748 hs-source-dirs: src

4849 default-language: Haskell2010

src/Control/Ether/Tags.hs+15

@@ -3,9 +3,12 @@

33{-# LANGUAGE PolyKinds #-}

44{-# LANGUAGE ConstraintKinds #-}

55{-# LANGUAGE TypeOperators #-}

6+{-# LANGUAGE FlexibleInstances #-}

7+{-# LANGUAGE FlexibleContexts #-}

68{-# LANGUAGE UndecidableInstances #-}

79{-# LANGUAGE MultiParamTypeClasses #-}

810{-# LANGUAGE FunctionalDependencies #-}

11+{-# LANGUAGE DefaultSignatures #-}

912module Control.Ether.Tags

1013 ( Taggable(..)

1114 , Tagged(..)

@@ -22,6 +25,7 @@ import qualified Control.Monad.ST.Strict as Strict (ST)

2225import qualified Control.Monad.ST.Lazy as Lazy (ST)

2326import GHC.Conc (STM)

2427import GHC.Exts (Constraint)

28+import qualified Control.Newtype as NT

2529

2630import qualified Control.Monad.Trans.Cont as Trans

2731import qualified Control.Monad.Trans.Except as Trans

@@ -137,6 +141,17 @@ type Tags (m :: * -> *) = MaybeToList (Tag m) ++ MaybeToList (MaybeMapTag (Inner

137141-- | The 'Tagged' type class establishes a relationship between a tagged

138142-- monad transformer and its untagged counterpart.

139143class (Taggable m, Tag m ~ 'Just tag) => Tagged m tag | m -> tag where

144+

140145 type Untagged m :: * -> *

146+

141147 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+

142153 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 #-}

12{-# LANGUAGE MultiParamTypeClasses #-}

23{-# LANGUAGE TypeFamilies #-}

34{-# LANGUAGE FlexibleInstances #-}

@@ -37,6 +38,8 @@ import Control.Monad.Trans.Class (MonadTrans, lift)

3738import Control.Monad.IO.Class (MonadIO)

3839import Control.Ether.Tags (Taggable(..), Tagged(..))

3940import qualified Control.Ether.Util as Util

41+import GHC.Generics (Generic)

42+import qualified Control.Newtype as NT

4043

4144import qualified Control.Monad.Signatures as Sig

4245import qualified Control.Monad.Trans.Except as Trans

@@ -66,17 +69,18 @@ runExcept t = Trans.runExcept . untagged t

6669-- the first exception.

6770

6871newtype ExceptT tag e m a = ExceptT (Trans.ExceptT e m a)

69− deriving ( Functor, Applicative, Alternative, Monad, MonadPlus

72+ deriving ( Generic

73+ , Functor, Applicative, Alternative, Monad, MonadPlus

7074 , MonadFix, MonadTrans, MonadIO )

7175

76+instance NT.Newtype (ExceptT tag e m a)

77+

7278instance Taggable (ExceptT tag e m) where

7379 type Tag (ExceptT tag e m) = 'Just tag

7480 type Inner (ExceptT tag e m) = 'Just m

7581

7682instance Tagged (ExceptT tag e m) tag where

7783 type Untagged (ExceptT tag e m) = Trans.ExceptT e m

78− tagged _ = ExceptT

79− untagged _ (ExceptT a) = a

8084

8185-- | Constructor for computations in the exception monad transformer.

8286exceptT :: 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 #-}

12{-# LANGUAGE MultiParamTypeClasses #-}

23{-# LANGUAGE TypeFamilies #-}

34{-# LANGUAGE FlexibleInstances #-}

@@ -35,6 +36,8 @@ import Control.Monad.Fix (MonadFix)

3536import Control.Monad.Trans.Class (MonadTrans, lift)

3637import Control.Monad.IO.Class (MonadIO)

3738import Control.Ether.Tags (Taggable(..), Tagged(..))

39+import GHC.Generics (Generic)

40+import qualified Control.Newtype as NT

3841

3942import qualified Control.Monad.Signatures as Sig

4043import qualified Control.Monad.Trans.Reader as Trans

@@ -59,17 +62,18 @@ type Reader tag r = ReaderT tag r Identity

5962-- The 'return' function ignores the environment, while '>>=' passes

6063-- the inherited environment to both subcomputations.

6164newtype ReaderT tag r m a = ReaderT (Trans.ReaderT r m a)

62− deriving ( Functor, Applicative, Alternative, Monad, MonadPlus

65+ deriving ( Generic

66+ , Functor, Applicative, Alternative, Monad, MonadPlus

6367 , MonadFix, MonadTrans, MonadIO )

6468

69+instance NT.Newtype (ReaderT tag r m a)

70+

6571instance Taggable (ReaderT tag r m) where

6672 type Tag (ReaderT tag r m) = 'Just tag

6773 type Inner (ReaderT tag r m) = 'Just m

6874

6975instance Tagged (ReaderT tag r m) tag where

7076 type Untagged (ReaderT tag r m) = Trans.ReaderT r m

71− tagged _ = ReaderT

72− untagged _ (ReaderT a) = a

7377

7478-- | Constructor for computations in the reader monad transformer.

7579readerT :: 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 #-}

12{-# LANGUAGE MultiParamTypeClasses #-}

23{-# LANGUAGE TypeFamilies #-}

34{-# LANGUAGE FlexibleInstances #-}

@@ -40,6 +41,8 @@ import Control.Monad.Fix (MonadFix)

4041import Control.Monad.Trans.Class (MonadTrans, lift)

4142import Control.Monad.IO.Class (MonadIO)

4243import Control.Ether.Tags (Taggable(..), Tagged(..))

44+import GHC.Generics (Generic)

45+import qualified Control.Newtype as NT

4346

4447import qualified Control.Monad.Signatures as Sig

4548import qualified Control.Monad.Trans.State.Lazy as Trans

@@ -66,9 +69,11 @@ type State tag r = StateT tag r Identity

6669-- the final state of the first computation as the initial state of

6770-- the second.

6871newtype StateT tag s m a = StateT (Trans.StateT s m a)

69− deriving ( Functor, Applicative, Alternative, Monad, MonadPlus

72+ deriving ( Generic

73+ , Functor, Applicative, Alternative, Monad, MonadPlus

7074 , MonadFix, MonadTrans, MonadIO )

7175

76+instance NT.Newtype (StateT tag s m a)

7277

7378instance Taggable (StateT tag s m) where

7479 type Tag (StateT tag s m) = 'Just tag

@@ -76,8 +81,6 @@ instance Taggable (StateT tag s m) where

7681

7782instance Tagged (StateT tag s m) tag where

7883 type Untagged (StateT tag s m) = Trans.StateT s m

79− tagged _ = StateT

80− untagged _ (StateT a) = a

8184

8285-- | Constructor for computations in the state monad transformer.

8386stateT :: proxy tag -> (s -> m (a, s)) -> StateT tag s m a