diff --git a/Data/EnumMap/Base.hs b/Data/EnumMap/Base.hs deleted file mode 100644 --- a/Data/EnumMap/Base.hs +++ /dev/null @@ -1,19 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE Trustworthy #-} -{-# OPTIONS_GHC -fno-warn-unused-imports #-} -{-# OPTIONS_HADDOCK not-home #-} - -module Data.EnumMap.Base - ( EnumMap (..) - , module Data.EnumMap.Base - ) where - -import Prelude () -import Data.IntMap.Lazy - -import Data.EnumMapSetWrapper - -#include "map.inc" - diff --git a/Data/EnumMap/Lazy.hs b/Data/EnumMap/Lazy.hs --- a/Data/EnumMap/Lazy.hs +++ b/Data/EnumMap/Lazy.hs @@ -1,24 +1,3 @@ -{-# LANGUAGE Safe #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - --- | Documentation: -module Data.EnumMap.Lazy - ( module Data.EnumMap.Base - ) where - -import Prelude -import Text.ParserCombinators.ReadPrec -import Text.Read - -import Data.EnumMap.Base (EnumMap) -import Data.EnumMap.Base hiding (EnumMap (EnumMap)) - -instance (Enum k, Show k, Show a) => Show (EnumMap k a) where - showsPrec p m = showParen (p > 10) $ - showString "fromList " . shows (toList m) - -instance (Enum k, Read k, Read a) => Read (EnumMap k a) where - readPrec = parens . prec 10 $ do - Ident "fromList" <- lexP - fromList `fmap` readPrec - +{-# LANGUAGE CPP #-} +#define STRICT Lazy +#include "map.inc" diff --git a/Data/EnumMap/Strict.hs b/Data/EnumMap/Strict.hs --- a/Data/EnumMap/Strict.hs +++ b/Data/EnumMap/Strict.hs @@ -1,20 +1,3 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE Trustworthy #-} -{-# OPTIONS_GHC -fno-warn-unused-imports #-} - --- | Documentation: -module Data.EnumMap.Strict - ( EnumMap - , module Data.EnumMap.Strict - ) where - -import Prelude () -import Data.IntMap.Strict - -import Data.EnumMapSetWrapper -import Data.EnumMap.Lazy ({-instance Show, Read-}) - +#define STRICT Strict #include "map.inc" - diff --git a/Data/EnumMapSetWrapper.hs b/Data/EnumMapSetWrapper.hs --- a/Data/EnumMapSetWrapper.hs +++ b/Data/EnumMapSetWrapper.hs @@ -1,8 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE Unsafe #-} {-# LANGUAGE ViewPatterns #-} @@ -35,28 +31,32 @@ -} -module Data.EnumMapSetWrapper (EnumMap (..), EnumSet (..), w, w') where +module Data.EnumMapSetWrapper (w, w') where import Prelude import Control.Applicative import Control.Arrow import Data.List (nub) -import Data.IntSet (IntSet, Key) -import Data.IntMap (IntMap) +import Data.IntSet (IntSet) +import Data.IntMap (IntMap, Key) +#if !MIN_VERSION_containers(0,5,1) +import qualified Data.IntSet as IntSet +import qualified Data.IntMap as IntMap +#endif import Language.Haskell.TH.Syntax -import Control.DeepSeq -import Data.Foldable -import Data.Traversable -import Data.Typeable -import Data.Data -import Data.Monoid +enumMap, enumSet :: Name +enumMap = mkName "EnumMap" +enumSet = mkName "EnumSet" -newtype EnumMap k v = EnumMap { unEnumMap :: IntMap v } deriving - (Eq, Ord, Monoid, Functor, Foldable, Traversable, Typeable, Data, NFData) +enumMapT :: Name -> Type -> Type +enumMapT k v = ConT enumMap `AppT` VarT k `AppT` v +enumSetT :: Name -> Type +enumSetT k = ConT enumSet `AppT` VarT k -newtype EnumSet k = EnumSet { unEnumSet :: IntSet } deriving - (Eq, Ord, Monoid, Typeable, Data, NFData) +unEnumMapE, unEnumSetE :: Exp +unEnumMapE = VarE (mkName "unEnumMap") +unEnumSetE = VarE (mkName "unEnumSet") ------------------------------------------------------------------------ @@ -65,6 +65,9 @@ o :: Exp -> Exp -> Exp o = flip UInfixE (VarE '(.)) +arrT :: Type -> Type -> Type +arrT a b = ArrowT `AppT` a `AppT` b + -- | @pre f ≃ (. f)@ pre :: Exp -> Exp pre f = InfixE Nothing (VarE '(.)) (Just (ParensE f)) @@ -90,18 +93,22 @@ ForallT tvs cxt t -> (wrap, [], ForallT tvs (nub $ cxt' ++ cxt) t') where (wrap, cxt', t') = pos k t - ArrowT `AppT` a `AppT` b -> (wrap, cxt, ArrowT `AppT` a' `AppT` b') where + ArrowT `AppT` a `AppT` b -> (wrap, cxt, a' `arrT` b') where (a'unwrap, a'cxt, a') = neg ki a (b'wrap, b'cxt, b') = pos ko b cxt = nub (a'cxt ++ b'cxt) wrap = post b'wrap `o` pre a'unwrap +#if MIN_VERSION_containers(0,5,1) ConT ((==) ''Key -> True) -> +#else + ConT ((||) <$> (==) ''Key <*> (==) ''Int -> True) -> +#endif (VarE 'toEnum, [ClassP ''Enum [VarT k]], VarT k) ConT ((==) ''IntMap -> True) `AppT` v -> - (ConE 'EnumMap, [], ConT ''EnumMap `AppT` VarT k `AppT` v) + (ConE enumMap, [], enumMapT k v) ConT ((==) ''IntSet -> True) -> - (ConE 'EnumSet, [], ConT ''EnumSet `AppT` VarT k) + (ConE enumSet, [], enumSetT k) ConT ((==) ''Maybe -> True) `AppT` a -> (VarE 'fmap `AppE` wrap, cxt, ConT ''Maybe `AppT` a') where (wrap, cxt, a') = pos k a @@ -135,18 +142,22 @@ neg :: Name -> Type -> (Exp, Cxt, Type) neg k typ = case typ of - ArrowT `AppT` a `AppT` b -> (unwrap, cxt, ArrowT `AppT` a' `AppT` b') where + ArrowT `AppT` a `AppT` b -> (unwrap, cxt, a' `arrT` b') where (a'wrap, a'cxt, a') = pos ki a (b'unwrap, b'cxt, b') = neg ko b cxt = nub (a'cxt ++ b'cxt) unwrap = post b'unwrap `o` pre a'wrap +#if MIN_VERSION_containers(0,5,1) ConT ((==) ''Key -> True) -> +#else + ConT ((||) <$> (==) ''Key <*> (==) ''Int -> True) -> +#endif (VarE 'fromEnum, [ClassP ''Enum [VarT k]], VarT k) ConT ((==) ''IntMap -> True) `AppT` v -> - (VarE 'unEnumMap, [], ConT ''EnumMap `AppT` VarT k `AppT` v) + (unEnumMapE, [], enumMapT k v) ConT ((==) ''IntSet -> True) -> - (VarE 'unEnumSet, [], ConT ''EnumSet `AppT` VarT k) + (unEnumSetE, [], enumSetT k) TupleT 2 `AppT` a `AppT` b -> (unwrap, cxt, TupleT 2 `AppT` a' `AppT` b') where @@ -186,15 +197,35 @@ w, w' :: Name -> Q [Dec] (w, w') = (wrap True, wrap False) where wrap :: Bool -> Name -> Q [Dec] +#if !MIN_VERSION_containers(0,5,1) + wrap _ name | name == 'IntMap.size = do + let size = mkName "size" + let a = mkName "a" + let t' = ForallT [PlainTV ki, PlainTV a] [] $ + enumMapT ki (VarT a) `arrT` ConT ''Int + let body = NormalB (VarE name `o` unEnumMapE) + return [ inlineD size, SigD size t', ValD (VarP size) body [] ] + wrap _ name | name == 'IntSet.size = do + let size = mkName "size" + let t' = ForallT [PlainTV ki] [] $ + enumSetT ki `arrT` ConT ''Int + let body = NormalB (VarE name `o` unEnumSetE) + return [ inlineD size, SigD size t', ValD (VarP size) body [] ] +#endif wrap subst name@(mkName . nameBase -> base) = do - VarI _name (pos ko -> (e, cxt', typ')) _dec fixity <- reify name + VarI _name (pos ko -> (e, cxt', typ')) _dec _fixity <- reify name let ks = map PlainTV [ki, ko] let t' = (if subst then substT ko ki else id) $ case typ' of ForallT tvs cxt t -> ForallT (ks ++ tvs) (nub $ cxt' ++ cxt) t t -> ForallT ks cxt' t let body = NormalB (e `AppE` VarE name) - return [ InfixD fixity base - , PragmaD (InlineP base Inline FunLike AllPhases) - , SigD base t', ValD (VarP base) body [] ] + return [ inlineD base, SigD base t', ValD (VarP base) body [] ] + + inlineD base = PragmaD $ InlineP base +#if MIN_VERSION_template_haskell(2,8,0) + Inline FunLike AllPhases +#else + (InlineSpec True False Nothing) +#endif diff --git a/Data/EnumSet.hs b/Data/EnumSet.hs --- a/Data/EnumSet.hs +++ b/Data/EnumSet.hs @@ -1,17 +1,97 @@ -{-# LANGUAGE Safe #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE Trustworthy #-} -- | Documentation: -module Data.EnumSet - ( module Data.EnumSet.Base - ) where +module Data.EnumSet where -import Prelude +import Prelude (Eq, Ord, Enum, Functor (..), (.), ($), (>)) +import Control.DeepSeq +import Data.IntSet +import Data.Typeable +import Data.Data +import Data.Monoid import Text.ParserCombinators.ReadPrec import Text.Read +import Text.Show -import Data.EnumSet.Base +import Data.EnumMapSetWrapper +newtype EnumSet k = EnumSet { unEnumSet :: IntSet } deriving + (Eq, Ord, Monoid, Typeable, Data, NFData) + +-- * Operators +w '(\\) + +-- * Query +w 'null +w 'size +w 'member +w 'notMember +w 'lookupLT +w 'lookupGT +w 'lookupLE +w 'lookupGE +w 'isSubsetOf +w 'isProperSubsetOf + +-- * Construction +w 'empty +w 'singleton +w 'insert +w 'delete + +-- * Combine +w 'union +w 'unions +w 'difference +w 'intersection + +-- * Filter +w 'filter +w 'partition +w 'split +w 'splitMember + +-- * Map +w' 'map + +-- * Folds +w 'foldr +w 'foldl + +-- * Strict folds +w 'foldr' +w 'foldl' + +-- * Min/Max +w 'findMin +w 'findMax +w 'deleteMin +w 'deleteMax +w 'deleteFindMin +w 'deleteFindMax +w 'maxView +w 'minView + +-- * Conversion: List +w 'elems +w 'toList +w 'fromList + +-- * Conversion: Ordered list +w 'toAscList +w 'toDescList +w 'fromAscList +w 'fromDistinctAscList + +-- * Debugging +w 'showTree +w 'showTreeWith + +------------------------------------------------------------------------ + instance (Enum k, Show k) => Show (EnumSet k) where showsPrec p s = showParen (p > 10) $ showString "fromList " . shows (toList s) @@ -19,5 +99,5 @@ instance (Enum k, Read k) => Read (EnumSet k) where readPrec = parens . prec 10 $ do Ident "fromList" <- lexP - fromList `fmap` readPrec + fmap fromList readPrec diff --git a/Data/EnumSet/Base.hs b/Data/EnumSet/Base.hs deleted file mode 100644 --- a/Data/EnumSet/Base.hs +++ /dev/null @@ -1,85 +0,0 @@ -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE Trustworthy #-} -{-# OPTIONS_GHC -fno-warn-unused-imports #-} -{-# OPTIONS_HADDOCK not-home #-} - -module Data.EnumSet.Base - ( EnumSet (..) - , module Data.EnumSet.Base - ) where - -import Prelude () -import Data.IntSet - -import Data.EnumMapSetWrapper - --- Operators -w '(\\) - --- Query -w 'null -w 'size -w 'member -w 'notMember -w 'lookupLT -w 'lookupGT -w 'lookupLE -w 'lookupGE -w 'isSubsetOf -w 'isProperSubsetOf - --- Construction -w 'empty -w 'singleton -w 'insert -w 'delete - --- Combine -w 'union -w 'unions -w 'difference -w 'intersection - --- Filter -w 'filter -w 'partition -w 'split -w 'splitMember - --- Map -w' 'map - --- Folds -w 'foldr -w 'foldl - --- Strict folds -w 'foldr' -w 'foldl' - --- Min/Max -w 'findMin -w 'findMax -w 'deleteMin -w 'deleteMax -w 'deleteFindMin -w 'deleteFindMax -w 'maxView -w 'minView - --- Conversion: List -w 'elems -w 'toList -w 'fromList - --- Conversion: Ordered list -w 'toAscList -w 'toDescList -w 'fromAscList -w 'fromDistinctAscList - --- Debugging -w 'showTree -w 'showTreeWith - diff --git a/enummapset-th.cabal b/enummapset-th.cabal --- a/enummapset-th.cabal +++ b/enummapset-th.cabal @@ -1,5 +1,5 @@ name: enummapset-th -version: 0.5.1.0 +version: 0.6.0.0 synopsis: TH-generated EnumSet/EnumMap wrappers around IntSet/IntMap. description: This package wraps @IntSet@ and @IntMap@ from @containers@, and provides @@ -10,12 +10,16 @@ The boilerplate is generated using Template Haskell, so unlike @enummapset@ it's easier to maintain and keep up-to-date with @containers@. On the downside, it's less portable. + . + Note that "Data.EnumMap.Lazy" and "Data.EnumMap.Strict" provide distinct + newtype wrappers, and their respective 'Functor' instances behave as + expected, unlike that of @IntMap@ which is alway lazy. homepage: https://github.com/liyang/enummapset-th license: BSD3 license-file: LICENSE author: Liyang HU maintainer: enummapset-th@liyang.hu -copyright: © 2012 Liyang HU +copyright: © 2013 Liyang HU category: Data build-type: Simple cabal-version: >= 1.8 @@ -28,18 +32,16 @@ library exposed-modules: - Data.EnumMap.Base Data.EnumMap.Lazy Data.EnumMap.Strict Data.EnumSet - Data.EnumSet.Base other-modules: Data.EnumMapSetWrapper build-depends: - base >= 4.6 && < 5, + base >= 4.5 && < 5, deepseq >= 1.3, - containers >= 0.5.1.0 && < 0.6, - template-haskell >= 2.8 + containers >= 0.5 && < 0.6, + template-haskell >= 2.7 include-dirs: include ghc-options: -Wall diff --git a/include/map.inc b/include/map.inc --- a/include/map.inc +++ b/include/map.inc @@ -1,8 +1,40 @@ --- Operators +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE Trustworthy #-} + +-- | Documentation: +module Data.EnumMap.STRICT where + +import Prelude (Eq, Ord, Enum, Functor (..), (.), ($), (>), const) +import Control.DeepSeq +import Data.Data +import Data.Foldable (Foldable) +import Data.IntMap.STRICT +import Data.Monoid +import Data.Traversable +import Text.ParserCombinators.ReadPrec +import Text.Read +import Text.Show + +import Data.EnumMapSetWrapper +import Data.EnumSet (EnumSet (..)) + +infixr 1 `EnumMap` +newtype EnumMap k v = EnumMap { unEnumMap :: IntMap v } deriving + (Eq, Ord, Monoid, Typeable, Data, NFData) + +------------------------------------------------------------------------ + +-- * Operators w '(!) w '(\\) --- Query +-- * Query w 'null w 'size w 'member @@ -14,17 +46,17 @@ w 'lookupLE w 'lookupGE --- Construction +-- * Construction w 'empty w 'singleton --- Insertion +-- * Insertion w 'insert w 'insertWith w 'insertWithKey w 'insertLookupWithKey --- Delete/Update +-- * Delete/Update w 'delete w 'adjust w 'adjustWithKey @@ -33,27 +65,27 @@ w 'updateLookupWithKey w 'alter --- Combine: Union +-- * Combine: Union w 'union w 'unionWith w 'unionWithKey w 'unions w 'unionsWith --- Combine: Difference +-- * Combine: Difference w 'difference w 'differenceWith w 'differenceWithKey --- Combine: Intersection +-- * Combine: Intersection w 'intersection w 'intersectionWith w 'intersectionWithKey --- Combine: Universal combining function +-- * Combine: Universal combining function w 'mergeWithKey --- Traversal: Map +-- * Traversal: Map w 'map w 'mapWithKey w 'traverseWithKey @@ -64,32 +96,32 @@ w' 'mapKeysWith w' 'mapKeysMonotonic --- Traversal: Folds +-- * Traversal: Folds w 'foldr w 'foldl w 'foldrWithKey w 'foldlWithKey --- Traversal: Strict folds +-- * Traversal: Strict folds w 'foldr' w 'foldl' w 'foldrWithKey' w 'foldlWithKey' --- Conversion +-- * Conversion w 'elems w 'keys w 'assocs w 'keysSet w 'fromSet --- Conversion: Lists +-- * Conversion: Lists w 'toList w 'fromList w 'fromListWith w 'fromListWithKey --- Conversion: Ordered lists +-- * Conversion: Ordered lists w 'toAscList w 'toDescList w 'fromAscList @@ -97,7 +129,7 @@ w 'fromAscListWithKey w 'fromDistinctAscList --- Filter +-- * Filter w 'filter w 'filterWithKey w 'partition @@ -109,13 +141,13 @@ w 'split w 'splitLookup --- Submap +-- * Submap w 'isSubmapOf w 'isSubmapOfBy w 'isProperSubmapOf w 'isProperSubmapOfBy --- Min/Max +-- * Min/Max w 'findMin w 'findMax w 'deleteMin @@ -131,9 +163,27 @@ w 'minViewWithKey w 'maxViewWithKey --- Debugging +-- * Debugging w 'showTree w 'showTreeWith + +------------------------------------------------------------------------ + +instance Functor (EnumMap k) where + {-# INLINE fmap #-} + fmap = map + +deriving instance Foldable (EnumMap k) +deriving instance Traversable (EnumMap k) + +instance (Enum k, Show k, Show a) => Show (EnumMap k a) where + showsPrec p m = showParen (p > 10) $ + showString "fromList " . shows (toList m) + +instance (Enum k, Read k, Read a) => Read (EnumMap k a) where + readPrec = parens . prec 10 $ do + Ident "fromList" <- lexP + fromList `fmap` readPrec -- vim: ft=haskell: