tagged 0.6.1 → 0.7

raw patch · 8 files changed

+487/−474 lines, 8 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +10/−0
• Data/Proxy.hs +0/−201
• Data/Tagged.hs +0/−264
• LICENSE +1/−1
• README.markdown +1/−1
• old/Data/Proxy.hs +185/−0
• src/Data/Tagged.hs +280/−0
• tagged.cabal +10/−7

@@ -1,3 +1,13 @@+0.7+---+* `Data.Proxy` has moved into base as of GHC 7.7 for use in the new `Data.Typeable`. We no longer export+  it for GHC >= 7.7. The most notable change in the module from the migration into base is the loss of+  the `reproxy` function.++0.6.2+-----+* Allowed polymorphic arguments where possible.+ 0.6.1 ----- * Needlessly claim that this entirely pure package is `Trustworthy`!

@@ -1,201 +0,0 @@-{-# LANGUAGE CPP #-}-#ifdef LANGUAGE_DeriveDataTypeable-{-# LANGUAGE DeriveDataTypeable #-}-#endif-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706-{-# LANGUAGE PolyKinds #-}-#endif-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707-{-# LANGUAGE StandaloneDeriving #-}-#endif-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif-{-# OPTIONS_GHC -fno-warn-orphans #-}-------------------------------------------------------------------------------- |--- Module     : Data.Proxy--- Copyright  : 2009-2012 Edward Kmett--- License    : BSD3------ Maintainer  : Edward Kmett <ekmett@gmail.com>--- Stability   : experimental--- Portability : portable------------------------------------------------------------------------------------module Data.Proxy-    (-    -- * Tagged values-      Proxy(..)-    , reproxy-    , asProxyTypeOf-    -- * Conversion-    , proxy-    , unproxy-    ) where--import Control.Applicative (Applicative(..))-import Data.Traversable (Traversable(..))-import Data.Foldable (Foldable(..))-import Data.Ix (Ix(..))-import Data.Tagged-import Data.Monoid-#ifdef __GLASGOW_HASKELL__-import GHC.Arr (unsafeIndex, unsafeRangeSize)-import Data.Data-#endif--#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707-deriving instance Typeable Proxy-#else-data Proxy s = Proxy-#endif--instance Eq (Proxy s) where-  _ == _ = True--instance Ord (Proxy s) where-  compare _ _ = EQ--instance Show (Proxy s) where-  showsPrec _ _ = showString "Proxy"--instance Read (Proxy s) where-  readsPrec d = readParen (d > 10) (\r -> [(Proxy, s) | ("Proxy",s) <- lex r ])--#ifdef __GLASGOW_HASKELL__-#if __GLASGOW_HASKELL__ < 707-instance Typeable1 Proxy where-  typeOf1 _ = mkTyConApp proxyTyCon []--proxyTyCon :: TyCon-#if __GLASGOW_HASKELL__ < 704-proxyTyCon = mkTyCon "Data.Proxy.Proxy"-#else-proxyTyCon = mkTyCon3 "tagged" "Data.Proxy" "Proxy"-#endif-{-# NOINLINE proxyTyCon #-}-#endif--instance Data s => Data (Proxy s) where-  gfoldl _ z _ = z Proxy-  toConstr _ = proxyConstr-  gunfold _ z c = case constrIndex c of-    1 -> z Proxy-    _ -> error "gunfold"-  dataTypeOf _ = proxyDataType-  dataCast1 f = gcast1 f--proxyConstr :: Constr-proxyConstr = mkConstr proxyDataType "Proxy" [] Prefix-{-# NOINLINE proxyConstr #-}--proxyDataType :: DataType-proxyDataType = mkDataType "Data.Proxy.Proxy" [proxyConstr]-{-# NOINLINE proxyDataType #-}-#endif--instance Enum (Proxy s) where-    succ _ = error "Proxy.succ"-    pred _ = error "Proxy.pred"-    fromEnum _ = 0-    toEnum 0 = Proxy-    toEnum _ = error "Proxy.toEnum: 0 expected"-    enumFrom _ = [Proxy]-    enumFromThen _ _ = [Proxy]-    enumFromThenTo _ _ _ = [Proxy]-    enumFromTo _ _ = [Proxy]--instance Ix (Proxy s) where-    range _ = [Proxy]-    index _ _ = 0-    inRange _ _ = True-    rangeSize _ = 1-#ifdef __GLASGOW_HASKELL__-    unsafeIndex _ _ = 0-    unsafeRangeSize _ = 1-#endif--instance Bounded (Proxy s) where-    minBound = Proxy-    maxBound = Proxy--instance Functor Proxy where-    fmap _ _ = Proxy-    {-# INLINE fmap #-}--instance Applicative Proxy where-    pure _ = Proxy-    {-# INLINE pure #-}-    _ <*> _ = Proxy-    {-# INLINE (<*>) #-}--instance Monoid (Proxy s) where-    mempty = Proxy-    {-# INLINE mempty #-}-    mappend _ _ = Proxy-    {-# INLINE mappend #-}-    mconcat _ = Proxy-    {-# INLINE mconcat #-}--instance Monad Proxy where-    return _ = Proxy-    {-# INLINE return #-}-    _ >>= _ = Proxy-    {-# INLINE (>>=) #-}--instance Foldable Proxy where-    foldMap _ _ = mempty-    {-# INLINE foldMap #-}-    fold _ = mempty-    {-# INLINE fold #-}-    foldr _ z _ = z-    {-# INLINE foldr #-}-    foldl _ z _ = z-    {-# INLINE foldl #-}-    foldl1 _ _ = error "foldl1: Proxy"-    {-# INLINE foldl1 #-}-    foldr1 _ _ = error "foldr1: Proxy"-    {-# INLINE foldr1 #-}--instance Traversable Proxy where-    traverse _ _ = pure Proxy-    {-# INLINE traverse #-}-    sequenceA _ = pure Proxy-    {-# INLINE sequenceA #-}-    mapM _ _ = return Proxy-    {-# INLINE mapM #-}-    sequence _ = return Proxy-    {-# INLINE sequence #-}---- | Some times you need to change the proxy you have lying around.--- Idiomatic usage is to make a new combinator for the relationship--- between the proxies that you want to enforce, and define that--- combinator using 'reproxy'.------ > data Succ n--- > reproxySucc :: Proxy n -> Proxy (Succ n)--- > reproxySucc = reproxy-reproxy :: Proxy s -> Proxy t-reproxy _ = Proxy-{-# INLINE reproxy #-}---- | Convert from a 'Tagged' representation to a representation--- based on a 'Proxy'.-proxy :: Tagged s a -> Proxy s -> a-proxy (Tagged x) _ = x-{-# INLINE proxy #-}---- | Convert from a representation based on a 'Proxy' to a 'Tagged'--- representation.-unproxy :: (Proxy s -> a) -> Tagged s a-unproxy f = Tagged (f Proxy)-{-# INLINE unproxy #-}---- | 'asProxyTypeOf' 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.-asProxyTypeOf :: a -> Proxy a -> a-asProxyTypeOf = const-{-# INLINE asProxyTypeOf #-}

@@ -1,264 +0,0 @@-{-# LANGUAGE CPP #-}-#ifdef LANGUAGE_DeriveDataTypeable-{-# LANGUAGE DeriveDataTypeable #-}-#endif-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706-{-# LANGUAGE PolyKinds #-}-#endif-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif-------------------------------------------------------------------------------- |--- Module     : Data.Tagged--- Copyright  : 2009-2012 Edward Kmett--- License    : BSD3------ Maintainer  : Edward Kmett <ekmett@gmail.com>--- Stability   : experimental--- Portability : portable-------------------------------------------------------------------------------------module Data.Tagged-    (-    -- * Tagged values-      Tagged(..)-    , retag-    , untag-    , tagSelf-    , untagSelf-    , asTaggedTypeOf-    , witness-    ) where--import Control.Applicative ((<$>), liftA2, Applicative(..))-import Control.Monad (liftM)-import Data.Traversable (Traversable(..))-import Data.Foldable (Foldable(..))-#ifdef __GLASGOW_HASKELL__-import Data.Data-#endif-import Data.Ix (Ix(..))-import Data.Monoid---- | 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 Tagged s b = Tagged { unTagged :: b } deriving-  ( Eq, Ord, Ix, Bounded-#if __GLASGOW_HASKELL__ >= 707-  , Typeable-#endif-  )--#ifdef __GLASGOW_HASKELL__-#if __GLASGOW_HASKELL__ < 707-instance Typeable2 Tagged where-  typeOf2 _ = mkTyConApp taggedTyCon []--taggedTyCon :: TyCon-#if __GLASGOW_HASKELL__ < 704-taggedTyCon = mkTyCon "Data.Tagged.Tagged"-#else-taggedTyCon = mkTyCon3 "tagged" "Data.Tagged" "Tagged"-#endif--#endif--instance (Data s, Data b) => Data (Tagged s b) where-  gfoldl f z (Tagged b) = z Tagged `f` b-  toConstr _ = taggedConstr-  gunfold k z c = case constrIndex c of-    1 -> k (z Tagged)-    _ -> error "gunfold"-  dataTypeOf _ = taggedDataType-  dataCast1 f = gcast1 f-  dataCast2 f = gcast2 f--taggedConstr :: Constr-taggedConstr = mkConstr taggedDataType "Tagged" [] Prefix-{-# INLINE taggedConstr #-}--taggedDataType :: DataType-taggedDataType = mkDataType "Data.Tagged.Tagged" [taggedConstr]-{-# INLINE taggedDataType #-}-#endif--instance Show b => Show (Tagged s b) where-    showsPrec n (Tagged b) = showParen (n > 10) $-        showString "Tagged " .-        showsPrec 11 b--instance Read b => Read (Tagged s b) where-    readsPrec d = readParen (d > 10) $ \r ->-        [(Tagged a, t) | ("Tagged", s) <- lex r, (a, t) <- readsPrec 11 s]--instance Monoid a => Monoid (Tagged s a) where-    mempty = Tagged mempty-    mappend (Tagged a) (Tagged b) = Tagged (mappend a b)--instance Functor (Tagged s) where-    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 (<*>) #-}--instance Monad (Tagged s) where-    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 #-}--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 #-}--instance Enum a => Enum (Tagged s a) where-    succ = fmap succ-    pred = fmap pred-    toEnum = Tagged . toEnum-    fromEnum (Tagged x) = fromEnum x-    enumFrom (Tagged x) = map Tagged (enumFrom x)-    enumFromThen (Tagged x) (Tagged y) = map Tagged (enumFromThen x y)-    enumFromTo (Tagged x) (Tagged y) = map Tagged (enumFromTo x y)-    enumFromThenTo (Tagged x) (Tagged y) (Tagged z) =-        map Tagged (enumFromThenTo x y z)--instance Num a => Num (Tagged s a) where-    (+) = liftA2 (+)-    (-) = liftA2 (-)-    (*) = liftA2 (*)-    negate = fmap negate-    abs = fmap abs-    signum = fmap signum-    fromInteger = Tagged . fromInteger--instance Real a => Real (Tagged s a) where-    toRational (Tagged x) = toRational x--instance Integral a => Integral (Tagged s a) where-    quot = liftA2 quot-    rem = liftA2 rem-    div = liftA2 div-    mod = liftA2 mod-    quotRem (Tagged x) (Tagged y) = (Tagged a, Tagged b) where-        (a, b) = quotRem x y-    divMod (Tagged x) (Tagged y) = (Tagged a, Tagged b) where-        (a, b) = divMod x y-    toInteger (Tagged x) = toInteger x--instance Fractional a => Fractional (Tagged s a) where-    (/) = liftA2 (/)-    recip = fmap recip-    fromRational = Tagged . fromRational--instance Floating a => Floating (Tagged s a) where-    pi = Tagged pi-    exp = fmap exp-    log = fmap log-    sqrt = fmap sqrt-    sin = fmap sin-    cos = fmap cos-    tan = fmap tan-    asin = fmap asin-    acos = fmap acos-    atan = fmap atan-    sinh = fmap sinh-    cosh = fmap cosh-    tanh = fmap tanh-    asinh = fmap asinh-    acosh = fmap acosh-    atanh = fmap atanh-    (**) = liftA2 (**)-    logBase = liftA2 (**)--instance RealFrac a => RealFrac (Tagged s a) where-    properFraction (Tagged x) = (a, Tagged b) where-        (a, b) = properFraction x-    truncate (Tagged x) = truncate x-    round (Tagged x) = round x-    ceiling (Tagged x) = ceiling x-    floor (Tagged x) = floor x--instance RealFloat a => RealFloat (Tagged s a) where-    floatRadix (Tagged x) = floatRadix x-    floatDigits (Tagged x) = floatDigits x-    floatRange (Tagged x) = floatRange x-    decodeFloat (Tagged x) = decodeFloat x-    encodeFloat m n = Tagged (encodeFloat m n)-    exponent (Tagged x) = exponent x-    significand = fmap significand-    scaleFloat n = fmap (scaleFloat n)-    isNaN (Tagged x) = isNaN x-    isInfinite (Tagged x) = isInfinite x-    isDenormalized (Tagged x) = isDenormalized x-    isNegativeZero (Tagged x) = isNegativeZero x-    isIEEE (Tagged x) = isIEEE x-    atan2 = liftA2 atan2---- | 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 :: Tagged s b -> Tagged t b-retag = Tagged . unTagged-{-# INLINE retag #-}---- | Alias for 'unTagged'-untag :: Tagged s b -> b-untag = unTagged---- | Tag a value with its own type.-tagSelf :: a -> Tagged a a-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 -> Tagged s b -> s-asTaggedTypeOf = const-{-# INLINE asTaggedTypeOf #-}--witness :: Tagged a b -> a -> b-witness (Tagged b) _ = b-{-# INLINE witness #-}---- | 'untagSelf' is a type-restricted version of 'untag'.-untagSelf :: Tagged a a -> a-untagSelf (Tagged x) = x-{-# INLINE untagSelf #-}

@@ -1,4 +1,4 @@-Copyright (c) 2009-2011 Edward Kmett+Copyright (c) 2009-2013 Edward Kmett All rights reserved.  Redistribution and use in source and binary forms, with or without

@@ -1,4 +1,4 @@ tagged ====== -Values carrying an extra [phantom type](http://www.haskell.org/haskellwiki/Phantom_type) tag. +Values carrying an extra [phantom type](http://www.haskell.org/haskellwiki/Phantom_type) tag.

@@ -0,0 +1,185 @@+{-# LANGUAGE CPP #-}+#ifdef LANGUAGE_DeriveDataTypeable+{-# LANGUAGE DeriveDataTypeable #-}+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706+{-# LANGUAGE PolyKinds #-}+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707+{-# LANGUAGE StandaloneDeriving #-}+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif+{-# OPTIONS_GHC -fno-warn-orphans #-}+----------------------------------------------------------------------------+-- |+-- Module     : Data.Proxy+-- Copyright  : 2009-2013 Edward Kmett+-- License    : BSD3+--+-- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Stability   : experimental+-- Portability : portable+--+-------------------------------------------------------------------------------+module Data.Proxy+    (+    -- * Proxy values+      Proxy(..)+    , reproxy+    , asProxyTypeOf+    ) where++import Control.Applicative (Applicative(..))+import Data.Traversable (Traversable(..))+import Data.Foldable (Foldable(..))+import Data.Ix (Ix(..))+import Data.Monoid+#ifdef __GLASGOW_HASKELL__+import GHC.Arr (unsafeIndex, unsafeRangeSize)+import Data.Data+#endif++#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707+deriving instance Typeable Proxy+#else+data Proxy s = Proxy+#endif++instance Eq (Proxy s) where+  _ == _ = True++instance Ord (Proxy s) where+  compare _ _ = EQ++instance Show (Proxy s) where+  showsPrec _ _ = showString "Proxy"++instance Read (Proxy s) where+  readsPrec d = readParen (d > 10) (\r -> [(Proxy, s) | ("Proxy",s) <- lex r ])++#ifdef __GLASGOW_HASKELL__+#if __GLASGOW_HASKELL__ < 707+instance Typeable1 Proxy where+  typeOf1 _ = mkTyConApp proxyTyCon []++proxyTyCon :: TyCon+#if __GLASGOW_HASKELL__ < 704+proxyTyCon = mkTyCon "Data.Proxy.Proxy"+#else+proxyTyCon = mkTyCon3 "tagged" "Data.Proxy" "Proxy"+#endif+{-# NOINLINE proxyTyCon #-}+#endif++instance Data s => Data (Proxy s) where+  gfoldl _ z _ = z Proxy+  toConstr _ = proxyConstr+  gunfold _ z c = case constrIndex c of+    1 -> z Proxy+    _ -> error "gunfold"+  dataTypeOf _ = proxyDataType+  dataCast1 f = gcast1 f++proxyConstr :: Constr+proxyConstr = mkConstr proxyDataType "Proxy" [] Prefix+{-# NOINLINE proxyConstr #-}++proxyDataType :: DataType+proxyDataType = mkDataType "Data.Proxy.Proxy" [proxyConstr]+{-# NOINLINE proxyDataType #-}+#endif++instance Enum (Proxy s) where+    succ _ = error "Proxy.succ"+    pred _ = error "Proxy.pred"+    fromEnum _ = 0+    toEnum 0 = Proxy+    toEnum _ = error "Proxy.toEnum: 0 expected"+    enumFrom _ = [Proxy]+    enumFromThen _ _ = [Proxy]+    enumFromThenTo _ _ _ = [Proxy]+    enumFromTo _ _ = [Proxy]++instance Ix (Proxy s) where+    range _ = [Proxy]+    index _ _ = 0+    inRange _ _ = True+    rangeSize _ = 1+#ifdef __GLASGOW_HASKELL__+    unsafeIndex _ _ = 0+    unsafeRangeSize _ = 1+#endif++instance Bounded (Proxy s) where+    minBound = Proxy+    maxBound = Proxy++instance Functor Proxy where+    fmap _ _ = Proxy+    {-# INLINE fmap #-}++instance Applicative Proxy where+    pure _ = Proxy+    {-# INLINE pure #-}+    _ <*> _ = Proxy+    {-# INLINE (<*>) #-}++instance Monoid (Proxy s) where+    mempty = Proxy+    {-# INLINE mempty #-}+    mappend _ _ = Proxy+    {-# INLINE mappend #-}+    mconcat _ = Proxy+    {-# INLINE mconcat #-}++instance Monad Proxy where+    return _ = Proxy+    {-# INLINE return #-}+    _ >>= _ = Proxy+    {-# INLINE (>>=) #-}++instance Foldable Proxy where+    foldMap _ _ = mempty+    {-# INLINE foldMap #-}+    fold _ = mempty+    {-# INLINE fold #-}+    foldr _ z _ = z+    {-# INLINE foldr #-}+    foldl _ z _ = z+    {-# INLINE foldl #-}+    foldl1 _ _ = error "foldl1: Proxy"+    {-# INLINE foldl1 #-}+    foldr1 _ _ = error "foldr1: Proxy"+    {-# INLINE foldr1 #-}++instance Traversable Proxy where+    traverse _ _ = pure Proxy+    {-# INLINE traverse #-}+    sequenceA _ = pure Proxy+    {-# INLINE sequenceA #-}+    mapM _ _ = return Proxy+    {-# INLINE mapM #-}+    sequence _ = return Proxy+    {-# INLINE sequence #-}++-- | Some times you need to change the proxy you have lying around.+-- Idiomatic usage is to make a new combinator for the relationship+-- between the proxies that you want to enforce, and define that+-- combinator using 'reproxy'.+--+-- > data Succ n+-- > reproxySucc :: proxy n -> Proxy (Succ n)+-- > reproxySucc = reproxy+reproxy :: proxy s -> Proxy t+reproxy _ = Proxy+{-# INLINE reproxy #-}++-- | 'asProxyTypeOf' 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.+asProxyTypeOf :: a -> proxy a -> a+asProxyTypeOf = const+{-# INLINE asProxyTypeOf #-}

@@ -0,0 +1,280 @@+{-# LANGUAGE CPP #-}+#ifdef LANGUAGE_DeriveDataTypeable+{-# LANGUAGE DeriveDataTypeable #-}+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706+{-# LANGUAGE PolyKinds #-}+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif+----------------------------------------------------------------------------+-- |+-- Module     : Data.Tagged+-- Copyright  : 2009-2013 Edward Kmett+-- License    : BSD3+--+-- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Stability   : experimental+-- Portability : portable+--+-------------------------------------------------------------------------------++module Data.Tagged+    (+    -- * Tagged values+      Tagged(..)+    , retag+    , untag+    , tagSelf+    , untagSelf+    , asTaggedTypeOf+    , witness+    -- * Conversion+    , proxy+    , unproxy+    ) where++import Control.Applicative ((<$>), liftA2, Applicative(..))+import Control.Monad (liftM)+import Data.Traversable (Traversable(..))+import Data.Foldable (Foldable(..))+#ifdef __GLASGOW_HASKELL__+import Data.Data+#endif+import Data.Ix (Ix(..))+import Data.Monoid+import Data.Proxy++-- | 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 Tagged s b = Tagged { unTagged :: b } deriving+  ( Eq, Ord, Ix, Bounded+#if __GLASGOW_HASKELL__ >= 707+  , Typeable+#endif+  )++#ifdef __GLASGOW_HASKELL__+#if __GLASGOW_HASKELL__ < 707+instance Typeable2 Tagged where+  typeOf2 _ = mkTyConApp taggedTyCon []++taggedTyCon :: TyCon+#if __GLASGOW_HASKELL__ < 704+taggedTyCon = mkTyCon "Data.Tagged.Tagged"+#else+taggedTyCon = mkTyCon3 "tagged" "Data.Tagged" "Tagged"+#endif++#endif++instance (Data s, Data b) => Data (Tagged s b) where+  gfoldl f z (Tagged b) = z Tagged `f` b+  toConstr _ = taggedConstr+  gunfold k z c = case constrIndex c of+    1 -> k (z Tagged)+    _ -> error "gunfold"+  dataTypeOf _ = taggedDataType+  dataCast1 f = gcast1 f+  dataCast2 f = gcast2 f++taggedConstr :: Constr+taggedConstr = mkConstr taggedDataType "Tagged" [] Prefix+{-# INLINE taggedConstr #-}++taggedDataType :: DataType+taggedDataType = mkDataType "Data.Tagged.Tagged" [taggedConstr]+{-# INLINE taggedDataType #-}+#endif++instance Show b => Show (Tagged s b) where+    showsPrec n (Tagged b) = showParen (n > 10) $+        showString "Tagged " .+        showsPrec 11 b++instance Read b => Read (Tagged s b) where+    readsPrec d = readParen (d > 10) $ \r ->+        [(Tagged a, t) | ("Tagged", s) <- lex r, (a, t) <- readsPrec 11 s]++instance Monoid a => Monoid (Tagged s a) where+    mempty = Tagged mempty+    mappend (Tagged a) (Tagged b) = Tagged (mappend a b)++instance Functor (Tagged s) where+    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 (<*>) #-}++instance Monad (Tagged s) where+    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 #-}++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 #-}++instance Enum a => Enum (Tagged s a) where+    succ = fmap succ+    pred = fmap pred+    toEnum = Tagged . toEnum+    fromEnum (Tagged x) = fromEnum x+    enumFrom (Tagged x) = map Tagged (enumFrom x)+    enumFromThen (Tagged x) (Tagged y) = map Tagged (enumFromThen x y)+    enumFromTo (Tagged x) (Tagged y) = map Tagged (enumFromTo x y)+    enumFromThenTo (Tagged x) (Tagged y) (Tagged z) =+        map Tagged (enumFromThenTo x y z)++instance Num a => Num (Tagged s a) where+    (+) = liftA2 (+)+    (-) = liftA2 (-)+    (*) = liftA2 (*)+    negate = fmap negate+    abs = fmap abs+    signum = fmap signum+    fromInteger = Tagged . fromInteger++instance Real a => Real (Tagged s a) where+    toRational (Tagged x) = toRational x++instance Integral a => Integral (Tagged s a) where+    quot = liftA2 quot+    rem = liftA2 rem+    div = liftA2 div+    mod = liftA2 mod+    quotRem (Tagged x) (Tagged y) = (Tagged a, Tagged b) where+        (a, b) = quotRem x y+    divMod (Tagged x) (Tagged y) = (Tagged a, Tagged b) where+        (a, b) = divMod x y+    toInteger (Tagged x) = toInteger x++instance Fractional a => Fractional (Tagged s a) where+    (/) = liftA2 (/)+    recip = fmap recip+    fromRational = Tagged . fromRational++instance Floating a => Floating (Tagged s a) where+    pi = Tagged pi+    exp = fmap exp+    log = fmap log+    sqrt = fmap sqrt+    sin = fmap sin+    cos = fmap cos+    tan = fmap tan+    asin = fmap asin+    acos = fmap acos+    atan = fmap atan+    sinh = fmap sinh+    cosh = fmap cosh+    tanh = fmap tanh+    asinh = fmap asinh+    acosh = fmap acosh+    atanh = fmap atanh+    (**) = liftA2 (**)+    logBase = liftA2 (**)++instance RealFrac a => RealFrac (Tagged s a) where+    properFraction (Tagged x) = (a, Tagged b) where+        (a, b) = properFraction x+    truncate (Tagged x) = truncate x+    round (Tagged x) = round x+    ceiling (Tagged x) = ceiling x+    floor (Tagged x) = floor x++instance RealFloat a => RealFloat (Tagged s a) where+    floatRadix (Tagged x) = floatRadix x+    floatDigits (Tagged x) = floatDigits x+    floatRange (Tagged x) = floatRange x+    decodeFloat (Tagged x) = decodeFloat x+    encodeFloat m n = Tagged (encodeFloat m n)+    exponent (Tagged x) = exponent x+    significand = fmap significand+    scaleFloat n = fmap (scaleFloat n)+    isNaN (Tagged x) = isNaN x+    isInfinite (Tagged x) = isInfinite x+    isDenormalized (Tagged x) = isDenormalized x+    isNegativeZero (Tagged x) = isNegativeZero x+    isIEEE (Tagged x) = isIEEE x+    atan2 = liftA2 atan2++-- | 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 :: Tagged s b -> Tagged t b+retag = Tagged . unTagged+{-# INLINE retag #-}++-- | Alias for 'unTagged'+untag :: Tagged s b -> b+untag = unTagged++-- | Tag a value with its own type.+tagSelf :: a -> Tagged a a+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 -> tagged s b -> s+asTaggedTypeOf = const+{-# INLINE asTaggedTypeOf #-}++witness :: Tagged a b -> a -> b+witness (Tagged b) _ = b+{-# INLINE witness #-}++-- | 'untagSelf' is a type-restricted version of 'untag'.+untagSelf :: Tagged a a -> a+untagSelf (Tagged x) = x+{-# INLINE untagSelf #-}++-- | Convert from a 'Tagged' representation to a representation+-- based on a 'Proxy'.+proxy :: Tagged s a -> proxy s -> a+proxy (Tagged x) _ = x+{-# INLINE proxy #-}++-- | Convert from a representation based on a 'Proxy' to a 'Tagged'+-- representation.+unproxy :: (Proxy s -> a) -> Tagged s a+unproxy f = Tagged (f Proxy)+{-# INLINE unproxy #-}

@@ -1,5 +1,5 @@ name:           tagged-version:        0.6.1+version:        0.7 license:        BSD3 license-file:   LICENSE author:         Edward A. Kmett@@ -22,12 +22,15 @@ library   default-language: Haskell98   other-extensions: CPP+  build-depends: base >= 2 && < 5+  ghc-options: -Wall+  hs-source-dirs: src+  exposed-modules: Data.Tagged+   if !impl(hugs)     cpp-options: -DLANGUAGE_DeriveDataTypeable     other-extensions: DeriveDataTypeable-  build-depends:-    base >= 2 && < 5-  exposed-modules:-    Data.Tagged-    Data.Proxy-  ghc-options: -Wall++  if !impl(ghc>=7.7)+    hs-source-dirs: old+    exposed-modules: Data.Proxy