content: {-# LANGUAGE FunctionalDependencies #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE UndecidableInstances #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE LiberalTypeSynonyms #-}
  {-# LANGUAGE DeriveDataTypeable #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE DeriveTraversable #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE TemplateHaskell #-}
  {-# LANGUAGE DeriveFoldable #-}
  {-# LANGUAGE KindSignatures #-}
  {-# LANGUAGE EmptyDataDecls #-}
  {-# LANGUAGE DeriveFunctor #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE RankNTypes #-}
  {-# LANGUAGE GADTs #-}
  {-# LANGUAGE CPP #-}
  {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  
  #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
  -- Copyright   :  (C) 2012-2013 Edward Kmett,
  -- License     :  BSD-style (see the file LICENSE)
  --
  -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
  -- Stability   :  experimental
  -- Portability :  non-portable
  --
  -- This module provides tables with multiple indices that support a simple
  -- API based on the lenses and traversals from the @lens@ package.
  ----------------------------------------------------------------------------
  module Data.Table
    (
    -- * Tables
      Table(..)
    , Tabular(..)
    , Tab(..)
    , Key(..)
    -- ** Template Haskell helpers
  #if __GLASGOW_HASKELL__ < 708
    , makeTabular
    , makeTabularFor
  #endif
    -- ** Table Construction
    , empty
    , singleton
    , table
    , table'
    , fromList
    , unsafeFromList
    -- ** Combining Tables
    , union
    , difference
    , intersection
    -- ** Reading and Writing
    , Data.Table.null
    , count
    , With(..)
    , Withal(..)
    , Group(..)
    , insert
    , insert'
    , unsafeInsert
    , delete
    , rows
    -- * Key Types
    -- ** Primary Keys
    , Primary
    -- ** Candidate Keys
    , Candidate, CandidateInt, CandidateHash
    -- ** Supplemental Keys
    , Supplemental, SupplementalInt, SupplementalHash
    -- ** Inverted Keys
    , Inverted, InvertedInt, InvertedHash
    -- * Esoterica
    , Auto(..)
    , autoKey
    , auto
    , autoIncrement
    -- * Implementation Details
    , IsKeyType(..)
    , KeyType(..)
    , AnIndex(..)
    ) where
  
  import Control.Applicative hiding (empty)
  import Control.Comonad
  import Control.DeepSeq (NFData(rnf))
  import Control.Lens
  import Control.Monad
  import Control.Monad.Fix
  import Data.Binary (Binary)
  import qualified Data.Binary as B
  import Data.Bytes.Serial (Serial(..))
  #if __GLASGOW_HASKELL__ < 708
  import Data.Char (toUpper)
  #endif
  import Data.Data
  import Data.Foldable as F hiding (foldl1)
  import Data.Functor.Contravariant
  import Data.Function (on)
  import Data.Hashable
  import Data.HashMap.Strict (HashMap)
  import qualified Data.HashMap.Strict as HM
  import Data.HashSet (HashSet)
  import qualified Data.HashSet as HS
  import Data.IntMap (IntMap)
  import qualified Data.IntMap as IM
  import Data.IntSet (IntSet)
  import qualified Data.IntSet as IS
  import Data.Map (Map)
  import qualified Data.Map as M
  import Data.Maybe
  import Data.Monoid
  import Data.SafeCopy (SafeCopy(..), safeGet, safePut, contain)
  import Data.Serialize (Serialize)
  import qualified Data.Serialize as C
  import Data.Set (Set)
  import qualified Data.Set as S
  import Data.Traversable hiding (mapM)
  #if __GLASGOW_HASKELL__ < 708
  import Language.Haskell.TH
  #endif
  import qualified Prelude as P
  import Prelude hiding (null)
  
  {-# ANN module "HLint: ignore Reduce duplication" #-}
  {-# ANN module "HLint: ignore Eta reduce" #-}
  
  -- | This class describes how to index a user-defined data type.
  class Ord (PKT t) => Tabular (t :: *) where
    -- | The primary key type
    type PKT t
  
    -- | Used to store indices
    data Tab t (m :: * -> * -> *)
  
    -- | The type used internally for columns
    data Key (k :: *) t :: * -> *
  
    -- | Extract the value of a 'Key'
    fetch :: Key k t a -> t -> a
  
    -- | Every 'Table' has one 'Primary' 'Key'
    primary :: Key Primary t (PKT t)
  
    -- | ... and so if you find one, it had better be that one!
    primarily :: Key Primary t a -> ((a ~ PKT t) => r) -> r
  
    -- | Construct a 'Tab' given a function from key to index.
    mkTab :: Applicative h => (forall k a. IsKeyType k a => Key k t a -> h (i k a)) -> h (Tab t i)
  
    -- | Lookup an index in a 'Tab'
    ixTab :: Tab t i -> Key k t a -> i k a
  
    -- | Loop over each index in a 'Tab'
    forTab :: Applicative h => Tab t i -> (forall k a . IsKeyType k a => Key k t a -> i k a -> h (j k a)) -> h (Tab t j)
  
    -- | Adjust a record using meta-information about the table allowing for auto-increments.
    autoTab :: t -> Maybe (Tab t (AnIndex t) -> t)
    autoTab _ = Nothing
    {-# INLINE autoTab #-}
  
  -- | This lets you define 'autoKey' to increment to 1 greater than the existing maximum key in a table.
  --
  -- In order to support this you need a numeric primary key, and the ability to update the primary key in a record, indicated by a
  -- lens to the field.
  --
  -- To enable auto-increment for a table with primary key @primaryKeyField@, set:
  --
  -- @'autoTab' = 'autoIncrement' primaryKeyField@
  autoIncrement :: (Tabular t, Num (PKT t)) => ALens' t (PKT t) -> t -> Maybe (Tab t (AnIndex t) -> t)
  autoIncrement pk t
    | t ^# pk == 0 = Just $ \ tb -> t & pk #~ 1 + fromMaybe 0 (tb ^? primaryMap.traverseMax.asIndex)
    | otherwise    = Nothing
  {-# INLINE autoIncrement #-}
  
  -- | This is used to store a single index.
  data AnIndex t k a where
    PrimaryMap          ::                       Map (PKT t) t      -> AnIndex t Primary          a
    CandidateIntMap     ::                       IntMap t           -> AnIndex t CandidateInt     Int
    CandidateHashMap    :: (Eq a, Hashable a) => HashMap a t        -> AnIndex t CandidateHash    a
    CandidateMap        :: Ord a              => Map a t            -> AnIndex t Candidate        a
    InvertedIntMap      ::                       IntMap [t]         -> AnIndex t InvertedInt      IntSet
    InvertedHashMap     :: (Eq a, Hashable a) => HashMap a [t]      -> AnIndex t InvertedHash     (HashSet a)
    InvertedMap         :: Ord a              => Map a [t]          -> AnIndex t Inverted         (Set a)
    SupplementalIntMap  ::                       IntMap [t]         -> AnIndex t SupplementalInt  Int
    SupplementalHashMap :: (Eq a, Hashable a) => HashMap a [t]      -> AnIndex t SupplementalHash a
    SupplementalMap     :: Ord a              => Map a [t]          -> AnIndex t Supplemental     a
  
  -- | Find the primary key index a tab
  --
  -- Note that while this is obeys the lens laws, using this to modify the tab
  -- breaks an invariant of Table, as it only adjust the primary key's map and not
  -- any of the others!
  primaryMap :: Tabular t => Lens' (Tab t (AnIndex t)) (Map (PKT t) t)
  primaryMap f t = case ixTab t primary of
    PrimaryMap m -> f m <&> \u -> runIdentity $ forTab t $ \k o -> Identity $ case o of
      PrimaryMap _ -> primarily k (PrimaryMap u)
      _              -> o
  {-# INLINE primaryMap #-}
  
  -- * Overloaded keys
  
  ------------------------------------------------------------------------------
  -- Table
  ------------------------------------------------------------------------------
  
  -- | Every 'Table' has a 'Primary' 'key' and may have 'Candidate',
  -- 'Supplemental' or 'Inverted' keys, plus their variants.
  data Table t where
    EmptyTable ::                                   Table t
    Table      :: Tabular t => Tab t (AnIndex t) -> Table t
    deriving Typeable
  
  instance (Tabular t, Data t) => Data (Table t) where
    gfoldl f z im = z fromList `f` toList im
    toConstr _ = fromListConstr
    gunfold k z c = case constrIndex c of
      1 -> k (z fromList)
      _ -> error "gunfold"
    dataTypeOf _ = tableDataType
    dataCast1 f = gcast1 f
  
  instance (Tabular t, Binary t) => Binary (Table t) where
    put = reviews table' B.put
    get = view table' <$> B.get
  
  instance (Tabular t, Serialize t) => Serialize (Table t) where
    put = reviews table' C.put
    get = view table <$> C.get
  
  instance (Tabular t, Serial t) => Serial (Table t) where
    serialize = reviews table serialize
    deserialize = view table <$> deserialize
  
  instance (Typeable t, Tabular t, SafeCopy t) => SafeCopy (Table t) where
    putCopy = contain . reviews table' safePut
    getCopy = contain $ view table' <$> safeGet
    errorTypeName pt = show $ typeOf (undefined `asProxyTypeOf` pt)
      where asProxyTypeOf :: a -> p a -> a
            asProxyTypeOf a _ = a
  
  fromListConstr :: Constr
  fromListConstr = mkConstr tableDataType "fromList" [] Prefix
  
  tableDataType :: DataType
  tableDataType = mkDataType "Data.Table.Table" [fromListConstr]
  
  instance Monoid (Table t) where
    mempty = EmptyTable
    {-# INLINE mempty #-}
  
    EmptyTable `mappend` r          = r
    r          `mappend` EmptyTable = r
    r          `mappend` s@Table{}  = F.foldl' (flip insert) s r
    {-# INLINE mappend #-}
  
  instance Eq t => Eq (Table t) where
    (==) = (==) `on` toList
    {-# INLINE (==) #-}
  
  instance Ord t => Ord (Table t) where
    compare = compare `on` toList
    {-# INLINE compare #-}
  
  instance Show t => Show (Table t) where
    showsPrec d t = showParen (d > 10) $ showString "fromList " . showsPrec 11 (toList t)
  
  instance (Tabular t, Read t) => Read (Table t) where
    readsPrec d = readParen (d > 10) $ \r -> do
      ("fromList",s) <- lex r
      (m, t) <- readsPrec 11 s
      return (fromList m, t)
  
  instance Foldable Table where
    foldMap _ EmptyTable = mempty
    foldMap f (Table m)  = foldMapOf (primaryMap.folded) f m
    {-# INLINE foldMap #-}
  
  type instance Index (Table t) = PKT t
  type instance IxValue (Table t) = t
  
  instance Ixed (Table t) where
    ix _ _ EmptyTable = pure EmptyTable
    ix k f t@(Table m) =
      let oldRow' = m ^? primaryMap . ix k
      in case oldRow' of
        Nothing -> pure t
        Just oldRow -> f oldRow <&> \newRow -> insert newRow $ deleteWith primary (==) (fetch primary oldRow) t
    {-# INLINE ix #-}
  
  instance Tabular t => At (Table t) where
    at k f EmptyTable = maybe EmptyTable singleton <$> indexed f k Nothing
    at k f t@(Table m) =
      let oldRow' = m ^? primaryMap . ix k
      in f oldRow' <&> \newRow' -> case (oldRow', newRow') of
        (Nothing, Nothing) -> t
        (Nothing, Just newRow) -> insert newRow t
        (Just oldRow, Nothing) -> deleteWith primary (==) (fetch primary oldRow) t
        (Just oldRow, Just newRow) -> insert newRow $ deleteWith primary (==) (fetch primary oldRow) t
    {-# INLINE at #-}
  
  deleteCollisions :: Table t -> [t] -> Table t
  deleteCollisions EmptyTable _ = EmptyTable
  deleteCollisions (Table tab) ts = Table $ runIdentity $ forTab tab $ \k i -> Identity $ case i of
    PrimaryMap idx          -> PrimaryMap $ primarily k $ F.foldl' (flip (M.delete . fetch primary)) idx ts
    CandidateMap idx        -> CandidateMap             $ F.foldl' (flip (M.delete . fetch k)) idx ts
    CandidateIntMap idx     -> CandidateIntMap          $ F.foldl' (flip (IM.delete . fetch k)) idx ts
    CandidateHashMap idx    -> CandidateHashMap         $ F.foldl' (flip (HM.delete . fetch k)) idx ts
    SupplementalMap idx     -> SupplementalMap $ M.foldlWithKey' ?? idx ?? M.fromListWith (++) [ (fetch k t, [t]) | t <- ts ] $ \m ky ys ->
      m & at ky . non' _Empty %~ let pys = fetch primary <$> ys in filter (\e -> fetch primary e `P.notElem` pys)
    SupplementalIntMap idx  -> SupplementalIntMap $ IM.foldlWithKey' ?? idx ?? IM.fromListWith (++) [ (fetch k t, [t]) | t <- ts ] $ \m ky ys ->
      m & at ky . non' _Empty %~ let pys = fetch primary <$> ys in filter (\e -> fetch primary e `P.notElem` pys)
    SupplementalHashMap idx -> SupplementalHashMap $ HM.foldlWithKey' ?? idx ?? HM.fromListWith (++) [ (fetch k t, [t]) | t <- ts ] $ \m ky ys ->
      m & at ky . non' _Empty %~ let pys = fetch primary <$> ys in filter (\e -> fetch primary e `P.notElem` pys)
    InvertedMap idx         -> InvertedMap     $ M.foldlWithKey' ?? idx ?? M.fromListWith (++) [ (f, [t]) | t <- ts, f <- S.toList $ fetch k t ] $ \m ky ys ->
      m & at ky . non' _Empty %~ let pys = fetch primary <$> ys in filter (\e -> fetch primary e `P.notElem` pys)
    InvertedIntMap idx      -> InvertedIntMap  $ IM.foldlWithKey' ?? idx ?? IM.fromListWith (++) [ (f, [t]) | t <- ts, f <- IS.toList $ fetch k t ] $ \m ky ys ->
      m & at ky . non' _Empty %~ 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 . non' _Empty %~ let pys = fetch primary <$> ys in filter (\e -> fetch primary e `P.notElem` pys)
  {-# INLINE deleteCollisions #-}
  
  emptyTab :: Tabular t => Tab t (AnIndex t)
  emptyTab = runIdentity $ mkTab $ \k -> Identity $ case keyType k of
    Primary          -> primarily k (PrimaryMap M.empty)
    Candidate        -> CandidateMap        M.empty
    CandidateHash    -> CandidateHashMap    HM.empty
    CandidateInt     -> CandidateIntMap     IM.empty
    Inverted         -> InvertedMap         M.empty
    InvertedHash     -> InvertedHashMap     HM.empty
    InvertedInt      -> InvertedIntMap      IM.empty
    Supplemental     -> SupplementalMap     M.empty
    SupplementalHash -> SupplementalHashMap HM.empty
    SupplementalInt  -> SupplementalIntMap  IM.empty
  {-# INLINE emptyTab #-}
  
  
  #if __GLASGOW_HASKELL__ < 708
  -- * 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
    makeTabularFor (f p) (over (traverse._2) f ks)
    where f :: Name -> (String, Name)
          f n = (n & nameBase & _head %~ toUpper, n)
  
  -- | 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 }
  --
  -- makeTabularFor ("FooId", '_fooId) [(''Candidate, ("FooBaz", '_fooBaz)), (''Supplemental, ("FooBar", '_fooBar))]
  -- @
  makeTabularFor :: (String, Name) -> [(Name, (String, Name))] -> Q [Dec]
  makeTabularFor pp@(iName, p) ks = do
    -- Get the type name and PKT from the primary selector
    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_" ++ iName
  
    let keys = (''Primary, pp) : ks
        keyCons@(pK:_) = map (mkName.fst.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
  
    keyTypes <- map (\(VarI _ (AppT _ t) _ _) -> t) <$> mapM (reify . snd . snd) keys
    keyVars  <- mapM (newName . nameBase . snd . 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 (mkName n) [])) keys keyTypes) []
  
      , DataInstD [] ''Tab [t, a] [NormalC tabName $ zipWith
          (\(k,_) t -> (NotStrict, AppT (AppT a (ConT k)) t)) keys keyTypes] []
  
      , FunD 'fetch $ map (\(_,(n,k)) ->
          Clause [ConP (mkName n) []] (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
        ) []]
      ]]
  
  #endif
  
  -- | Construct an empty relation
  empty :: Table t
  empty = EmptyTable
  {-# INLINE empty #-}
  
  -- | Check to see if the relation is empty
  null :: Table t -> Bool
  null EmptyTable = True
  null (Table m)  = M.null (m^.primaryMap)
  {-# INLINE null #-}
  
  -- | Construct a relation with a single row
  singleton :: Tabular t => t -> Table t
  singleton row = Table $ runIdentity $ mkTab $ \ k -> Identity $ case keyType k of
    Primary          -> primarily k $ PrimaryMap $ M.singleton  (fetch k row) row
    Candidate        -> CandidateMap             $ M.singleton  (fetch k row) row
    CandidateInt     -> CandidateIntMap          $ IM.singleton (fetch k row) row
    CandidateHash    -> CandidateHashMap         $ HM.singleton (fetch k row) row
    Supplemental     -> SupplementalMap          $ M.singleton  (fetch k row) [row]
    SupplementalInt  -> SupplementalIntMap       $ IM.singleton (fetch k row) [row]
    SupplementalHash -> SupplementalHashMap      $ HM.singleton (fetch k row) [row]
  #if MIN_VERSION_containers(0,5,0)
    Inverted         -> InvertedMap              $ M.fromSet  (const [row]) (fetch k row)
    InvertedInt      -> InvertedIntMap           $ IM.fromSet (const [row]) (fetch k row)
  #else
    Inverted         -> InvertedMap              $ M.fromDistinctAscList  [ (e, [row]) | e <- S.toAscList  (fetch k row) ]
    InvertedInt      -> InvertedIntMap           $ IM.fromDistinctAscList [ (e, [row]) | e <- IS.toAscList (fetch k row) ]
  #endif
    InvertedHash     -> InvertedHashMap          $ HS.foldl' (\m k -> HM.insert k [row] m) HM.empty (fetch k row)
  {-# INLINE singleton #-}
  
  -- | Return the set of rows that would be deleted by deleting or inserting this row
  collisions :: t -> Table t -> [t]
  collisions _ EmptyTable = []
  collisions t (Table m)  = getConst $ forTab m $ \k i -> Const $ case i of
    PrimaryMap idx       -> primarily k $ idx^..ix (fetch k t)
    CandidateMap idx     ->               idx^..ix (fetch k t)
    CandidateIntMap idx  ->               idx^..ix (fetch k t)
    CandidateHashMap idx ->               idx^..ix (fetch k t)
    _                  -> []
  {-# INLINE collisions #-}
  
  -- | Delete this row from the database. This will remove any row that collides with the specified
  -- row on any primary or candidate key.
  delete :: t -> Table t -> Table t
  delete t m = deleteCollisions m (collisions t m)
  {-# INLINE delete #-}
  
  -- | 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)
  insert' t0 r = case autoTab t0 of
    Just p -> case r of
      EmptyTable -> go (p emptyTab)
      Table m    -> go (p m)
    Nothing -> go t0
    where
    go t = (,) t $ unsafeInsert t (delete t r)
    {-# INLINE go #-}
  {-# 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) . non' _Empty %~ (t:)
      SupplementalIntMap idx  -> SupplementalIntMap       $ idx & at (fetch k t) . non' _Empty %~ (t:)
      SupplementalHashMap idx -> SupplementalHashMap      $ idx & at (fetch k t) . non' _Empty %~ (t:)
      InvertedMap idx         -> InvertedMap              $ idx & flip (F.foldr $ \ik -> at ik . non' _Empty %~ (t:)) (fetch k t)
      InvertedIntMap idx      -> InvertedIntMap           $ idx & flip (IS.foldr $ \ik -> at ik . non' _Empty %~ (t:)) (fetch k t)
      InvertedHashMap idx     -> InvertedHashMap          $ idx & flip (F.foldr $ \ik -> at ik . non' _Empty %~ (t:)) (fetch k t)
  {-# INLINE unsafeInsert #-}
  
  -- | Retrieve a row count.
  count :: Table t -> Int
  count EmptyTable = 0
  count (Table m)  = M.size (m^.primaryMap)
  
  -- | Convert a list to and from a 'Table'.
  --
  -- The real isomorphism laws hold if the original list makes no use of the auto-increment
  -- functionality of the table, has no duplicates and is sorted according to the primary key.
  --
  -- However,
  --
  -- @'from' 'table' '.' 'table' ≡ 'id'@
  --
  -- always holds.
  --
  -- Note that the types of 'table' make it easy to lose inference, requiring type annotation.
  -- You may wish to considering using 'table'' instead.
  table :: (Tabular s, Tabular t) => Iso [s] [t] (Table s) (Table t)
  table = iso fromList toList
  {-# INLINE table #-}
  
  table' :: Tabular t => Iso' [t] (Table t)
  table' = table
  {-# INLINE table' #-}
  
  instance (Tabular b, PKT a ~ PKT b) => Each (Table a) (Table b) a b where
    each _ EmptyTable = pure EmptyTable
    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, 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
    -- | Group by a given key or arbitrary function.
    group :: Ord i => q -> IndexedLensLike' i f (Table t) (Table t)
  
  instance Applicative f => Group f (t -> a) t a where
    group _  _ EmptyTable = pure EmptyTable
    group ky f (Table m)  = traverse (\(k,vs) -> indexed f k (fromList vs)) (M.toList idx) <&> mconcat where
      idx = M.fromListWith (++) (m^..primaryMap.folded.to(\v -> (ky v, [v])))
    {-# INLINE group #-}
  
  instance Applicative f => Group f (Key Primary t a) t a where
    group _  _ EmptyTable = pure EmptyTable
    group ky f (Table m)  = case ixTab m ky of
      PrimaryMap idx -> primarily ky $ for (toList idx) (\v -> indexed f (fetch primary v) (singleton v)) <&> mconcat
    {-# INLINE group #-}
  
  instance Applicative f => Group f (Key Candidate t a) t a where
    group _  _ EmptyTable = pure EmptyTable
    group ky f (Table m)  = case ixTab m ky of
      CandidateMap idx -> traverse (\(k,v) -> indexed f k (singleton v)) (M.toList idx) <&> mconcat
    {-# INLINE group #-}
  
  instance (Applicative f, a ~ Int) => Group f (Key CandidateInt t a) t a where
    group _  _ EmptyTable = pure EmptyTable
    group ky f (Table m)  = case ixTab m ky of
      CandidateIntMap idx -> traverse (\(k,v) -> indexed f k (singleton v)) (IM.toList idx) <&> mconcat
    {-# INLINE group #-}
  
  instance Applicative f => Group f (Key CandidateHash t a) t a where
    group _  _ EmptyTable = pure EmptyTable
    group ky f (Table m)  = case ixTab m ky of
      CandidateHashMap idx -> traverse (\(k,v) -> indexed f k (singleton v)) (HM.toList idx) <&> mconcat
    {-# INLINE group #-}
  
  instance Applicative f => Group f (Key Supplemental t a) t a where
    group _  _ EmptyTable = pure EmptyTable
    group ky f (Table m)  = case ixTab m ky of
      SupplementalMap idx -> traverse (\(k,vs) -> indexed f k (fromList vs)) (M.toList idx) <&> mconcat
    {-# INLINE group #-}
  
  instance (Applicative f, a ~ Int) => Group f (Key SupplementalInt t a) t a where
    group _  _ EmptyTable = pure EmptyTable
    group ky f (Table m)  = case ixTab m ky of
      SupplementalIntMap idx -> traverse (\(k,vs) -> indexed f k (fromList vs)) (IM.toList idx) <&> mconcat
    {-# INLINE group #-}
  
  instance Applicative f => Group f (Key SupplementalHash t a) t a where
    group _  _ EmptyTable = pure EmptyTable
    group ky f (Table m)  = case ixTab m ky of
      SupplementalHashMap idx -> traverse (\(k,vs) -> indexed f k (fromList vs)) (HM.toList idx) <&> mconcat
    {-# INLINE group #-}
  
  instance (Applicative f, Contravariant f) => Group f (Key Inverted t (Set a)) t a where
    group _  _ EmptyTable = pure EmptyTable
    group ky f (Table m)  = case ixTab m ky of
      InvertedMap idx -> phantom $ traverse (\(k,vs) -> indexed f k (fromList vs)) $ M.toList idx
  
  instance (Applicative f, Contravariant f, a ~ Int) => Group f (Key InvertedInt t IntSet) t a where
    group _  _ EmptyTable = pure EmptyTable
    group ky f (Table m)  = case ixTab m ky of
      InvertedIntMap idx -> phantom $ traverse (\(k,vs) -> indexed f k (fromList vs)) $ IM.toList idx
  
  instance (Applicative f, Contravariant f) => Group f (Key InvertedHash t (HashSet a)) t a where
    group _  _ EmptyTable = pure EmptyTable
    group ky f (Table m)  = case ixTab m ky of
      InvertedHashMap idx -> phantom $ traverse (\(k,vs) -> indexed f k (fromList vs)) $ HM.toList idx
  
  -- | Search inverted indices
  class Withal q s t | q -> s t where
    withAny :: q -> s -> Lens' (Table t) (Table t)
    withAll ::q -> s -> Lens' (Table t) (Table t)
  
    deleteWithAny :: q -> s -> Table t -> Table t
    deleteWithAny p as t = set (withAny p as) empty t
    {-# INLINE deleteWithAny #-}
  
    deleteWithAll :: q -> s -> Table t -> Table t
    deleteWithAll p as t = set (withAll p as) empty t
    {-# INLINE deleteWithAll #-}
  
  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 (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 (unsafeFromList xs) <&> mappend (deleteCollisions r xs)
            ss = S.fromList as
    {-# INLINE withAll #-}
  
  instance Ord a => Withal (Key Inverted t (Set a)) [a] t where
    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 (unsafeFromList xs) <&> mappend (deleteCollisions r xs)
    {-# INLINE withAny #-}
  
    withAll _  _  f EmptyTable  = f EmptyTable
    withAll _  [] f r           = f r -- every row has all of an empty list of keywords
    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 (unsafeFromList xs) <&> mappend (deleteCollisions r xs)
    {-# INLINE withAll #-}
  
  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 (unsafeFromList xs) <&> mappend (deleteCollisions r xs)
    {-# INLINE withAny #-}
  
    withAll _  _  f EmptyTable  = f EmptyTable
    withAll _  [] f r           = f r -- every row has all of an empty list of keywords
    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 (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 (unsafeFromList xs) <&> mappend (deleteCollisions r xs)
    {-# INLINE withAny #-}
  
    withAll _  _  f EmptyTable  = f EmptyTable
    withAll _  [] f r           = f r -- every row has all of an empty list of keywords
    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 (unsafeFromList xs) <&> mappend (deleteCollisions r xs)
    {-# INLINE withAll #-}
  
  
  class With q t | q -> t where
    -- | Select a smaller, updateable subset of the rows of a table using an index or an arbitrary function.
    with :: Ord a => q a -> (forall x. Ord x => x -> x -> Bool) -> a -> Lens' (Table t) (Table t)
  
    -- | Delete selected rows from a table
    --
    -- @'deleteWith' p cmp a t ≡ 'set' ('with' p cmp a) 'empty' t@
    deleteWith :: Ord a => q a -> (forall x. Ord x => x -> x -> Bool) -> a -> Table t -> Table t
    deleteWith p cmp a t = set (with p cmp a) empty t
    {-# INLINE deleteWith #-}
  
  instance With ((->) t) t where
    with _  _   _ f EmptyTable  = f EmptyTable
    with ky cmp a f r@(Table m)
      | lt && eq && gt = f r
      | lt || eq || gt = go $ m^..primaryMap.folded.filtered (\row -> cmp (ky row) a)
      | otherwise      = f EmptyTable <&> mappend r
      where
        lt = cmp LT EQ
        eq = cmp EQ EQ
        gt = cmp GT EQ
        go xs = f (unsafeFromList xs) <&> mappend (deleteCollisions r xs)
    {-# INLINE with #-}
  
  instance With (Key Primary t) t where
    with _   _   _ f EmptyTable  = f EmptyTable
    with ky cmp a f r@(Table m)
      | lt && eq && gt = f r
      | not lt && eq && not gt = primarily ky $ go $ m^..primaryMap.ix a
      | lt || eq || gt = primarily ky $ go $ case M.splitLookup a (m^.primaryMap) of
          (l,e,g) -> (if lt then F.toList l else []) ++ (if eq then F.toList e else []) ++ (if gt then F.toList g else [])
      | otherwise = f EmptyTable <&> mappend r
      where
        lt = cmp LT EQ
        eq = cmp EQ EQ
        gt = cmp GT EQ
        go xs = f (unsafeFromList xs) <&> mappend (deleteCollisions r xs)
    {-# INLINE with #-}
  
  instance With (Key Candidate t) t where
    with _   _   _ f EmptyTable  = f EmptyTable
    with ky cmp a f r@(Table m)
      | lt && eq && gt = f r
      | not lt && eq && not gt = case ixTab m ky of
        CandidateMap idx    -> go $ idx^..ix a
      | lt || eq || gt = case ixTab m ky of
        CandidateMap idx -> go $ case M.splitLookup a idx of
          (l,e,g) -> (if lt then F.toList l else []) ++ (if eq then F.toList e else []) ++ (if gt then F.toList g else [])
      | otherwise = f EmptyTable <&> mappend r -- no match
      where
          lt = cmp LT EQ
          eq = cmp EQ EQ
          gt = cmp GT EQ
          go xs = f (unsafeFromList xs) <&> mappend (deleteCollisions r xs)
    {-# INLINE with #-}
  
  instance With (Key CandidateInt t) t where
    with _   _   _ f EmptyTable  = f EmptyTable
    with ky cmp a f r@(Table m)
      | lt && eq && gt = f r
      | not lt && eq && not gt = case ixTab m ky of
        CandidateIntMap idx    -> go $ idx^..ix a
      | lt || eq || gt = case ixTab m ky of
        CandidateIntMap idx -> go $ case IM.splitLookup a idx of
          (l,e,g) -> (if lt then F.toList l else []) ++ (if eq then F.toList e else []) ++ (if gt then F.toList g else [])
      | otherwise = f EmptyTable <&> mappend r -- no match
      where
          lt = cmp LT EQ
          eq = cmp EQ EQ
          gt = cmp GT EQ
          go xs = f (unsafeFromList xs) <&> mappend (deleteCollisions r xs)
    {-# INLINE with #-}
  
  instance With (Key CandidateHash t) t where
    with _   _   _ f EmptyTable  = f EmptyTable
    with ky cmp a f r@(Table m)
      | lt     && eq && gt     = f r
      | not lt && eq && not gt = case ixTab m ky of CandidateHashMap idx    -> go $ idx^..ix a
      | lt     || eq || gt     = go $ m^..primaryMap.folded.filtered (\row -> cmp (fetch ky row) a) -- table scan
      | otherwise              = f EmptyTable <&> mappend r -- no match
      where
          lt = cmp LT EQ
          eq = cmp EQ EQ
          gt = cmp GT EQ
          go xs = f (unsafeFromList xs) <&> mappend (deleteCollisions r xs)
    {-# INLINE with #-}
  
  instance With (Key Supplemental t) t where
    with _   _   _ f EmptyTable  = f EmptyTable
    with ky cmp a f r@(Table m)
      | lt && eq && gt = f r -- all rows
      | not lt && eq && not gt = case ixTab m ky of
        SupplementalMap idx -> go $ idx^..ix a.folded
      | lt || eq || gt = go $ case ixTab m ky of
        SupplementalMap idx -> case M.splitLookup a idx of
          (l,e,g) -> (if lt then F.concat l else []) ++ (if eq then F.concat e else []) ++ (if gt then F.concat g else [])
      | otherwise      = f EmptyTable <&> mappend r -- no match
      where
          lt = cmp LT EQ
          eq = cmp EQ EQ
          gt = cmp GT EQ
          go xs = f (unsafeFromList xs) <&> mappend (deleteCollisions r xs)
    {-# INLINE with #-}
  
  instance With (Key SupplementalInt t) t where
    with _   _   _ f EmptyTable  = f EmptyTable
    with ky cmp a f r@(Table m)
      | lt && eq && gt = f r -- all rows
      | not lt && eq && not gt = case ixTab m ky of
        SupplementalIntMap idx -> go $ idx^..ix a.folded
      | lt || eq || gt = go $ case ixTab m ky of
        SupplementalIntMap idx -> case IM.splitLookup a idx of
          (l,e,g) -> (if lt then F.concat l else []) ++ (if eq then F.concat e else []) ++ (if gt then F.concat g else [])
      | otherwise      = f EmptyTable <&> mappend r -- no match
      where
          lt = cmp LT EQ
          eq = cmp EQ EQ
          gt = cmp GT EQ
          go xs = f (unsafeFromList xs) <&> mappend (deleteCollisions r xs)
    {-# INLINE with #-}
  
  instance With (Key SupplementalHash t) t where
    with _   _   _ f EmptyTable  = f EmptyTable
    with ky cmp a f r@(Table m)
      |     lt && eq &&     gt = f r -- all rows
      | not lt && eq && not gt = case ixTab m ky of SupplementalHashMap idx -> go $ idx^..ix a.folded
      |     lt || eq ||     gt = go $ m^..primaryMap.folded.filtered (\row -> cmp (fetch ky row) a) -- table scan
      | otherwise              = f EmptyTable <&> mappend r -- no match
      where
          lt = cmp LT EQ
          eq = cmp EQ EQ
          gt = cmp GT EQ
          go xs = f (unsafeFromList xs) <&> mappend (deleteCollisions r xs)
    {-# INLINE with #-}
  
  -- | Build up a table from a list
  fromList :: Tabular t => [t] -> Table t
  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
  data KeyType t a where
    Primary          :: Ord a              => KeyType Primary          a
    Candidate        :: Ord a              => KeyType Candidate        a
    CandidateInt     ::                       KeyType CandidateInt     Int
    CandidateHash    :: (Eq a, Hashable a) => KeyType CandidateHash    a
    Supplemental     :: Ord a              => KeyType Supplemental     a
    SupplementalInt  ::                       KeyType SupplementalInt  Int
    SupplementalHash :: (Eq a, Hashable a) => KeyType SupplementalHash a
    Inverted         :: Ord a              => KeyType Inverted         (Set a)
    InvertedInt      ::                       KeyType InvertedInt      IntSet
    InvertedHash     :: (Eq a, Hashable a) => KeyType InvertedHash     (HashSet a)
  
  -- | 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
  
  class IsKeyType k a where
    keyType :: Key k t a -> KeyType k a
  
  instance Ord a => IsKeyType Primary a where
    keyType _ = Primary
    {-# INLINE keyType #-}
  
  instance Ord a => IsKeyType Candidate a where
    keyType _ = Candidate
    {-# INLINE keyType #-}
  
  instance a ~ Int => IsKeyType CandidateInt a where
    keyType _ = CandidateInt
    {-# INLINE keyType #-}
  
  instance (Eq a, Hashable a)=> IsKeyType CandidateHash a where
    keyType _ = CandidateHash
    {-# INLINE keyType #-}
  
  instance Ord a => IsKeyType Supplemental a where
    keyType _ = Supplemental
    {-# INLINE keyType #-}
  
  instance a ~ Int => IsKeyType SupplementalInt a where
    keyType _ = SupplementalInt
    {-# INLINE keyType #-}
  
  instance (Eq a, Hashable a)=> IsKeyType SupplementalHash a where
    keyType _ = SupplementalHash
    {-# INLINE keyType #-}
  
  instance (t ~ Set, Ord a) => IsKeyType Inverted (t a) where
    keyType _ = Inverted
    {-# INLINE keyType #-}
  
  instance IsKeyType InvertedInt IntSet where
    keyType _ = InvertedInt
    {-# INLINE keyType #-}
  
  instance (t ~ HashSet, Eq a, Hashable a) => IsKeyType InvertedHash (t a) where
    keyType _ = InvertedHash
    {-# INLINE keyType #-}
  
  ------------------------------------------------------------------------------
  -- A simple table with an auto-incremented key
  ------------------------------------------------------------------------------
  
  -- | Generate a row with an auto-incremented key
  auto :: a -> Auto a
  auto = Auto 0
  {-# INLINE auto #-}
  
  instance Field1 (Auto a) (Auto a) Int Int where
    _1 f (Auto k a) = indexed f (0 :: Int) k <&> \k' -> Auto k' a
    {-# INLINE _1 #-}
  
  instance Field2 (Auto a) (Auto b) a b where
    _2 f (Auto k a) = indexed f (1 :: Int) a <&> Auto k
    {-# INLINE _2 #-}
  
  type instance Index (Auto a) = Int
  
  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
    deriving (Eq,Ord,Show,Read,Functor,Foldable,Traversable,Data,Typeable)
  
  autoKey :: Lens' (Auto a) Int
  autoKey f (Auto k a) = f k <&> \k' -> Auto k' a
  {-# INLINE autoKey #-}
  
  instance FunctorWithIndex Int Auto where
    imap f (Auto k a) = Auto k (f k a)
    {-# INLINE imap #-}
  
  instance FoldableWithIndex Int Auto where
    ifoldMap f (Auto k a) = f k a
    {-# INLINE ifoldMap #-}
  
  instance TraversableWithIndex Int Auto where
    itraverse f (Auto k a) = Auto k <$> f k a
    {-# INLINE itraverse #-}
  
  instance Comonad Auto where
    extract (Auto _ a) = a
    {-# INLINE extract #-}
    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)
    data Key p (Auto a) b where
      AutoKey :: Key Primary (Auto a) Int
    fetch AutoKey (Auto k _) = k
    {-# INLINE fetch #-}
    primary = AutoKey
    {-# INLINE primary #-}
    primarily AutoKey r = r
    {-# INLINE primarily #-}
    mkTab f = AutoTab <$> f AutoKey
    {-# INLINE mkTab #-}
    ixTab (AutoTab x) AutoKey = x
    {-# INLINE ixTab #-}
    forTab (AutoTab x) f = AutoTab <$> f AutoKey x
    {-# INLINE forTab #-}
    autoTab = autoIncrement autoKey
    {-# INLINE autoTab #-}
  
  ------------------------------------------------------------------------------
  -- A simple key-value pair, indexed on the key
  ------------------------------------------------------------------------------
  
  -- | Simple (key, value) pairs
  instance Ord k => Tabular (k,v) where
    type PKT (k,v) = k
    data Tab (k,v) i = KVTab (i Primary k)
    data Key p (k,v) b where
      Fst :: Key Primary (k,v) k
    fetch Fst = fst
    {-# INLINE fetch #-}
    primary = Fst
    {-# INLINE primary #-}
    primarily Fst r = r
    {-# INLINE primarily #-}
    mkTab f = KVTab <$> f Fst
    {-# INLINE mkTab #-}
    ixTab (KVTab x) Fst = x
    {-# INLINE ixTab #-}
    forTab (KVTab x) f = KVTab <$> f Fst x
    {-# INLINE forTab #-}
  
  ------------------------------------------------------------------------------
  -- Set-like tables with Identity
  ------------------------------------------------------------------------------
  
  instance Ord a => Tabular (Identity a) where
    type PKT (Identity a) = a
    data Tab (Identity a) i = IdentityTab (i Primary a)
    data Key p (Identity a) b where
      Id :: Key Primary (Identity a) a
    fetch Id = extract
    {-# INLINE fetch #-}
    primary = Id
    {-# INLINE primary #-}
    primarily Id r = r
    {-# INLINE primarily #-}
    mkTab f = IdentityTab <$> f Id
    {-# INLINE mkTab #-}
    ixTab (IdentityTab x) Id = x
    {-# INLINE ixTab #-}
    forTab (IdentityTab x) f = IdentityTab <$> f Id x
    {-# INLINE forTab #-}
  
  -----------------------------------------------------------------------------
  -- A simple value for set-like tables.
  -----------------------------------------------------------------------------
  
  instance Field1 (Value a) (Value b) a b where
    _1 f (Value a) = Value <$> indexed f (0 :: Int) a
    {-# INLINE _1 #-}
  
  type instance Index (Value a) = ()
  type instance IxValue (Value a) = a
  
  instance Each (Value a) (Value b) a b where
    each f (Value a) = Value <$> f a
    {-# INLINE each #-}
  
  instance Ixed (Value a) where
    ix () pafb (Value a) = Value <$> indexed pafb () a
    {-# INLINE ix #-}
  
  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)
  
  instance Applicative Value where
    pure = Value
    {-# INLINE pure #-}
    Value f <*> Value a = Value (f a)
    {-# INLINE (<*>) #-}
  
  instance Monad Value where
    return = Value
    {-# INLINE return #-}
    Value a >>= f = f a
    {-# INLINE (>>=) #-}
  
  instance MonadFix Value where
    mfix f = let m = f (extract m) in m
    {-# INLINE mfix #-}
  
  instance Comonad Value where
    extract (Value a) = a
    {-# INLINE extract #-}
    extend f w@(Value _) = Value (f w)
    {-# INLINE extend #-}
  
  instance ComonadApply Value where
    Value f <@> Value a = Value (f a)
    {-# INLINE (<@>) #-}
  
  instance Ord a => Tabular (Value a) where
    type PKT (Value a) = a
    data Tab (Value a) i = ValueTab (i Primary a)
    data Key p (Value a) b where
      Val :: Key Primary (Value a) a
    fetch Val = extract
    {-# INLINE fetch #-}
    primary = Val
    {-# INLINE primary #-}
    primarily Val r = r
    {-# INLINE primarily #-}
    mkTab f = ValueTab <$> f Val
    {-# INLINE mkTab #-}
    ixTab (ValueTab x) Val = x
    {-# 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
  
  #if __GLASGOW_HASKELL__ < 708
  
  -- Compatibility for equality predicates across TH versions
  equalP' :: Type -> Type -> Pred
  #if MIN_VERSION_template_haskell(2,10,0)
  equalP' = AppT . AppT EqualityT
  #else
  equalP' = EqualP
  #endif
  
  -- | Compatibility shim for recent changes to template haskell's 'tySynInstD'
  tySynInstD' :: Name -> [Type] -> Type -> Dec
  #if MIN_VERSION_template_haskell(2,9,0)
  tySynInstD' fam ts r = TySynInstD fam (TySynEqn ts r)
  #else
  tySynInstD' = TySynInstD
  #endif
  
  #endif
  