tagged-transformer 0.2 → 0.3

raw patch · 3 files changed

+286/−192 lines, 3 filesdep +arraydep +mtldep +reflectiondep −functor-applydep ~comonaddep ~comonad-transformersdep ~contravariantPVP ok

version bump matches the API change (PVP)

Dependencies added: array, mtl, reflection, semigroupoids, tagged

Dependencies removed: functor-apply

Dependency ranges changed: comonad, comonad-transformers, contravariant, distributive, transformers

API changes (from Hackage documentation)

Files

• Data/Functor/Trans/Tagged.hs +0/−182
• src/Data/Functor/Trans/Tagged.hs +271/−0
• tagged-transformer.cabal +15/−10

@@ -1,182 +0,0 @@-------------------------------------------------------------------------------- |--- Module     : Data.Functor.Trans.Tagged--- Copyright  : 2011 Edward Kmett--- License    : BSD3------ Maintainer  : Edward Kmett <ekmett@gmail.com>--- Stability   : experimental--- Portability : portable-------------------------------------------------------------------------------------module Data.Functor.Trans.Tagged-  ( -  -- * Tagged values-    Tagged-  , TaggedT(..)-  , retag-  , tag, tagSelf-  , untag, untagSelf-  , asTaggedTypeOf-  ) where--import Prelude hiding (foldr, foldl, mapM, sequence, foldr1, foldl1)-import Control.Applicative-import Control.Monad (liftM, MonadPlus(..))-import Control.Monad.Fix-import Control.Monad.Trans.Class-import Control.Comonad.Trans.Class-import Control.Comonad.Hoist.Class-import Control.Comonad-import Data.Traversable (Traversable(..))-import Data.Foldable (Foldable(..))-import Data.Distributive-import Data.Functor.Bind-import Data.Functor.Plus-import Data.Functor.Identity-import Data.Functor.Contravariant---- | A @'Tagged' s b@ value is a value @b@ with an attached phantom type @s@.--- This can be used in place of the more traditional but less safe idiom of--- passing in an undefined value with the type, because unlike an @(s -> b)@, --- a @'Tagged' s b@ can't try to use the argument @s@ as a real value.------ Moreover, you don't have to rely on the compiler to inline away the extra--- argument, because the newtype is "free"--newtype TaggedT s m b = TagT { untagT :: m b } -  deriving ( Eq, Ord, Read, Show )--type Tagged s = TaggedT s Identity--instance Functor m => Functor (TaggedT s m) where -  fmap f (TagT x) = TagT (fmap f x)-  b <$ (TagT x) = TagT (b <$ x)-  {-# INLINE fmap #-}--instance Contravariant m => Contravariant (TaggedT s m) where-  contramap f (TagT x) = TagT (contramap f x)--instance Apply m => Apply (TaggedT s m) where-  TagT f <.> TagT x = TagT (f <.> x)-  {-# INLINE (<.>) #-}-  TagT f  .> TagT x = TagT (f  .> x)-  {-# INLINE ( .>) #-}-  TagT f <.  TagT x = TagT (f <.  x)-  {-# INLINE (<. ) #-}-  -instance Alt m => Alt (TaggedT s m) where-  TagT a <!> TagT b = TagT (a <!> b)--instance Plus m => Plus (TaggedT s m) where-  zero = TagT zero--instance Applicative m => Applicative (TaggedT s m) where-  pure = TagT . pure-  {-# INLINE pure #-}-  TagT f <*> TagT x = TagT (f <*> x)-  {-# INLINE (<*>) #-}-  TagT f  *> TagT x = TagT (f  *> x)-  {-# INLINE ( *>) #-}-  TagT f <*  TagT x = TagT (f <*  x)-  {-# INLINE (<* ) #-}--instance Alternative m => Alternative (TaggedT s m) where-  empty = TagT empty-  TagT a <|> TagT b = TagT (a <|> b)--instance Bind m => Bind (TaggedT s m) where-  TagT m >>- k = TagT (m >>- untagT . k)--instance Monad m => Monad (TaggedT s m) where-  return = TagT . return-  {-# INLINE return #-}-  TagT m >>= k = TagT (m >>= untagT . k)-  {-# INLINE (>>=) #-}-  TagT m >> TagT n = TagT (m >> n)-  {-# INLINE (>>) #-}--instance MonadPlus m => MonadPlus (TaggedT s m) where-  mzero = TagT mzero-  mplus (TagT a) (TagT b) = TagT (mplus a b)--instance MonadFix m => MonadFix (TaggedT s m) where-  mfix f = TagT $ mfix (untagT . f) --instance MonadTrans (TaggedT s) where-  lift = TagT--instance Foldable f => Foldable (TaggedT s f) where-  foldMap f (TagT x) = foldMap f x-  {-# INLINE foldMap #-}-  fold (TagT x) = fold x-  {-# INLINE fold #-}-  foldr f z (TagT x) = foldr f z x-  {-# INLINE foldr #-}-  foldl f z (TagT x) = foldl f z x-  {-# INLINE foldl #-}-  foldl1 f (TagT x) = foldl1 f x -  {-# INLINE foldl1 #-}-  foldr1 f (TagT x) = foldr1 f x-  {-# INLINE foldr1 #-}--instance Traversable f => Traversable (TaggedT s f) where-  traverse f (TagT x) = TagT <$> traverse f x-  {-# INLINE traverse #-}-  sequenceA (TagT x) = TagT <$> sequenceA x-  {-# INLINE sequenceA #-}-  mapM f (TagT x) = liftM TagT (mapM f x)-  {-# INLINE mapM #-}-  sequence (TagT x) = liftM TagT (sequence x)-  {-# INLINE sequence #-}--instance Distributive f => Distributive (TaggedT s f) where-  distribute = TagT . distribute . fmap untagT--instance Extend f => Extend (TaggedT s f) where-  extend f (TagT w) = TagT (extend (f . TagT) w)--instance Comonad w => Comonad (TaggedT s w) where-  extract (TagT w) = extract w-  -instance ComonadTrans (TaggedT s) where-  lower (TagT w) = w--instance ComonadHoist (TaggedT s) where-  cohoist = TagT . Identity . extract . untagT---- | Some times you need to change the tag you have lying around.--- Idiomatic usage is to make a new combinator for the relationship between the--- tags that you want to enforce, and define that combinator using 'retag'.------ > data Succ n--- > retagSucc :: Tagged n a -> Tagged (Succ n) a--- > retagSucc = retag-retag :: TaggedT s m b -> TaggedT t m b-retag = TagT . untagT-{-# INLINE retag #-}---- | 'asTaggedTypeOf' is a type-restricted version of 'const'. It is usually used as an infix operator, and its typing forces its first argument (which is usually overloaded) to have the same type as the tag of the second.-asTaggedTypeOf :: s -> TaggedT s m b -> s-asTaggedTypeOf = const-{-# INLINE asTaggedTypeOf #-}--tag :: b -> Tagged s b-tag = TagT . Identity-{-# INLINE tag #-}--untag :: Tagged s b -> b-untag = runIdentity . untagT-{-# INLINE untag #-}---- | Tag a value with its own type.-tagSelf :: a -> Tagged a a-tagSelf = tag-{-# INLINE tagSelf #-}---- | 'untagSelf' is a type-restricted version of 'untag'.-untagSelf :: Tagged a a -> a-untagSelf = untag-{-# INLINE untagSelf #-}-

@@ -0,0 +1,271 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}+----------------------------------------------------------------------------+-- |+-- Module     : Data.Functor.Trans.Tagged+-- Copyright  : 2011 Edward Kmett+-- License    : BSD3+--+-- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Stability   : experimental+-- Portability : portable+--+-------------------------------------------------------------------------------++module Data.Functor.Trans.Tagged+  (+  -- * Tagged values+    TaggedT(..)+  , tag, self, selfM, untag+  , retag+  , mapTaggedT+  , reflected, reflectedM+  , asTaggedTypeOf+  ) where++import Prelude hiding (foldr, foldl, mapM, sequence, foldr1, foldl1)+import Control.Applicative (Alternative(..), Applicative(..), (<$), (<$>))+import Control.Monad (liftM, MonadPlus(..))+import Control.Monad.Fix (MonadFix(..))+import Control.Monad.Trans (MonadIO(..), MonadTrans(..))+import Control.Monad.Reader (MonadReader(..))+import Control.Monad.Writer (MonadWriter(..))+import Control.Monad.State (MonadState(..))+import Control.Monad.Cont (MonadCont(..))+import Control.Comonad.Trans.Class (ComonadTrans(..))+import Control.Comonad.Hoist.Class (ComonadHoist(..))+import Control.Comonad (Comonad(..))+import Data.Traversable (Traversable(..))+import Data.Foldable (Foldable(..))+import Data.Distributive (Distributive(..))+import Data.Functor.Bind (Apply(..), Bind(..))+import Data.Functor.Extend (Extend(..))+import Data.Functor.Plus (Alt(..), Plus(..))+import Data.Functor.Identity (Identity(..))+import Data.Functor.Contravariant (Contravariant(..))+import Data.Proxy (Proxy(..))+import Data.Reflection (Reifies(..))++-- | A @'Tagged' s b@ value is a value @b@ with an attached phantom type @s@.+-- This can be used in place of the more traditional but less safe idiom of+-- passing in an undefined value with the type, because unlike an @(s -> b)@,+-- a @'Tagged' s b@ can't try to use the argument @s@ as a real value.+--+-- Moreover, you don't have to rely on the compiler to inline away the extra+-- argument, because the newtype is "free"++newtype TaggedT s m b = TagT { untagT :: m b }+  deriving ( Eq, Ord, Read, Show )+++instance Functor m => Functor (TaggedT s m) where+  fmap f (TagT x) = TagT (fmap f x)+  {-# INLINE fmap #-}+  b <$ (TagT x) = TagT (b <$ x)+  {-# INLINE (<$) #-}++instance Contravariant m => Contravariant (TaggedT s m) where+  contramap f (TagT x) = TagT (contramap f x)+  {-# INLINE contramap #-}++instance Apply m => Apply (TaggedT s m) where+  TagT f <.> TagT x = TagT (f <.> x)+  {-# INLINE (<.>) #-}+  TagT f  .> TagT x = TagT (f  .> x)+  {-# INLINE ( .>) #-}+  TagT f <.  TagT x = TagT (f <.  x)+  {-# INLINE (<. ) #-}++instance Applicative m => Applicative (TaggedT s m) where+  pure = TagT . pure+  {-# INLINE pure #-}+  TagT f <*> TagT x = TagT (f <*> x)+  {-# INLINE (<*>) #-}+  TagT f  *> TagT x = TagT (f  *> x)+  {-# INLINE ( *>) #-}+  TagT f <*  TagT x = TagT (f <*  x)+  {-# INLINE (<* ) #-}++instance Bind m => Bind (TaggedT s m) where+  TagT m >>- k = TagT (m >>- untagT . k)+  {-# INLINE (>>-) #-}++instance Monad m => Monad (TaggedT s m) where+  return = TagT . return+  {-# INLINE return #-}+  TagT m >>= k = TagT (m >>= untagT . k)+  {-# INLINE (>>=) #-}+  TagT m >> TagT n = TagT (m >> n)+  {-# INLINE (>>) #-}+++instance Alt m => Alt (TaggedT s m) where+  TagT a <!> TagT b = TagT (a <!> b)+  {-# INLINE (<!>) #-}++instance Alternative m => Alternative (TaggedT s m) where+  empty = TagT empty+  {-# INLINE empty #-}+  TagT a <|> TagT b = TagT (a <|> b)+  {-# INLINE (<|>) #-}++instance Plus m => Plus (TaggedT s m) where+  zero = TagT zero+  {-# INLINE zero #-}++instance MonadPlus m => MonadPlus (TaggedT s m) where+  mzero = TagT mzero+  {-# INLINE mzero #-}+  mplus (TagT a) (TagT b) = TagT (mplus a b)+  {-# INLINE mplus #-}+++instance MonadFix m => MonadFix (TaggedT s m) where+  mfix f = TagT $ mfix (untagT . f)+  {-# INLINE mfix #-}+++instance MonadTrans (TaggedT s) where+  lift = TagT+  {-# INLINE lift #-}++instance MonadIO m => MonadIO (TaggedT s m) where+  liftIO = lift . liftIO+  {-# INLINE liftIO #-}++instance MonadWriter w m => MonadWriter w (TaggedT s m) where+  writer = lift . writer+  {-# INLINE writer #-}+  tell = lift . tell+  {-# INLINE tell #-}+  listen = lift . listen . untag+  {-# INLINE listen #-}+  pass = lift . pass . untag+  {-# INLINE pass #-}++instance MonadReader r m => MonadReader r (TaggedT s m) where+  ask = lift ask+  {-# INLINE ask #-}+  local f = lift . local f . untag+  {-# INLINE local #-}+  reader = lift . reader+  {-# INLINE reader #-}++instance MonadState t m => MonadState t (TaggedT s m) where+  get = lift get+  {-# INLINE get #-}+  put = lift . put+  {-# INLINE put #-}+  state = lift . state+  {-# INLINE state #-}++instance MonadCont m => MonadCont (TaggedT s m) where+  callCC f = lift . callCC $ \k -> untag (f (tag . k))+  {-# INLINE callCC #-}+++instance Foldable f => Foldable (TaggedT s f) where+  foldMap f (TagT x) = foldMap f x+  {-# INLINE foldMap #-}+  fold (TagT x) = fold x+  {-# INLINE fold #-}+  foldr f z (TagT x) = foldr f z x+  {-# INLINE foldr #-}+  foldl f z (TagT x) = foldl f z x+  {-# INLINE foldl #-}+  foldl1 f (TagT x) = foldl1 f x+  {-# INLINE foldl1 #-}+  foldr1 f (TagT x) = foldr1 f x+  {-# INLINE foldr1 #-}++instance Traversable f => Traversable (TaggedT s f) where+  traverse f (TagT x) = TagT <$> traverse f x+  {-# INLINE traverse #-}+  sequenceA (TagT x) = TagT <$> sequenceA x+  {-# INLINE sequenceA #-}+  mapM f (TagT x) = liftM TagT (mapM f x)+  {-# INLINE mapM #-}+  sequence (TagT x) = liftM TagT (sequence x)+  {-# INLINE sequence #-}++instance Distributive f => Distributive (TaggedT s f) where+  distribute = TagT . distribute . fmap untagT+  {-# INLINE distribute #-}+++instance Extend f => Extend (TaggedT s f) where+  extended f (TagT w) = TagT (extended (f . TagT) w)+  {-# INLINE extended #-}++instance Comonad w => Comonad (TaggedT s w) where+  extract (TagT w) = extract w+  {-# INLINE extract #-}+++instance ComonadTrans (TaggedT s) where+  lower (TagT w) = w+  {-# INLINE lower #-}+++instance ComonadHoist (TaggedT s) where+  cohoist = TagT . Identity . extract . untagT+  {-# INLINE cohoist #-}+++-- | Easier to type alias for 'TagT'+tag :: m b -> TaggedT s m b+tag = TagT+{-# INLINE tag #-}++-- | Easier to type alias for 'untagT'+untag :: TaggedT s m b -> m b+untag = untagT+{-# INLINE untag #-}++-- | Some times you need to change the tag you have lying around.+-- Idiomatic usage is to make a new combinator for the relationship between the+-- tags that you want to enforce, and define that combinator using 'retag'.+--+-- > data Succ n+-- > retagSucc :: Tagged n a -> Tagged (Succ n) a+-- > retagSucc = retag+retag :: TaggedT s m b -> TaggedT t m b+retag = tag . untag+{-# INLINE retag #-}+++-- | Lift an operation on underlying monad+mapTaggedT :: (m a -> n b) -> TaggedT s m a -> TaggedT s n b+mapTaggedT f = tag . f . untag+{-# INLINE mapTaggedT #-}+++-- | Tag value with its own type in 'Applicative' context+self :: Applicative m => a -> TaggedT a m a+self = tag . pure+{-# INLINE self #-}++-- | Tag value with its own type in 'Monad' context+selfM :: Monad m => a -> TaggedT s m a+selfM = tag . return+{-# INLINE selfM #-}+++-- | Reflect reified value back in 'Applicative' context+reflected :: forall s m a. (Applicative m, Reifies s a) => TaggedT s m a+reflected = tag . pure . reflect $ (Proxy :: Proxy s)+{-# INLINE reflected #-}++-- | Reflect reified value back in 'Monad' context+reflectedM :: forall s m a. (Monad m, Reifies s a) => TaggedT s m a+reflectedM = tag . return . reflect $ (Proxy :: Proxy s)+{-# INLINE reflectedM #-}+++-- | 'asTaggedTypeOf' is a type-restricted version of 'const'. It is usually used as an infix operator, and its typing forces its first argument (which is usually overloaded) to have the same type as the tag of the second.+asTaggedTypeOf :: s -> TaggedT s m b -> s+asTaggedTypeOf = const+{-# INLINE asTaggedTypeOf #-}

@@ -1,5 +1,5 @@ name:           tagged-transformer-version:        0.2+version:        0.3 license:        BSD3 license-file:   LICENSE author:         Edward A. Kmett@@ -18,16 +18,21 @@   location: git://github.com/ekmett/tagged-transformer.git  library-  build-depends: -    base >= 4 && < 5,-    transformers >= 0.2.2 && < 0.3,-    comonad >= 0.9.0.1 && < 0.10, -    distributive >= 0.1 && < 0.2,-    contravariant >= 0.1.2 && < 0.2,-    functor-apply >= 0.10.0.2 && < 0.11,-    comonad-transformers >= 0.10.1 && < 0.11-  +  build-depends:+    base                      >= 4        && < 5,+    array                     >= 0.3.0.2  && < 0.5,+    comonad-transformers      >= 3        && < 4,+    contravariant             >= 0.3      && < 1,+    distributive              >= 0.3      && < 1,+    mtl                       >= 2.0.1    && < 2.2,+    comonad                   >= 3        && < 4,+    reflection                >= 1.1.6    && < 2,+    semigroupoids             >= 3.0.2    && < 4,+    tagged                    >= 0.4.4    && < 1,+    transformers              >= 0.2      && < 0.4+   exposed-modules:     Data.Functor.Trans.Tagged +  hs-source-dirs: src   ghc-options: -Wall