tagged 0.2.1 → 0.2.2
raw patch · 3 files changed
+61/−62 lines, 3 filesdep ~basedep ~semigroups
Dependency ranges changed: base, semigroups
Files
- Data/Proxy.hs +4/−3
- Data/Tagged.hs +54/−56
- tagged.cabal +3/−3
Data/Proxy.hs view
@@ -30,6 +30,7 @@ import Data.Data (Data,Typeable) import Data.Ix (Ix(..)) import Data.Tagged+import Data.Semigroup #ifdef __GLASGOW_HASKELL__ import GHC.Arr (unsafeIndex, unsafeRangeSize) #endif@@ -52,6 +53,9 @@ enumFromThenTo _ _ _ = [Proxy] enumFromTo _ _ = [Proxy] +instance Semigroup (Proxy s) where+ _ <> _ = Proxy+ {- Work around for the following GHC bug with deriving Ix instances with a phantom type: @@ -162,6 +166,3 @@ asProxyTypeOf :: a -> Proxy a -> a asProxyTypeOf = const {-# INLINE asProxyTypeOf #-}--instance Semigroup (Proxy a) where- Proxy <> Proxy = Proxy
Data/Tagged.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-} ---------------------------------------------------------------------------- -- | -- Module : Data.Tagged@@ -14,8 +14,7 @@ module Data.Tagged ( -- * Tagged values- Tagged- , TaggedT(..)+ Tagged(..) , retag , untag , tagSelf@@ -29,8 +28,8 @@ import Data.Foldable (Foldable(..)) import Data.Data (Data,Typeable) import Data.Ix (Ix(..))--- import Data.Functor.Identity import Text.Read+import Data.Semigroup -- | 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@@ -40,65 +39,67 @@ -- 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 = TaggedT { unTagged :: m b } deriving - ( Eq, Ord, Ix, Enum, Bounded --- , Num, Real, Integral, Fractional, Floating, RealFrac, RealFloat--- #ifdef LANGUAGE_DeriveDataTypeable--- , Data, Typeable--- #endif+newtype Tagged s b = Tagged { unTagged :: b } deriving + ( Eq, Ord, Ix, Enum, Bounded, Num, Real, Integral, Fractional, Floating, RealFrac, RealFloat+#ifdef LANGUAGE_DeriveDataTypeable+ , Data, Typeable+#endif ) instance Show b => Show (Tagged s b) where- showsPrec n (Tagged b) = showParen (n > 10) $- showString "Tagged " .- showsPrec 11 b+ showsPrec n (Tagged b) = showParen (n > 10) $+ showString "Tagged " .+ showsPrec 11 b +instance Semigroup a => Semigroup (Tagged s a) where+ Tagged a <> Tagged b = Tagged (a <> b)+ instance Read b => Read (Tagged s b) where- readPrec = parens $ prec 10 $ do- Ident "Tagged" <- lexP- Tagged <$> step readPrec+ readPrec = parens $ prec 10 $ do+ Ident "Tagged" <- lexP+ Tagged <$> step readPrec instance Functor (Tagged s) where - fmap f (Tagged x) = Tagged (f x)- {-# INLINE fmap #-}+ fmap f (Tagged x) = Tagged (f x)+ {-# INLINE fmap #-} instance Applicative (Tagged s) where- pure = Tagged- {-# INLINE pure #-}- Tagged f <*> Tagged x = Tagged (f x)- {-# INLINE (<*>) #-}+ pure = Tagged+ {-# INLINE pure #-}+ Tagged f <*> Tagged x = Tagged (f x)+ {-# INLINE (<*>) #-} instance Monad (Tagged s) where- return = Tagged- {-# INLINE return #-}- Tagged m >>= k = k m - {-# INLINE (>>=) #-}- _ >> n = n- {-# INLINE (>>) #-}+ return = Tagged+ {-# INLINE return #-}+ Tagged m >>= k = k m + {-# INLINE (>>=) #-}+ _ >> n = n+ {-# INLINE (>>) #-} instance Foldable (Tagged s) where- foldMap f (Tagged x) = f x- {-# INLINE foldMap #-}- fold (Tagged x) = x- {-# INLINE fold #-}- foldr f z (Tagged x) = f x z- {-# INLINE foldr #-}- foldl f z (Tagged x) = f z x- {-# INLINE foldl #-}- foldl1 _ (Tagged x) = x - {-# INLINE foldl1 #-}- foldr1 _ (Tagged x) = x- {-# INLINE foldr1 #-}+ foldMap f (Tagged x) = f x+ {-# INLINE foldMap #-}+ fold (Tagged x) = x+ {-# INLINE fold #-}+ foldr f z (Tagged x) = f x z+ {-# INLINE foldr #-}+ foldl f z (Tagged x) = f z x+ {-# INLINE foldl #-}+ foldl1 _ (Tagged x) = x + {-# INLINE foldl1 #-}+ foldr1 _ (Tagged x) = x+ {-# INLINE foldr1 #-} instance Traversable (Tagged s) where- traverse f (Tagged x) = Tagged <$> f x- {-# INLINE traverse #-}- sequenceA (Tagged x) = Tagged <$> x- {-# INLINE sequenceA #-}- mapM f (Tagged x) = liftM Tagged (f x)- {-# INLINE mapM #-}- sequence (Tagged x) = liftM Tagged x- {-# INLINE sequence #-}+ traverse f (Tagged x) = Tagged <$> f x+ {-# INLINE traverse #-}+ sequenceA (Tagged x) = Tagged <$> x+ {-# INLINE sequenceA #-}+ mapM f (Tagged x) = liftM Tagged (f x)+ {-# INLINE mapM #-}+ sequence (Tagged x) = liftM Tagged x+ {-# INLINE sequence #-} -- | 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@@ -107,21 +108,21 @@ -- > data Succ n -- > retagSucc :: Tagged n a -> Tagged (Succ n) a -- > retagSucc = retag-retag :: TaggedT s m b -> TaggedT t m b-retag = TaggedT . unTaggedT+retag :: Tagged s b -> Tagged t b+retag = Tagged . unTagged {-# INLINE retag #-} -- | Alias for 'unTagged'-untag :: TaggedT s m b -> b+untag :: Tagged s b -> b untag = unTagged -- | Tag a value with its own type. tagSelf :: a -> Tagged a a-tagSelf = tagged+tagSelf = Tagged {-# INLINE tagSelf #-} -- | '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 :: s -> Tagged s b -> s asTaggedTypeOf = const {-# INLINE asTaggedTypeOf #-} @@ -129,7 +130,4 @@ untagSelf :: Tagged a a -> a untagSelf (Tagged x) = x {-# INLINE untagSelf #-}--instance Semigroup a => Semigroup (Tagged s a) where- Tagged a <> Tagged b = Tagged (a <> b)
tagged.cabal view
@@ -1,5 +1,5 @@ name: tagged-version: 0.2.1+version: 0.2.2 license: BSD3 license-file: LICENSE author: Edward A. Kmett@@ -27,8 +27,8 @@ extensions: DeriveDataTypeable build-depends: base >= 4 && < 5,- semigroups >= 0.4 && < 0.5,- data-default >= 0.2 && < 3+ data-default >= 0.2 && < 3,+ semigroups >= 0.5 && < 0.6 exposed-modules: Data.Tagged Data.Proxy