tables 0.3.1 → 0.4
raw patch · 5 files changed
+344/−102 lines, 5 filesdep +deepseqdep +template-haskelldep ~binarydep ~comonaddep ~lens
Dependencies added: deepseq, template-haskell
Dependency ranges changed: binary, comonad, lens, profunctors
Files
- .travis.yml +33/−14
- README.markdown +1/−1
- examples/Graph.hs +52/−0
- src/Data/Table.hs +248/−82
- tables.cabal +10/−5
.travis.yml view
@@ -1,24 +1,46 @@ language: haskell-before_install:- # Uncomment whenever hackage is down.- # - mkdir -p ~/.cabal && cp travis/config ~/.cabal/config && cabal update - # grab lens 3.8+env:+ - GHCVER=7.4.2+ - GHCVER=7.6.3++before_install:+ # Grab lens 4.0 - git clone https://github.com/ekmett/lens.git+ # If $GHCVER is the one travis has, don't bother reinstalling it.+ # We can also have faster builds by installing some libraries with+ # `apt`. If it isn't, install the GHC we want from hvr's PPA along+ # with cabal-1.18.+ - |+ if [ $GHCVER = `ghc --numeric-version` ]; then+ # Try installing some of the build-deps with apt-get for speed.+ cd lens+ travis/cabal-apt-install $MODE+ cd ..+ export CABAL=cabal+ else+ # Install the GHC we want from hvr's PPA+ sudo add-apt-repository -y ppa:hvr/ghc+ sudo apt-get update+ sudo apt-get install cabal-install-1.18 ghc-$GHCVER+ export CABAL=cabal-1.18+ export PATH=/opt/ghc/$GHCVER/bin:$PATH+ fi+ # Uncomment whenever hackage is down.+ # - mkdir -p ~/.cabal && cp travis/config ~/.cabal/config && $CABAL update+ - $CABAL update+ # Install the rest of lens' dependencies and build it. - cd lens- - travis/cabal-apt-install --only-dependencies --force-reinstall - cabal install - cd .. - # Try installing some of the build-deps with apt-get for speed.- - travis/cabal-apt-install --only-dependencies --force-reinstall $mode- install:- - cabal configure $mode- - cabal build+ - $CABAL install --dependencies-only --enable-tests+ - $CABAL configure -flib-Werror --enable-tests $MODE script:- - $script+ - $CABAL build+ - $CABAL test --show-details=always notifications: irc:@@ -27,6 +49,3 @@ skip_join: true template: - "\x0313tables\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}"--env:- - mode="--enable-tests" script="cabal test --show-details=always"
README.markdown view
@@ -1,7 +1,7 @@ Tables ====== -[](http://travis-ci.org/lens/tables)+[](http://travis-ci.org/ekmett/tables) This package provides simple in memory data tables with multiple indices.
+ examples/Graph.hs view
@@ -0,0 +1,52 @@+{-# Language TemplateHaskell #-}+{-# Language TypeFamilies #-}+{-# Language GADTs #-}+{-# Language GeneralizedNewtypeDeriving #-}+{-# Language RankNTypes #-}+-- base+import Control.Applicative+-- containers+import Data.Set (Set)+import qualified Data.Set as S+-- lens+import Control.Lens+-- tables+import Data.Table++data Node = Node+ { _name :: Int+ , _arcs :: Set Int+ } deriving (Show)+makeLenses ''Node++instance Tabular Node where+ type PKT Node = Int+ data Key k Node b where+ Key :: Key Primary Node Int+ Arcs :: Key Inverted Node (Set Int)+ data Tab Node i = NTab (i Primary Int)+ (i Inverted (Set Int))+ fetch Key = _name+ fetch Arcs = _arcs+ primary = Key+ primarily Key r = r+ mkTab f = NTab <$> f Key <*> f Arcs+ forTab (NTab i s) f = NTab <$> f Key i <*> f Arcs s+ ixTab (NTab i _) Key = i+ ixTab (NTab _ s) Arcs = s++main :: IO ()+main = do+ -- Make a lot of graph nodes.+ let t = fromList+ [ Node 1 (S.fromList [1, 2, 3])+ , Node 2 (S.fromList [1, 2, 3])+ , Node 3 (S.fromList [1, 2])+ , Node 4 (S.fromList [5])+ , Node 5 (S.fromList [4])+ , Node 6 (S.fromList [3])+ ]+ -- Print the names of all the nodes pointing to #3.+ print $ t ^.. withAny Arcs [3] . folded . name+ -- Print the names of all the nodes pointing to both #1 and #2.+ print $ t ^.. withAll Arcs [1, 2] . folded . name
src/Data/Table.hs view
@@ -7,6 +7,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE EmptyDataDecls #-}@@ -20,6 +21,9 @@ #ifndef MIN_VERSION_containers #define MIN_VERSION_containers(x,y,z) 1 #endif+#ifndef MIN_VERSION_lens+#define MIN_VERSION_lens(x,y,z) 1+#endif ----------------------------------------------------------------------------- -- | -- Module : Data.Table@@ -40,11 +44,18 @@ , Tabular(..) , Tab(..) , Key(..)+ -- ** Template Haskell helpers+ , makeTabular -- ** Table Construction , empty , singleton , table , fromList+ , unsafeFromList+ -- ** Combining Tables+ , union+ , difference+ , intersection -- ** Reading and Writing , null , count@@ -53,9 +64,18 @@ , Group(..) , insert , insert'+ , unsafeInsert , delete , rows- , rows'+ -- * Key Types+ -- ** Primary Keys+ , Primary+ -- ** Candidate Keys+ , Candidate, CandidateInt, CandidateHash+ -- ** Supplemental Keys+ , Supplemental, SupplementalInt, SupplementalHash+ -- ** Inverted Keys+ , Inverted, InvertedInt, InvertedHash -- * Esoterica , Auto(..) , autoKey@@ -64,24 +84,21 @@ -- * Implementation Details , IsKeyType(..) , KeyType(..)- , Primary- , Candidate, CandidateInt, CandidateHash- , Supplemental, SupplementalInt, SupplementalHash- , Inverted, InvertedInt, InvertedHash , AnIndex(..) ) where import Control.Applicative hiding (empty) import Control.Comonad+import Control.DeepSeq (NFData(rnf)) import Control.Lens hiding (anon) import Control.Monad import Control.Monad.Fix import Data.Binary (Binary) import qualified Data.Binary as B+import Data.Char (toUpper) import Data.Data-import Data.Foldable as F+import Data.Foldable as F hiding (foldl1) import Data.Function (on)-import Data.Functor.Identity import Data.Hashable import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM@@ -100,7 +117,8 @@ import qualified Data.Serialize as C import Data.Set (Set) import qualified Data.Set as S-import Data.Traversable+import Data.Traversable hiding (mapM)+import Language.Haskell.TH import qualified Prelude as P import Prelude hiding (null) @@ -225,7 +243,7 @@ EmptyTable `mappend` r = r r `mappend` EmptyTable = r- r@Table{} `mappend` s = F.foldl' (flip insert) r s+ r `mappend` s@Table{} = F.foldl' (flip insert) s r {-# INLINE mappend #-} instance Eq t => Eq (Table t) where@@ -253,11 +271,7 @@ type instance Index (Table t) = PKT t type instance IxValue (Table t) = t -instance Gettable f => Contains f (Table t) where- contains k f EmptyTable = coerce $ indexed f k False- contains k f (Table m) = Table <$> primaryMap (contains k f) m--instance Applicative f => Ixed f (Table t) where+instance Ixed (Table t) where ix _ _ EmptyTable = pure EmptyTable ix k f (Table m) = Table <$> primaryMap (ix k f) m {-# INLINE ix #-}@@ -297,7 +311,6 @@ m & at ky . anon nil %~ let pys = fetch primary <$> ys in filter (\e -> fetch primary e `P.notElem` pys) InvertedHashMap idx -> InvertedHashMap $ HM.foldlWithKey' ?? idx ?? HM.fromListWith (++) [ (f, [t]) | t <- ts, f <- HS.toList $ fetch k t ] $ \m ky ys -> m & at ky . anon nil %~ let pys = fetch primary <$> ys in filter (\e -> fetch primary e `P.notElem` pys)- {-# INLINE deleteCollisions #-} emptyTab :: Tabular t => Tab t (AnIndex t)@@ -316,6 +329,75 @@ -- * Public API +-- | Generate a Tabular instance for a data type. Currently, this only+-- works for types which have no type variables, and won't generate autoTab.+--+-- @+-- data Foo = Foo { fooId :: Int, fooBar :: String, fooBaz :: Double }+--+-- makeTabular 'fooId [(''Candidate, 'fooBaz), (''Supplemental, 'fooBar)]+-- @+makeTabular :: Name -> [(Name, Name)] -> Q [Dec]+makeTabular p ks = do+ -- Get the type name and PKT from the primary selector+ -- FIXME: Work for more flexible type names+ VarI _ (AppT (AppT ArrowT t) pkt) _ _ <- reify p+++ -- Locally used variable names+ k <- VarT <$> newName "k"+ a <- VarT <$> newName "a"+ f <- newName "f"++ tabName <- newName $ "Tab_" ++ nameBase p++ let keys = (''Primary, p) : ks+ keyCons@(pK:_) = map (uppercase.snd) keys++ idiom, idiom' :: [Exp] -> Exp+ idiom' = foldl1 (\l r -> AppE (AppE (VarE '(<*>)) l) r)++ idiom [] = AppE (VarE 'pure) (ConE '())+ idiom (x:xs) = idiom' $ AppE (VarE 'pure) x : xs++ -- FIXME: Work for more flexible type names+ keyTypes <- map (\(VarI _ (AppT _ t) _ _) -> t) <$> mapM (reify . snd) keys+ keyVars <- mapM (newName . nameBase . snd) keys++ return [InstanceD [] (AppT (ConT ''Tabular) t)+ [ TySynInstD ''PKT [t] pkt++ , DataInstD [] ''Key [k, t, a] (zipWith (\(kk,n) kt ->+ ForallC [] [EqualP k (ConT kk), EqualP a kt]+ (NormalC (uppercase n) [])) keys keyTypes) []++ , DataInstD [] ''Tab [t, a] [NormalC tabName $ zipWith+ (\(k,_) t -> (NotStrict, AppT (AppT a (ConT k)) t)) keys keyTypes] []++ , FunD 'fetch $ map (\(_,k) ->+ Clause [ConP (uppercase k) []] (NormalB (VarE k)) []) keys++ , ValD (VarP 'primary) (NormalB (ConE pK)) []++ , FunD 'primarily [Clause [ConP pK [], VarP f] (NormalB (VarE f)) []]++ , FunD 'mkTab [Clause [VarP f]+ ( NormalB . idiom $ ConE tabName : map (AppE (VarE f) . ConE) keyCons+ ) []]++ , FunD 'forTab [Clause [ConP tabName (map VarP keyVars), VarP f]+ ( NormalB . idiom $ ConE tabName : zipWith+ (\c x -> AppE (AppE (VarE f) (ConE c)) (VarE x)) keyCons keyVars+ ) []]++ , FunD 'ixTab [Clause [ConP tabName (map VarP keyVars), VarP f]+ ( NormalB . CaseE (VarE f) $ zipWith+ (\c x -> Match (ConP c []) (NormalB $ VarE x) []) keyCons keyVars+ ) []]+ ]]+ where uppercase :: Name -> Name+ uppercase = iso nameBase mkName._head %~ toUpper+ -- | Construct an empty relation empty :: Table t empty = EmptyTable@@ -367,6 +449,7 @@ -- | Insert a row into a relation, removing collisions. insert :: Tabular t => t -> Table t -> Table t insert t r = snd $ insert' t r+{-# INLINE insert #-} -- | Insert a row into a relation, removing collisions. insert' :: Tabular t => t -> Table t -> (t, Table t)@@ -376,22 +459,27 @@ Table m -> go (p m) Nothing -> go t0 where- go t = (,) t $ case delete t r of- EmptyTable -> singleton t- Table m -> Table $ runIdentity $ forTab m $ \k i -> Identity $ case i of- PrimaryMap idx -> primarily k $ PrimaryMap $ idx & at (fetch k t) ?~ t- CandidateMap idx -> CandidateMap $ idx & at (fetch k t) ?~ t- CandidateIntMap idx -> CandidateIntMap $ idx & at (fetch k t) ?~ t- CandidateHashMap idx -> CandidateHashMap $ idx & at (fetch k t) ?~ t- SupplementalMap idx -> SupplementalMap $ idx & at (fetch k t) . anon nil %~ (t:)- SupplementalIntMap idx -> SupplementalIntMap $ idx & at (fetch k t) . anon nil %~ (t:)- SupplementalHashMap idx -> SupplementalHashMap $ idx & at (fetch k t) . anon nil %~ (t:)- InvertedMap idx -> InvertedMap $ idx & flip (F.foldr $ \ik -> at ik . anon nil %~ (t:)) (fetch k t)- InvertedIntMap idx -> InvertedIntMap $ idx & flip (IS.foldr $ \ik -> at ik . anon nil %~ (t:)) (fetch k t)- InvertedHashMap idx -> InvertedHashMap $ idx & flip (F.foldr $ \ik -> at ik . anon nil %~ (t:)) (fetch k t)+ go t = (,) t $ unsafeInsert t (delete t r) {-# INLINE go #-}-{-# INLINE insert #-}+{-# INLINE insert' #-} +-- | Insert a row into a relation, ignoring collisions.+unsafeInsert :: Tabular t => t -> Table t -> Table t+unsafeInsert t r = case r of+ EmptyTable -> singleton t+ Table m -> Table $ runIdentity $ forTab m $ \k i -> Identity $ case i of+ PrimaryMap idx -> primarily k $ PrimaryMap $ idx & at (fetch k t) ?~ t+ CandidateMap idx -> CandidateMap $ idx & at (fetch k t) ?~ t+ CandidateIntMap idx -> CandidateIntMap $ idx & at (fetch k t) ?~ t+ CandidateHashMap idx -> CandidateHashMap $ idx & at (fetch k t) ?~ t+ SupplementalMap idx -> SupplementalMap $ idx & at (fetch k t) . anon nil %~ (t:)+ SupplementalIntMap idx -> SupplementalIntMap $ idx & at (fetch k t) . anon nil %~ (t:)+ SupplementalHashMap idx -> SupplementalHashMap $ idx & at (fetch k t) . anon nil %~ (t:)+ InvertedMap idx -> InvertedMap $ idx & flip (F.foldr $ \ik -> at ik . anon nil %~ (t:)) (fetch k t)+ InvertedIntMap idx -> InvertedIntMap $ idx & flip (IS.foldr $ \ik -> at ik . anon nil %~ (t:)) (fetch k t)+ InvertedHashMap idx -> InvertedHashMap $ idx & flip (F.foldr $ \ik -> at ik . anon nil %~ (t:)) (fetch k t)+{-# INLINE unsafeInsert #-}+ -- | Retrieve a row count. count :: Table t -> Int count EmptyTable = 0@@ -411,19 +499,23 @@ table = iso fromList toList {-# INLINE table #-} -instance (Tabular b, Applicative f, PKT a ~ PKT b) => Each f (Table a) (Table b) a b where+instance (Tabular b, PKT a ~ PKT b) => Each (Table a) (Table b) a b where each _ EmptyTable = pure EmptyTable- each f (Table m) = P.foldr insert empty <$> sequenceA (M.foldrWithKey (\i a r -> indexed f i a : r) [] $ m^.primaryMap)+ each f r@Table{} = P.foldr insert empty <$> traverse f (toList r)+ {-# INLINE each #-} +{- -- | Traverse all of the rows in a table without changing any types rows' :: Traversal' (Table t) t rows' _ EmptyTable = pure EmptyTable rows' f r@Table{} = P.foldr insert empty <$> traverse f (toList r) {-# INLINE rows' #-}+-} -- | Traverse all of the rows in a table, potentially changing table types completely.-rows :: Tabular t => Traversal (Table s) (Table t) s t-rows f r = P.foldr insert empty <$> traverse f (toList r)+rows :: (Tabular t, PKT s ~ PKT t) => IndexedTraversal (PKT s) (Table s) (Table t) s t+rows _ EmptyTable = pure EmptyTable+rows f (Table m) = P.foldr insert empty <$> sequenceA (M.foldrWithKey (\i a r -> indexed f i a : r) [] $ m^.primaryMap) {-# INLINE rows #-} class Group f q t i | q -> t i where@@ -509,13 +601,13 @@ instance Ord a => Withal (t -> [a]) [a] t where withAny _ _ f EmptyTable = f EmptyTable withAny k as f r@(Table m) = go $ m^..primaryMap.folded.filtered (P.any (\e -> ss^.contains e) . k)- where go xs = f (xs^.table) <&> mappend (deleteCollisions r xs)+ where go xs = f (unsafeFromList xs) <&> mappend (deleteCollisions r xs) ss = S.fromList as {-# INLINE withAny #-} withAll _ _ f EmptyTable = f EmptyTable withAll k as f r@(Table m) = go $ m^..primaryMap.folded.filtered (P.all (\e -> ss^.contains e) . k)- where go xs = f (xs^.table) <&> mappend (deleteCollisions r xs)+ where go xs = f (unsafeFromList xs) <&> mappend (deleteCollisions r xs) ss = S.fromList as {-# INLINE withAll #-} @@ -523,7 +615,7 @@ withAny _ _ f EmptyTable = f EmptyTable withAny ky as f r@(Table m) = go $ case ixTab m ky of InvertedMap idx -> as >>= \a -> idx^..ix a.folded- where go xs = f (xs^.table) <&> mappend (deleteCollisions r xs)+ where go xs = f (unsafeFromList xs) <&> mappend (deleteCollisions r xs) {-# INLINE withAny #-} withAll _ _ f EmptyTable = f EmptyTable@@ -531,14 +623,14 @@ withAll ky (a:as) f r@(Table m) = case ixTab m ky of InvertedMap idx -> let mkm c = M.fromList [ (fetch primary v, v) | v <- idx^..ix c.folded ] in go $ F.toList $ F.foldl' (\r -> M.intersection r . mkm) (mkm a) as- where go xs = f (xs^.table) <&> mappend (deleteCollisions r xs)+ where go xs = f (unsafeFromList xs) <&> mappend (deleteCollisions r xs) {-# INLINE withAll #-} -instance Withal (Key InvertedInt t (IntSet)) [Int] t where+instance Withal (Key InvertedInt t IntSet) [Int] t where withAny _ _ f EmptyTable = f EmptyTable withAny ky as f r@(Table m) = go $ case ixTab m ky of InvertedIntMap idx -> as >>= \a -> idx^..ix a.folded- where go xs = f (xs^.table) <&> mappend (deleteCollisions r xs)+ where go xs = f (unsafeFromList xs) <&> mappend (deleteCollisions r xs) {-# INLINE withAny #-} withAll _ _ f EmptyTable = f EmptyTable@@ -546,14 +638,14 @@ withAll ky (a:as) f r@(Table m) = case ixTab m ky of InvertedIntMap idx -> let mkm c = M.fromList [ (fetch primary v, v) | v <- idx^..ix c.folded ] in go $ F.toList $ F.foldl' (\r -> M.intersection r . mkm) (mkm a) as- where go xs = f (xs^.table) <&> mappend (deleteCollisions r xs)+ where go xs = f (unsafeFromList xs) <&> mappend (deleteCollisions r xs) {-# INLINE withAll #-} instance (Eq a, Hashable a) =>Withal (Key InvertedHash t (HashSet a)) [a] t where withAny _ _ f EmptyTable = f EmptyTable withAny ky as f r@(Table m) = go $ case ixTab m ky of InvertedHashMap idx -> as >>= \a -> idx^..ix a.folded- where go xs = f (xs^.table) <&> mappend (deleteCollisions r xs)+ where go xs = f (unsafeFromList xs) <&> mappend (deleteCollisions r xs) {-# INLINE withAny #-} withAll _ _ f EmptyTable = f EmptyTable@@ -561,7 +653,7 @@ withAll ky (a:as) f r@(Table m) = case ixTab m ky of InvertedHashMap idx -> let mkm c = M.fromList [ (fetch primary v, v) | v <- idx^..ix c.folded ] in go $ F.toList $ F.foldl' (\r -> M.intersection r . mkm) (mkm a) as- where go xs = f (xs^.table) <&> mappend (deleteCollisions r xs)+ where go xs = f (unsafeFromList xs) <&> mappend (deleteCollisions r xs) {-# INLINE withAll #-} @@ -586,7 +678,7 @@ lt = cmp LT EQ eq = cmp EQ EQ gt = cmp GT EQ- go xs = f (xs^.table) <&> mappend (deleteCollisions r xs)+ go xs = f (unsafeFromList xs) <&> mappend (deleteCollisions r xs) {-# INLINE with #-} instance With (Key Primary t) t where@@ -601,7 +693,7 @@ lt = cmp LT EQ eq = cmp EQ EQ gt = cmp GT EQ- go xs = f (xs^.table) <&> mappend (deleteCollisions r xs)+ go xs = f (unsafeFromList xs) <&> mappend (deleteCollisions r xs) {-# INLINE with #-} instance With (Key Candidate t) t where@@ -618,7 +710,7 @@ lt = cmp LT EQ eq = cmp EQ EQ gt = cmp GT EQ- go xs = f (xs^.table) <&> mappend (deleteCollisions r xs)+ go xs = f (unsafeFromList xs) <&> mappend (deleteCollisions r xs) {-# INLINE with #-} instance With (Key CandidateInt t) t where@@ -635,7 +727,7 @@ lt = cmp LT EQ eq = cmp EQ EQ gt = cmp GT EQ- go xs = f (xs^.table) <&> mappend (deleteCollisions r xs)+ go xs = f (unsafeFromList xs) <&> mappend (deleteCollisions r xs) {-# INLINE with #-} instance With (Key CandidateHash t) t where@@ -649,7 +741,7 @@ lt = cmp LT EQ eq = cmp EQ EQ gt = cmp GT EQ- go xs = f (xs^.table) <&> mappend (deleteCollisions r xs)+ go xs = f (unsafeFromList xs) <&> mappend (deleteCollisions r xs) {-# INLINE with #-} instance With (Key Supplemental t) t where@@ -666,7 +758,7 @@ lt = cmp LT EQ eq = cmp EQ EQ gt = cmp GT EQ- go xs = f (xs^.table) <&> mappend (deleteCollisions r xs)+ go xs = f (unsafeFromList xs) <&> mappend (deleteCollisions r xs) {-# INLINE with #-} instance With (Key SupplementalInt t) t where@@ -683,7 +775,7 @@ lt = cmp LT EQ eq = cmp EQ EQ gt = cmp GT EQ- go xs = f (xs^.table) <&> mappend (deleteCollisions r xs)+ go xs = f (unsafeFromList xs) <&> mappend (deleteCollisions r xs) {-# INLINE with #-} instance With (Key SupplementalHash t) t where@@ -697,7 +789,7 @@ lt = cmp LT EQ eq = cmp EQ EQ gt = cmp GT EQ- go xs = f (xs^.table) <&> mappend (deleteCollisions r xs)+ go xs = f (unsafeFromList xs) <&> mappend (deleteCollisions r xs) {-# INLINE with #-} -- | Build up a table from a list@@ -705,6 +797,28 @@ fromList = foldl' (flip insert) empty {-# INLINE fromList #-} +-- | Build up a table from a list, without checking for collisions+unsafeFromList :: Tabular t => [t] -> Table t+unsafeFromList = foldl' (flip unsafeInsert) empty+{-# INLINE unsafeFromList #-}++-- | Left-biased union of the two tables+--+-- This is a synonym for 'mappend'+union :: Table t -> Table t -> Table t+union = mappend+{-# INLINE union #-}++-- | Return the elements of the first table that do not share a key with an element of the second table+difference :: (Tabular t1, Tabular t2, PKT t1 ~ PKT t2) => Table t1 -> Table t2 -> Table t1+difference t1 t2 = deleteWithAny ((:[]) . fetch primary) (t2 ^.. each . to (fetch primary)) t1+{-# INLINE difference #-}++-- | Return the elements of the first table that share a key with an element of the second table+intersection :: (Tabular t1, Tabular t2, PKT t1 ~ PKT t2) => Table t1 -> Table t2 -> Table t1+intersection t1 t2 = t1 ^. withAny ((:[]) . fetch primary) (t2 ^.. each . to (fetch primary))+{-# INLINE intersection #-}+ -- * Lifting terms to types -- | Value-level key types@@ -720,14 +834,41 @@ InvertedInt :: KeyType InvertedInt IntSet InvertedHash :: (Eq a, Hashable a) => KeyType InvertedHash (HashSet a) --- | Type level key types+-- | The key type for the canonical, unique identifier attached to+-- every row. There should only be one 'Primary' key. data Primary++-- | A key type for values unique to each row, but that are+-- not 'Primary'. data Candidate++-- | 'CandidateInt' keys are like 'Candidate' keys but are backed by+-- an 'IntMap' rather than a 'Map'. This makes them more performant,+-- but values at 'CandidateInt' keys may only be 'Int's. data CandidateInt++-- | 'CandidateHash' keys are like 'Candidate' keys but are backed by+-- a 'HashMap' rather than a 'Map'. This makes them more performant+-- on @('==')@ and @('/=')@ lookups, but values at 'CandidateHash' keys+-- must be instances of 'Hashable' and 'Eq'. data CandidateHash++-- | A key type for supplemental data attached to each row that we+-- still may want to index by. Values need not be unique. data Supplemental++-- | 'SupplementalInt' keys are like 'Supplemental' keys but are backed by+-- an 'IntMap' rather than a 'Map'. This makes them more performant,+-- but values at 'SupplementalInt' keys may only be 'Int's. data SupplementalInt++-- | 'SupplementalHash' keys are like 'Supplemental' keys but are backed by+-- a 'HashMap' rather than a 'Map'. This makes them more performant+-- on @('==')@ and @('/=')@ lookups, but values at 'SupplementalHash' keys+-- must be instances of 'Hashable' and 'Eq'. data SupplementalHash++-- | A key type for inverse keys. data Inverted data InvertedInt data InvertedHash@@ -775,9 +916,6 @@ keyType _ = InvertedHash {-# INLINE keyType #-} -class HasValue p q f s t a b | s -> a, t -> b, s b -> t, t a -> s where- value :: Overloading p q f s t a b- ------------------------------------------------------------------------------ -- A simple table with an auto-incremented key ------------------------------------------------------------------------------@@ -797,8 +935,8 @@ type instance Index (Auto a) = Int -instance (a ~ Int, b ~ Int, Applicative f) => Each f (Auto a) (Auto b) a b where- each f (Auto k a) = Auto <$> indexed f (0 :: Int) k <*> indexed f (1 :: Int) a+instance (a ~ Int, b ~ Int) => Each (Auto a) (Auto b) a b where+ each f (Auto k a) = Auto <$> f k <*> f a {-# INLINE each #-} data Auto a = Auto !Int a@@ -808,10 +946,6 @@ autoKey f (Auto k a) = f k <&> \k' -> Auto k' a {-# INLINE autoKey #-} -instance (Indexable Int p, q ~ (->), Functor f) => HasValue p q f (Auto a) (Auto b) a b where- value f (Auto k a) = indexed f k a <&> Auto k- {-# INLINE value #-}- instance FunctorWithIndex Int Auto where imap f (Auto k a) = Auto k (f k a) {-# INLINE imap #-}@@ -830,6 +964,18 @@ extend f w@(Auto k _) = Auto k (f w) {-# INLINE extend #-} +instance Binary a => Binary (Auto a) where+ put (Auto k a) = B.put k >> B.put a+ get = Auto <$> B.get <*> B.get++instance Serialize a => Serialize (Auto a) where+ put (Auto k a) = C.put k >> C.put a+ get = Auto <$> C.get <*> C.get++instance SafeCopy a => SafeCopy (Auto a) where+ getCopy = contain $ Auto <$> safeGet <*> safeGet+ putCopy (Auto k a) = contain $ safePut k >> safePut a+ instance Tabular (Auto a) where type PKT (Auto a) = Int data Tab (Auto a) i = AutoTab (i Primary Int)@@ -854,10 +1000,6 @@ -- A simple key-value pair, indexed on the key ------------------------------------------------------------------------------ -instance (Indexable k p, q ~ (->), Functor f) => HasValue p q f (k, a) (k, b) a b where- value f (k, a) = indexed f k a <&> (,) k- {-# INLINE value #-}- -- | Simple (key, value) pairs instance Ord k => Tabular (k,v) where type PKT (k,v) = k@@ -881,10 +1023,6 @@ -- Set-like tables with Identity ------------------------------------------------------------------------------ -instance (Profunctor p, Functor f, p ~ q) => HasValue p q f (Identity a) (Identity b) a b where- value = unwrapped- {-# INLINE value #-}- instance Ord a => Tabular (Identity a) where type PKT (Identity a) = a data Tab (Identity a) i = IdentityTab (i Primary a)@@ -914,21 +1052,18 @@ type instance Index (Value a) = () type instance IxValue (Value a) = a -instance Functor f => Each f (Value a) (Value b) a b where- each f (Value a) = Value <$> indexed f () a+instance Each (Value a) (Value b) a b where+ each f (Value a) = Value <$> f a {-# INLINE each #-} -instance Gettable f => Contains f (Value a) where- contains () pafb _ = coerce (indexed pafb () True)- {-# INLINE contains #-}--instance Functor f => Ixed f (Value a) where+instance Ixed (Value a) where ix () pafb (Value a) = Value <$> indexed pafb () a {-# INLINE ix #-} -instance Wrapped a b (Value a) (Value b) where- wrapped = iso Value $ \(Value a) -> a- {-# INLINE wrapped #-}+instance Wrapped (Value a) where+ type Unwrapped (Value a) = a+ _Wrapped' = iso (\(Value a) -> a) Value+ {-# INLINE _Wrapped' #-} data Value a = Value a deriving (Eq,Ord,Show,Read,Functor,Foldable,Traversable,Data,Typeable)@@ -959,10 +1094,6 @@ Value f <@> Value a = Value (f a) {-# INLINE (<@>) #-} -instance (Profunctor p, Functor f, p ~ q) => HasValue p q f (Value a) (Value b) a b where- value = unwrapped- {-# INLINE value #-}- instance Ord a => Tabular (Value a) where type PKT (Value a) = a data Tab (Value a) i = ValueTab (i Primary a)@@ -980,3 +1111,38 @@ {-# INLINE ixTab #-} forTab (ValueTab x) f = ValueTab <$> f Val x {-# INLINE forTab #-}++instance (Tabular a, NFData a, NFData (Tab a (AnIndex a))) => NFData (Table a) where+ rnf (Table tab) = rnf tab+ rnf EmptyTable = ()++instance (NFData t, NFData a, NFData (PKT t)) => NFData (AnIndex t Primary a) where+ rnf (PrimaryMap m) = rnf m++instance (NFData t, NFData a, NFData (PKT t)) => NFData (AnIndex t Supplemental a) where+ rnf (SupplementalMap m) = rnf m++instance (NFData t, NFData (PKT t)) => NFData (AnIndex t SupplementalInt Int) where+ rnf (SupplementalIntMap m) = rnf m++instance (NFData t, NFData a, NFData (PKT t)) => NFData (AnIndex t SupplementalHash a) where+ rnf (SupplementalHashMap m) = rnf m++instance (NFData t, NFData a, NFData (PKT t)) => NFData (AnIndex t Candidate a) where+ rnf (CandidateMap m) = rnf m++instance (NFData t, NFData (PKT t)) => NFData (AnIndex t CandidateInt Int) where+ rnf (CandidateIntMap m) = rnf m++instance (NFData t, NFData a, NFData (PKT t)) => NFData (AnIndex t CandidateHash a) where+ rnf (CandidateHashMap m) = rnf m++instance (NFData t, NFData (PKT t)) => NFData (AnIndex t InvertedInt IntSet) where+ rnf (InvertedIntMap m) = rnf m++instance (NFData t, NFData a, NFData (PKT t)) => NFData (AnIndex t Inverted (Set a)) where+ rnf (InvertedMap m) = rnf m++instance (NFData t, NFData a, NFData (PKT t)) => NFData (AnIndex t InvertedHash (HashSet a)) where+ rnf (InvertedHashMap m) = rnf m+
tables.cabal view
@@ -1,6 +1,6 @@ name: tables category: Data, Lenses-version: 0.3.1+version: 0.4 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE@@ -34,24 +34,29 @@ location: git://github.com/ekmett/tables.git flag test-properties+ description: Enable the properties test-suite. default: True manual: True flag transformers2+ description: Enables the use of old versions of transformers. Users should+ never care about this. default: False manual: False library build-depends: base >= 4.3 && < 5,- binary >= 0.5 && < 0.6,+ binary >= 0.5 && < 0.8, cereal >= 0.3 && < 0.4,- comonad >= 3 && < 4,+ comonad >= 4 && < 5, containers >= 0.4 && < 0.6,+ deepseq >= 1.3 && < 1.4, hashable >= 1.1 && < 1.3,- lens >= 3.8 && < 4,- profunctors >= 3.2 && < 4,+ lens >= 4 && < 5,+ profunctors >= 4 && < 5, safecopy >= 0.6.3 && < 0.9,+ template-haskell >= 2.7 && < 2.9, transformers >= 0.2 && < 0.4, transformers-compat >= 0.1 && < 1, unordered-containers == 0.2.*