enummapset-th-0.6.1.1/0000755000000000000000000000000012747555743012655 5ustar0000000000000000enummapset-th-0.6.1.1/LICENSE0000644000000000000000000000275412747555743013672 0ustar0000000000000000Copyright (c) 2012, Liyang HU 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 Liyang HU 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. enummapset-th-0.6.1.1/Setup.hs0000644000000000000000000000005612747555743014312 0ustar0000000000000000import Distribution.Simple main = defaultMain enummapset-th-0.6.1.1/enummapset-th.cabal0000644000000000000000000000325712747555743016437 0ustar0000000000000000name: enummapset-th version: 0.6.1.1 synopsis: TH-generated EnumSet/EnumMap wrappers around IntSet/IntMap. description: This package wraps @IntSet@ and @IntMap@ from @containers@, and provides fast sets and maps keyed on any data type with a well-behaved @Enum@ instance. Useful for derived @Enum@s, newtype'd @Int@s, or any data type that can be packed into an @Int@: just implement @fromEnum@ and @toEnum@. . 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/tsurucapital/enummapset-th license: BSD3 license-file: LICENSE author: Liyang HU maintainer: enummapset-th@liyang.hu copyright: © 2013−2015 Liyang HU category: Data build-type: Simple cabal-version: >= 1.8 tested-with: GHC == 7.8.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1 extra-source-files: include/map.inc source-repository head type: git location: https://github.com/tsurucapital/enummapset-th.git library exposed-modules: Data.EnumMap.Lazy Data.EnumMap.Strict Data.EnumSet other-modules: Data.EnumMapSetWrapper build-depends: base >= 4.5 && < 5, deepseq >= 1.3, containers >= 0.5.3 && < 0.6, template-haskell >= 2.7 include-dirs: include ghc-options: -Wall -- vim: et sw=4 ts=4 sts=4: enummapset-th-0.6.1.1/Data/0000755000000000000000000000000012747555743013526 5ustar0000000000000000enummapset-th-0.6.1.1/Data/EnumSet.hs0000644000000000000000000000345412747555743015450 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE KindSignatures #-} -- | Refer to the -- for "Data.IntSet". module Data.EnumSet where 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.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 (Data.EnumSet.toList s) instance (Enum k, Read k) => Read (EnumSet k) where readPrec = parens . prec 10 $ do Ident "fromList" <- lexP fmap Data.EnumSet.fromList readPrec enummapset-th-0.6.1.1/Data/EnumMapSetWrapper.hs0000644000000000000000000002035012747555743017441 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE Unsafe #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_HADDOCK not-home, ignore-exports #-} {- | A type @t@ is either negative (takes) or positive (gives). If @t ≡ a → b@, then @b@ has the same polarity as @t@, while @a@ has the opposite. Given the reification of a type @s@ of the appropriate polarity, 'pos' (or 'neg') returns a triple comprising a wrapper (or an unwrapper) of type @s → t@, any additional contexts required, along with the reification of @t@. When @s@ is 'Key', we replace it with a type @k@; the replacements for 'IntMap' @v@ and 'IntSet' are 'EnumMap' @k v@ and 'EnumSet' @k@ respectively; otherwise the type is left untouched. In each case the appropriate wrapper (or unwrapper) is returned. In order to generalise functions that map from one key type to another, we heuristically consider the rightmost type in a sequence of ‘→’s to be the output, treating everything else as input. For example: > EnumSet.map ∷ (Enum i, Enum o) ⇒ (i → o) → EnumSet i → EnumSet o We're screwed if someone adds a function that generalises to more than two different key types. [Ed: You could always write it out by hand…] Where only one key type is concerned, 'substT' unifies the input and output key type variables. -} module Data.EnumMapSetWrapper (w, w') where import Prelude #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif import Control.Arrow import Data.List (nub) 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 enumMap, enumSet :: Name enumMap = mkName "EnumMap" enumSet = mkName "EnumSet" enumMapT :: Name -> Type -> Type enumMapT k v = ConT enumMap `AppT` VarT k `AppT` v enumSetT :: Name -> Type enumSetT k = ConT enumSet `AppT` VarT k unEnumMapE, unEnumSetE :: Exp unEnumMapE = VarE (mkName "unEnumMap") unEnumSetE = VarE (mkName "unEnumSet") ------------------------------------------------------------------------ -- | @o ≃ (.)@ infixr 9 `o` 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)) -- | @post g ≃ (g .)@ post :: Exp -> Exp post g = InfixE (Just (ParensE g)) (VarE '(.)) Nothing -- | Argument input and output positions. ki, ko :: Name ki = mkName "k" ko = mkName "k'" -- | Like (***), but with 50% extra free. {-# INLINE xxx #-} xxx :: (a -> a') -> (b -> b') -> (c -> c') -> (a, b, c) -> (a', b', c') xxx f g h = \ (a, b, c) -> (f a, g b, h c) ------------------------------------------------------------------------ pos :: Name -> Type -> (Exp, Cxt, Type) pos k typ = case typ of 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, 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 #if MIN_VERSION_template_haskell(2,10,0) (VarE 'toEnum, [ConT ''Enum `AppT` VarT k], VarT k) #else (VarE 'toEnum, [ClassP ''Enum [VarT k]], VarT k) #endif ConT ((==) ''IntMap -> True) `AppT` v -> (ConE enumMap, [], enumMapT k v) ConT ((==) ''IntSet -> True) -> (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 TupleT 2 `AppT` a `AppT` b -> (wrap, cxt, TupleT 2 `AppT` a' `AppT` b') where (a'wrap, a'cxt, a') = pos k a (b'wrap, b'cxt, b') = pos k b cxt = nub (a'cxt ++ b'cxt) wrap = UInfixE (ParensE a'wrap) (VarE '(***)) (ParensE b'wrap) TupleT 3 `AppT` a `AppT` b `AppT` c -> (wrap, cxt, TupleT 3 `AppT` a' `AppT` b' `AppT` c') where (a'wrap, a'cxt, a') = pos k a (b'wrap, b'cxt, b') = pos k b (c'wrap, c'cxt, c') = pos k c cxt = nub (a'cxt ++ b'cxt ++ c'cxt) wrap = VarE 'xxx `AppE` a'wrap `AppE` b'wrap `AppE` c'wrap ListT `AppT` a -> (wrap, cxt, ListT `AppT` a') where (a'wrap, cxt, a') = pos k a wrap = VarE 'map `AppE` a'wrap VarT t `AppT` a -> (wrap, cxt, VarT t `AppT` a') where (a'wrap, cxt, a') = pos k a wrap = VarE '(<$>) `AppE` a'wrap _ -> (VarE 'id, [], typ) ------------------------------------------------------------------------ neg :: Name -> Type -> (Exp, Cxt, Type) neg k typ = case typ of 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 #if MIN_VERSION_template_haskell(2,10,0) (VarE 'fromEnum, [ConT ''Enum `AppT` VarT k], VarT k) #else (VarE 'fromEnum, [ClassP ''Enum [VarT k]], VarT k) #endif ConT ((==) ''IntMap -> True) `AppT` v -> (unEnumMapE, [], enumMapT k v) ConT ((==) ''IntSet -> True) -> (unEnumSetE, [], enumSetT k) TupleT 2 `AppT` a `AppT` b -> (unwrap, cxt, TupleT 2 `AppT` a' `AppT` b') where (a'unwrap, a'cxt, a') = neg k a (b'unwrap, b'cxt, b') = neg k b cxt = nub (a'cxt ++ b'cxt) unwrap = UInfixE (ParensE a'unwrap) (VarE '(***)) (ParensE b'unwrap) ListT `AppT` a -> (unwrap, cxt, ListT `AppT` a') where (a'unwrap, cxt, a') = neg k a unwrap = VarE 'map `AppE` a'unwrap _ -> (VarE 'id, [], typ) ------------------------------------------------------------------------ substT :: Name -> Name -> Type -> Type substT from to = subT where subT :: Type -> Type subT typ = case typ of VarT ((==) from -> True) -> VarT to s `AppT` t -> subT s `AppT` subT t ForallT tvs cxt t -> ForallT tvs' cxt' (subT t) where tvs' = nub (map subB tvs) cxt' = nub (map subP cxt) _ -> typ subB :: TyVarBndr -> TyVarBndr subB tv = case tv of PlainTV ((==) from -> True) -> PlainTV to KindedTV ((==) from -> True) k -> KindedTV to k _ -> tv subP :: Pred -> Pred #if MIN_VERSION_template_haskell(2,10,0) subP = subT #else subP p = case p of ClassP c ts -> ClassP c (map subT ts) EqualP s t -> EqualP (subT s) (subT t) #endif 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 #if MIN_VERSION_template_haskell(2,11,0) VarI _name (pos ko -> (e, cxt', typ')) _dec #else VarI _name (pos ko -> (e, cxt', typ')) _dec _fixity #endif <- 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 [ 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 enummapset-th-0.6.1.1/Data/EnumMap/0000755000000000000000000000000012747555743015070 5ustar0000000000000000enummapset-th-0.6.1.1/Data/EnumMap/Lazy.hs0000644000000000000000000000030412747555743016340 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | Refer to the -- for "Data.IntMap.Lazy". #define STRICT Lazy #include "map.inc" enummapset-th-0.6.1.1/Data/EnumMap/Strict.hs0000644000000000000000000000031212747555743016670 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | Refer to the -- for "Data.IntMap.Strict". #define STRICT Strict #include "map.inc" enummapset-th-0.6.1.1/include/0000755000000000000000000000000012747555743014300 5ustar0000000000000000enummapset-th-0.6.1.1/include/map.inc0000644000000000000000000000637612747555743015564 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE Trustworthy #-} module Data.EnumMap.STRICT where import Prelude (Eq, Ord, Enum, Functor (..), (.), ($), (>)) 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 w 'null w 'size w 'member w 'notMember w 'lookup w 'findWithDefault w 'lookupLT w 'lookupGT w 'lookupLE w 'lookupGE -- * Construction w 'empty w 'singleton -- * Insertion w 'insert w 'insertWith w 'insertWithKey w 'insertLookupWithKey -- * Delete/Update w 'delete w 'adjust w 'adjustWithKey w 'update w 'updateWithKey w 'updateLookupWithKey w 'alter -- * Combine: Union w 'union w 'unionWith w 'unionWithKey w 'unions w 'unionsWith -- * Combine: Difference w 'difference w 'differenceWith w 'differenceWithKey -- * Combine: Intersection w 'intersection w 'intersectionWith w 'intersectionWithKey -- * Combine: Universal combining function w 'mergeWithKey -- * Traversal: Map w 'map w 'mapWithKey w 'traverseWithKey w 'mapAccum w 'mapAccumWithKey w 'mapAccumRWithKey w' 'mapKeys w' 'mapKeysWith w' 'mapKeysMonotonic -- * Traversal: Folds w 'foldr w 'foldl w 'foldrWithKey w 'foldlWithKey w 'foldMapWithKey -- * Traversal: Strict folds w 'foldr' w 'foldl' w 'foldrWithKey' w 'foldlWithKey' -- * Conversion w 'elems w 'keys w 'assocs w 'keysSet w 'fromSet -- * Conversion: Lists w 'toList w 'fromList w 'fromListWith w 'fromListWithKey -- * Conversion: Ordered lists w 'toAscList w 'toDescList w 'fromAscList w 'fromAscListWith w 'fromAscListWithKey w 'fromDistinctAscList -- * Filter w 'filter w 'filterWithKey w 'partition w 'partitionWithKey w 'mapMaybe w 'mapMaybeWithKey w 'mapEither w 'mapEitherWithKey w 'split w 'splitLookup -- * Submap w 'isSubmapOf w 'isSubmapOfBy w 'isProperSubmapOf w 'isProperSubmapOfBy -- * Min/Max w 'findMin w 'findMax w 'deleteMin w 'deleteMax w 'deleteFindMin w 'deleteFindMax w 'updateMin w 'updateMax w 'updateMinWithKey w 'updateMaxWithKey w 'minView w 'maxView w 'minViewWithKey w 'maxViewWithKey -- * Debugging w 'showTree w 'showTreeWith ------------------------------------------------------------------------ instance Functor (EnumMap k) where {-# INLINE fmap #-} fmap = Data.EnumMap.STRICT.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 (Data.EnumMap.STRICT.toList m) instance (Enum k, Read k, Read a) => Read (EnumMap k a) where readPrec = parens . prec 10 $ do Ident "fromList" <- lexP Data.EnumMap.STRICT.fromList `fmap` readPrec -- vim: ft=haskell: