tagged-0.7/0000755000000000000000000000000012202611316010773 5ustar0000000000000000tagged-0.7/.travis.yml0000644000000000000000000000002212202611316013076 0ustar0000000000000000language: haskell tagged-0.7/CHANGELOG.markdown0000644000000000000000000000136012202611316014026 0ustar00000000000000000.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`! 0.6 --- * On GHC 7.7, we now still export the instances we used to for `Data.Proxy.Proxy` as orphans if need be. 0.5 --- * On GHC 7.7 we now simply export `Data.Typeable.Proxy` rather than make our own type. We still re-export it. 0.4.5 ----- * Added `witness` 0.4.4 ----- * Actually working polymorphic kind support 0.4.3 ----- * Added polymorphic kind support tagged-0.7/LICENSE0000644000000000000000000000276512202611316012012 0ustar0000000000000000Copyright (c) 2009-2013 Edward Kmett All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Edward Kmett nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. tagged-0.7/README.markdown0000644000000000000000000000015512202611316013475 0ustar0000000000000000tagged ====== Values carrying an extra [phantom type](http://www.haskell.org/haskellwiki/Phantom_type) tag. tagged-0.7/Setup.lhs0000644000000000000000000000016512202611316012605 0ustar0000000000000000#!/usr/bin/runhaskell > module Main (main) where > import Distribution.Simple > main :: IO () > main = defaultMain tagged-0.7/tagged.cabal0000644000000000000000000000211312202611316013207 0ustar0000000000000000name: tagged version: 0.7 license: BSD3 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett stability: experimental category: Data, Phantom Types synopsis: Haskell 98 phantom types to avoid unsafely passing dummy arguments homepage: http://github.com/ekmett/tagged bug-reports: http://github.com/ekmett/tagged/issues copyright: 2009-2013 Edward A. Kmett description: Haskell 98 phantom types to avoid unsafely passing dummy arguments build-type: Simple cabal-version: >= 1.10 extra-source-files: .travis.yml CHANGELOG.markdown README.markdown source-repository head type: git location: git://github.com/ekmett/tagged.git 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 if !impl(ghc>=7.7) hs-source-dirs: old exposed-modules: Data.Proxy tagged-0.7/old/0000755000000000000000000000000012202611316011551 5ustar0000000000000000tagged-0.7/old/Data/0000755000000000000000000000000012202611316012422 5ustar0000000000000000tagged-0.7/old/Data/Proxy.hs0000644000000000000000000001121512202611316014077 0ustar0000000000000000{-# 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 -- 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 #-} tagged-0.7/src/0000755000000000000000000000000012202611316011562 5ustar0000000000000000tagged-0.7/src/Data/0000755000000000000000000000000012202611316012433 5ustar0000000000000000tagged-0.7/src/Data/Tagged.hs0000644000000000000000000001763112202611316014172 0ustar0000000000000000{-# 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 -- 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 #-}