tagged 0.4.3 → 0.4.4
raw patch · 5 files changed
+98/−37 lines, 5 files
Files
- CHANGELOG.markdown +7/−0
- Data/Proxy.hs +46/−24
- Data/Tagged.hs +39/−11
- README.markdown +4/−0
- tagged.cabal +2/−2
+ CHANGELOG.markdown view
@@ -0,0 +1,7 @@+0.4.4+-----+* Actually working polymorphic kind support++0.4.3+-----+* Added polymorphic kind support
Data/Proxy.hs view
@@ -2,13 +2,13 @@ #ifdef LANGUAGE_DeriveDataTypeable {-# LANGUAGE DeriveDataTypeable #-} #endif-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 706+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif ---------------------------------------------------------------------------- -- | -- Module : Data.Proxy--- Copyright : 2009-2011 Edward Kmett+-- Copyright : 2009-2012 Edward Kmett -- License : BSD3 -- -- Maintainer : Edward Kmett <ekmett@gmail.com>@@ -16,7 +16,6 @@ -- Portability : portable -- -------------------------------------------------------------------------------- module Data.Proxy ( -- * Tagged values@@ -31,23 +30,59 @@ import Control.Applicative (Applicative(..)) import Data.Traversable (Traversable(..)) import Data.Foldable (Foldable(..))-#ifdef LANGUAGE_DeriveDataTypeable-import Data.Data (Data,Typeable)-#endif import Data.Ix (Ix(..)) import Data.Tagged import Data.Monoid #ifdef __GLASGOW_HASKELL__ import GHC.Arr (unsafeIndex, unsafeRangeSize)+import Data.Data #endif -data Proxy p = Proxy deriving- ( Eq, Ord, Show, Read-#ifdef LANGUAGE_DeriveDataTypeable- , Data, Typeable+data Proxy s = Proxy++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__++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 #-} +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"@@ -58,19 +93,6 @@ enumFromThen _ _ = [Proxy] enumFromThenTo _ _ _ = [Proxy] enumFromTo _ _ = [Proxy]--{--Work around for the following GHC bug with deriving Ix instances with a phantom type:--Data/Tagged.hs:1:0:- Expecting an ordinary type, but found a type of kind * -> *- In an expression type signature: Proxy- In the expression: ghc-prim:GHC.Prim.tagToEnum# a :: Proxy- In the definition of `Data.Tagged.$tag2con_Proxy':- Data.Tagged.$tag2con_Proxy (ghc-prim:GHC.Types.I# a)- = ghc-prim:GHC.Prim.tagToEnum# a :: Proxy---} instance Ix (Proxy s) where range _ = [Proxy]
Data/Tagged.hs view
@@ -2,13 +2,13 @@ #ifdef LANGUAGE_DeriveDataTypeable {-# LANGUAGE DeriveDataTypeable #-} #endif-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 706+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif ---------------------------------------------------------------------------- -- | -- Module : Data.Tagged--- Copyright : 2009-2011 Edward Kmett+-- Copyright : 2009-2012 Edward Kmett -- License : BSD3 -- -- Maintainer : Edward Kmett <ekmett@gmail.com>@@ -32,8 +32,8 @@ import Control.Monad (liftM) import Data.Traversable (Traversable(..)) import Data.Foldable (Foldable(..))-#ifdef LANGUAGE_DeriveDataTypeable-import Data.Data (Data,Typeable)+#ifdef __GLASGOW_HASKELL__+import Data.Data #endif import Data.Ix (Ix(..)) import Data.Monoid@@ -45,14 +45,40 @@ -- -- 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-#ifdef LANGUAGE_DeriveDataTypeable- , Data, Typeable-#endif ) +#ifdef __GLASGOW_HASKELL__+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++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 " .@@ -195,9 +221,11 @@ -- 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+-- @+-- 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 #-}
+ README.markdown view
@@ -0,0 +1,4 @@+tagged+======++Values carrying an extra [phantom type](http://www.haskell.org/haskellwiki/Phantom_type) tag.
tagged.cabal view
@@ -1,5 +1,5 @@ name: tagged-version: 0.4.3+version: 0.4.4 license: BSD3 license-file: LICENSE author: Edward A. Kmett@@ -13,7 +13,7 @@ description: Haskell 98 phantom types to avoid unsafely passing dummy arguments build-type: Simple cabal-version: >= 1.10-extra-source-files: .travis.yml+extra-source-files: .travis.yml CHANGELOG.markdown README.markdown source-repository head type: git