{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}

-- | The 'KVITable' is similar to a 'Data.Map', but the keys for a
-- 'KVITable' are made up of sequences of @Key=Val@ values.  The
-- primary use of a 'KVITable' is for rendering the information in
-- various configurations and formats, although it may be used like
-- any other container.

module Data.KVITable
  (
    KVITable(KVITable)
  , Key
  , KeyVal
  , KeyVals
  , KeySpec
  , fromList
  , toList
  , Data.KVITable.lookup
  , lookup'
  , keyVals
  , keyValGen
  , valueColName
  , insert
  , insertWith
  , foldlInsert
  , foldlInsertWith
  , Data.KVITable.filter
  , adjust
  , adjustWithKey
  , delete
  , update
  , updateWithKey
  , rows
  )
where

import           Data.Function ( on )
import qualified Data.List as L
import qualified Data.Map as Map
import           Data.Name
import qualified GHC.Exts
import           Lens.Micro ( Lens' )

import           Data.KVITable.Internal.Helpers


-- | The core KeyValue Indexed Table.  This table is similar to a Map,
-- but the values are indexed by a list of Key+Value combinations, and
-- the table contents can be sparse.

-- KWQ: make fields strict?  check with tasty-bench

data KVITable v = KVITable
  { forall v. KVITable v -> KeyVals
keyvals      :: KeyVals -- ^ allowed value for keys (in order)

  , forall v. KVITable v -> Key -> KeyVal
keyvalGen    :: Key -> KeyVal
    -- ^ Function to generate the keyval if the keyval is not
    -- explicitly provided.  Provided with the Key and returns the
    -- KeyVal that should be used.

  , forall v. KVITable v -> Map KeySpec v
contents     :: Map.Map KeySpec v
    -- ^ Internal contents of the KVITable

    -- The invariant for the KVITable contents is that each KeySpec
    -- contains all keys listed in keyvals (in the same order) with
    -- the defaultKeyVal for any keys not explicitly provided for that
    -- value.

  , forall v. KVITable v -> Named HTMLStyle "column header"
valuecolName :: Named HTMLStyle "column header" -- ^ name of the value cells
  }

instance Eq v => Eq (KVITable v) where
  -- n.b. keyvals (i.e. metadata) are _not_ used for equality, only contents
  == :: KVITable v -> KVITable v -> Bool
(==) = Map KeySpec v -> Map KeySpec v -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Map KeySpec v -> Map KeySpec v -> Bool)
-> (KVITable v -> Map KeySpec v)
-> KVITable v
-> KVITable v
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` KVITable v -> Map KeySpec v
forall v. KVITable v -> Map KeySpec v
contents

instance Show v => Show (KVITable v) where
  show :: KVITable v -> String
show KVITable v
t = String
"KVITable {" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
           String
" keyvals = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> KeyVals -> String
forall a. Show a => a -> String
show (KVITable v -> KeyVals
forall v. KVITable v -> KeyVals
keyvals KVITable v
t) String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
           String
" contents = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Map KeySpec v -> String
forall a. Show a => a -> String
show (KVITable v -> Map KeySpec v
forall v. KVITable v -> Map KeySpec v
contents KVITable v
t) String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
           String
", valuecolName = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Named HTMLStyle "column header" -> String
forall a. Show a => a -> String
show (KVITable v -> Named HTMLStyle "column header"
forall v. KVITable v -> Named HTMLStyle "column header"
valuecolName KVITable v
t) String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
           String
"}"

-- | The 'Key' is the first half of a tuple that makes up the list of
-- keys (the 'KeySpec').  The second half is the 'KeyVal'.
type Key = Name "Key"

-- | The 'KeyVal' is the first half of a tuple that makes up the list of
-- keys (the 'KeySpec').  The first half is the 'Key'.
type KeyVal = Name "KeyVal"

-- | The 'KeySpec' is the list of tuples and defines the unique key
-- for a value in the 'KVITable'.
type KeySpec = [ (Key,  KeyVal ) ]

-- | The 'KeyVals' specifies all valid values for a particular 'Key'
-- in the 'KVITable'.  The set of 'KeyVals' can be provided at the
-- initialization of the 'KVITable' to ensure specific values are
-- considered (especially if rendering includes blank rows or
-- columns); if entries are added to the table with a 'KeyVal'
-- previously unknown for the 'Key', the 'KeyVals' for the table is
-- automatically updated to include the new 'KeyVal'.
type KeyVals = [ (Key, [KeyVal]) ]

-- | The KVITable semigroup is left biased (same as Data.Map).  Note
-- that joining tables can result in a table that has a different
-- keyVals sequence than either input table.

instance Semigroup (KVITable v) where
  KVITable v
a <> :: KVITable v -> KVITable v -> KVITable v
<> KVITable v
b = (KVITable v -> (KeySpec, v) -> KVITable v)
-> KVITable v -> [(KeySpec, v)] -> KVITable v
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl KVITable v -> (KeySpec, v) -> KVITable v
forall v. KVITable v -> (KeySpec, v) -> KVITable v
foldlInsert
           (KVITable v
forall a. Monoid a => a
mempty { valuecolName = valuecolName a
                   , keyvals = keyvals a
                   })
           (KVITable v -> [Item (KVITable v)]
forall v. KVITable v -> [Item (KVITable v)]
toList KVITable v
b [(KeySpec, v)] -> [(KeySpec, v)] -> [(KeySpec, v)]
forall a. Semigroup a => a -> a -> a
<> KVITable v -> [Item (KVITable v)]
forall v. KVITable v -> [Item (KVITable v)]
toList KVITable v
a)

instance Monoid (KVITable v) where
  mempty :: KVITable v
mempty = KVITable { keyvals :: KeyVals
keyvals = KeyVals
forall a. Monoid a => a
mempty
                    , keyvalGen :: Key -> KeyVal
keyvalGen = KeyVal -> Key -> KeyVal
forall a b. a -> b -> a
const KeyVal
""
                    , contents :: Map KeySpec v
contents = Map KeySpec v
forall a. Monoid a => a
mempty
                    , valuecolName :: Named HTMLStyle "column header"
valuecolName = Named HTMLStyle "column header"
"Value"
                    }

instance Functor KVITable where
  fmap :: forall a b. (a -> b) -> KVITable a -> KVITable b
fmap a -> b
f KVITable a
t = KVITable { contents :: Map KeySpec b
contents = (a -> b) -> Map KeySpec a -> Map KeySpec b
forall a b. (a -> b) -> Map KeySpec a -> Map KeySpec b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (KVITable a -> Map KeySpec a
forall v. KVITable v -> Map KeySpec v
contents KVITable a
t)
                      , keyvalGen :: Key -> KeyVal
keyvalGen = KVITable a -> Key -> KeyVal
forall v. KVITable v -> Key -> KeyVal
keyvalGen KVITable a
t
                      , keyvals :: KeyVals
keyvals = KVITable a -> KeyVals
forall v. KVITable v -> KeyVals
keyvals KVITable a
t
                      , valuecolName :: Named HTMLStyle "column header"
valuecolName = KVITable a -> Named HTMLStyle "column header"
forall v. KVITable v -> Named HTMLStyle "column header"
valuecolName KVITable a
t
                      }

instance Foldable KVITable where
  foldMap :: forall m a. Monoid m => (a -> m) -> KVITable a -> m
foldMap a -> m
f = (a -> m) -> Map KeySpec a -> m
forall m a. Monoid m => (a -> m) -> Map KeySpec a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f (Map KeySpec a -> m)
-> (KVITable a -> Map KeySpec a) -> KVITable a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KVITable a -> Map KeySpec a
forall v. KVITable v -> Map KeySpec v
contents

instance Traversable KVITable where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> KVITable a -> f (KVITable b)
traverse a -> f b
f KVITable a
t = (\Map KeySpec b
c -> KVITable { contents :: Map KeySpec b
contents = Map KeySpec b
c
                                 , valuecolName :: Named HTMLStyle "column header"
valuecolName = KVITable a -> Named HTMLStyle "column header"
forall v. KVITable v -> Named HTMLStyle "column header"
valuecolName KVITable a
t
                                 , keyvals :: KeyVals
keyvals = KVITable a -> KeyVals
forall v. KVITable v -> KeyVals
keyvals KVITable a
t
                                 , keyvalGen :: Key -> KeyVal
keyvalGen = KVITable a -> Key -> KeyVal
forall v. KVITable v -> Key -> KeyVal
keyvalGen KVITable a
t
                                 }
                 ) (Map KeySpec b -> KVITable b)
-> f (Map KeySpec b) -> f (KVITable b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Map KeySpec a -> f (Map KeySpec b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map KeySpec a -> f (Map KeySpec b)
traverse a -> f b
f (KVITable a -> Map KeySpec a
forall v. KVITable v -> Map KeySpec v
contents KVITable a
t)

instance GHC.Exts.IsList (KVITable v) where
  type Item (KVITable v) = (KeySpec, v)
  fromList :: [Item (KVITable v)] -> KVITable v
fromList = (KVITable v -> (KeySpec, v) -> KVITable v)
-> KVITable v -> [(KeySpec, v)] -> KVITable v
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl KVITable v -> (KeySpec, v) -> KVITable v
forall v. KVITable v -> (KeySpec, v) -> KVITable v
foldlInsert KVITable v
forall a. Monoid a => a
mempty
  toList :: KVITable v -> [Item (KVITable v)]
toList = Map KeySpec v -> [(KeySpec, v)]
Map KeySpec v -> [Item (Map KeySpec v)]
forall l. IsList l => l -> [Item l]
GHC.Exts.toList (Map KeySpec v -> [(KeySpec, v)])
-> (KVITable v -> Map KeySpec v) -> KVITable v -> [(KeySpec, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KVITable v -> Map KeySpec v
forall v. KVITable v -> Map KeySpec v
contents


-- | Converts a list of @([(Key,Val)], Value)@ tuples to a KVI table.

fromList :: [ GHC.Exts.Item (KVITable v) ] -> KVITable v
fromList :: forall v. [Item (KVITable v)] -> KVITable v
fromList = [Item (KVITable v)] -> KVITable v
forall l. IsList l => [Item l] -> l
GHC.Exts.fromList

-- | Converts a KVI table to a list of @([(Key,Val)], Value)@ tuples.

toList :: KVITable v -> [ GHC.Exts.Item (KVITable v) ]
toList :: forall v. KVITable v -> [Item (KVITable v)]
toList = KVITable v -> [Item (KVITable v)]
forall l. IsList l => l -> [Item l]
GHC.Exts.toList


-- | Fetch or set the keyvals list via lenses. Note that setting the keyval list
-- will drop any current contents in the table that do not have entries in the
-- keyvals list; existing entries in the table under the old keys are NOT
-- migrated to the new table entries.

keyVals :: Lens' (KVITable v) KeyVals
keyVals :: forall v (f :: * -> *).
Functor f =>
(KeyVals -> f KeyVals) -> KVITable v -> f (KVITable v)
keyVals KeyVals -> f KeyVals
f KVITable v
t = (\KeyVals
kvs ->
                 KVITable v
t { keyvals = kvs
                   , contents =
                     let inKVS KeySpec
spec v
_val =
                           KeyVals -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length KeyVals
kvs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== KeySpec -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length KeySpec
spec
                           Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (((Key, KeyVal), (Key, [KeyVal])) -> Bool
forall {t :: * -> *} {a} {a}.
(Foldable t, Eq a, Eq a) =>
((a, a), (a, t a)) -> Bool
keymatch (((Key, KeyVal), (Key, [KeyVal])) -> Bool)
-> [((Key, KeyVal), (Key, [KeyVal]))] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeySpec -> KeyVals -> [((Key, KeyVal), (Key, [KeyVal]))]
forall a b. [a] -> [b] -> [(a, b)]
zip KeySpec
spec KeyVals
kvs)
                         keymatch ((a
sk,a
sv), (a
k,t a
vs)) = a
sk a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
k Bool -> Bool -> Bool
&& a
sv a -> t a -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
vs
                     in Map.filterWithKey inKVS (contents t)
                   }
              ) (KeyVals -> KVITable v) -> f KeyVals -> f (KVITable v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyVals -> f KeyVals
f (KVITable v -> KeyVals
forall v. KVITable v -> KeyVals
keyvals KVITable v
t)


-- | Fetch or set the default 'KeyVal' generator for this 'KVITable'

keyValGen :: Lens' (KVITable v) (Key -> KeyVal)
keyValGen :: forall v (f :: * -> *).
Functor f =>
((Key -> KeyVal) -> f (Key -> KeyVal))
-> KVITable v -> f (KVITable v)
keyValGen (Key -> KeyVal) -> f (Key -> KeyVal)
f KVITable v
t = (\Key -> KeyVal
n -> KVITable v
t { keyvalGen = n } ) ((Key -> KeyVal) -> KVITable v)
-> f (Key -> KeyVal) -> f (KVITable v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Key -> KeyVal) -> f (Key -> KeyVal)
f (KVITable v -> Key -> KeyVal
forall v. KVITable v -> Key -> KeyVal
keyvalGen KVITable v
t)

-- | Fetch or set the column name for the actual value cell in the
-- 'KVITable'.

valueColName :: Lens' (KVITable v) (Named HTMLStyle "column header")
valueColName :: forall v (f :: * -> *).
Functor f =>
(Named HTMLStyle "column header"
 -> f (Named HTMLStyle "column header"))
-> KVITable v -> f (KVITable v)
valueColName Named HTMLStyle "column header"
-> f (Named HTMLStyle "column header")
f KVITable v
t = (\Named HTMLStyle "column header"
n -> KVITable v
t { valuecolName = n } ) (Named HTMLStyle "column header" -> KVITable v)
-> f (Named HTMLStyle "column header") -> f (KVITable v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Named HTMLStyle "column header"
-> f (Named HTMLStyle "column header")
f (KVITable v -> Named HTMLStyle "column header"
forall v. KVITable v -> Named HTMLStyle "column header"
valuecolName KVITable v
t)


-- | Retrieve an entry from the KVITable given a keyspec.  The keyspec
-- may be minimally specified (i.e. it does not need to contain keys
-- whose value is the default key value) and it may present the keys
-- out of order and the lookup will still succeed (if there is a value
-- for the normalized keyspec), but it will be faster to use the
-- normalized key directly.
--
-- The performance of lookup degrades exponentially on a sparse KVITable: an
-- unset KVITable entry is indistinguishable from a non-normalized keyspec, so if
-- the initial query fails, the keyspec is normalized and then the lookup is
-- re-attempted.  This may be fine for an individual query, but for large numbers
-- of queries this is excessively slow.  To mitigate this, the lookup' can be
-- used, which assumes the use of a normalized key.

lookup :: KeySpec -> KVITable v -> Maybe v
lookup :: forall v. KeySpec -> KVITable v -> Maybe v
lookup KeySpec
keyspec KVITable v
t = case KeySpec -> Map KeySpec v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeySpec
keyspec (Map KeySpec v -> Maybe v) -> Map KeySpec v -> Maybe v
forall a b. (a -> b) -> a -> b
$ KVITable v -> Map KeySpec v
forall v. KVITable v -> Map KeySpec v
contents KVITable v
t of
                     Just v
v -> v -> Maybe v
forall a. a -> Maybe a
Just v
v
                     Maybe v
Nothing ->
                       -- keyspec might be under-specified or in a different order
                       let ks :: KeySpec
ks = KVITable v -> KeySpec -> KeySpec
forall v. KVITable v -> KeySpec -> KeySpec
normalizeKeySpec KVITable v
t KeySpec
keyspec
                       in KeySpec -> Map KeySpec v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeySpec
ks (Map KeySpec v -> Maybe v) -> Map KeySpec v -> Maybe v
forall a b. (a -> b) -> a -> b
$ KVITable v -> Map KeySpec v
forall v. KVITable v -> Map KeySpec v
contents KVITable v
t

normalizeKeySpec :: KVITable v -> KeySpec -> KeySpec
normalizeKeySpec :: forall v. KVITable v -> KeySpec -> KeySpec
normalizeKeySpec KVITable v
t KeySpec
keyspec =
  let keyandval :: KeySpec -> (Key, [KeyVal]) -> KeySpec
keyandval KeySpec
s (Key
k,[KeyVal]
vs) = case Key -> KeySpec -> Maybe KeyVal
forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup Key
k KeySpec
keyspec of
        Just KeyVal
v ->
          if KeyVal
v KeyVal -> [KeyVal] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KeyVal]
vs then KeySpec -> (Key, KeyVal) -> KeySpec
forall a. [a] -> a -> [a]
snoc KeySpec
s (Key
k,KeyVal
v)
          else KeySpec
s -- no level added, so this should never match in the Map
        Maybe KeyVal
Nothing -> KeySpec -> (Key, KeyVal) -> KeySpec
forall a. [a] -> a -> [a]
snoc KeySpec
s (Key
k, KVITable v -> Key -> KeyVal
forall v. KVITable v -> Key -> KeyVal
keyvalGen KVITable v
t Key
k)
  in (KeySpec -> (Key, [KeyVal]) -> KeySpec)
-> KeySpec -> KeyVals -> KeySpec
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl KeySpec -> (Key, [KeyVal]) -> KeySpec
keyandval KeySpec
forall a. Monoid a => a
mempty (KVITable v -> KeyVals
forall v. KVITable v -> KeyVals
keyvals KVITable v
t)


-- | Like 'lookup', but assumes a normalized key (all key elements specified, and
-- in the proper order).  Faster than 'lookup', but will return false negatives
-- if not used with a normalized key.

lookup' :: KeySpec -> KVITable v -> Maybe v
lookup' :: forall v. KeySpec -> KVITable v -> Maybe v
lookup' KeySpec
keyspec = KeySpec -> Map KeySpec v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeySpec
keyspec (Map KeySpec v -> Maybe v)
-> (KVITable v -> Map KeySpec v) -> KVITable v -> Maybe v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KVITable v -> Map KeySpec v
forall v. KVITable v -> Map KeySpec v
contents

-- | Inserts a new cell value into the table at the specified keyspec
-- location.  The keyspec may be minimally specified and out-of-order.
--
-- This may be an expensive operation if it has to extend the keyvals
-- for the table.  In general, insertion is expected to be less
-- frequent than lookups so computation costs are biased towards the
-- insertion operation.
--
-- This is equivalent to @insertWith const@.

insert :: KeySpec -> v -> KVITable v -> KVITable v
insert :: forall v. KeySpec -> v -> KVITable v -> KVITable v
insert = (v -> v -> v) -> KeySpec -> v -> KVITable v -> KVITable v
forall v. (v -> v -> v) -> KeySpec -> v -> KVITable v -> KVITable v
insertWith v -> v -> v
forall a b. a -> b -> a
const

-- | Inserts a new cell value into the table at the specified keyspec
-- location, if no value exists at that location. Otherwise, the old and
-- new value are combined via @f new old@.  The keyspec may be minimally
-- specified and out-of-order.
--
-- This may be an expensive operation if it has to extend the keyvals
-- for the table.  In general, insertion is expected to be less
-- frequent than lookups so computation costs are biased towards the
-- insertion operation.

insertWith :: (v -> v -> v) -> KeySpec -> v -> KVITable v -> KVITable v
insertWith :: forall v. (v -> v -> v) -> KeySpec -> v -> KVITable v -> KVITable v
insertWith v -> v -> v
f KeySpec
keyspec v
val KVITable v
t = (v -> v -> v)
-> KVITable v
-> v
-> KeyVals
-> KeySpec
-> KeySpec
-> KeyVals
-> KVITable v
forall v.
(v -> v -> v)
-> KVITable v
-> v
-> KeyVals
-> KeySpec
-> KeySpec
-> KeyVals
-> KVITable v
endsetWith v -> v -> v
f KVITable v
t v
val (KVITable v -> KeyVals
forall v. KVITable v -> KeyVals
keyvals KVITable v
t) KeySpec
keyspec KeySpec
forall a. Monoid a => a
mempty KeyVals
forall a. Monoid a => a
mempty

remainingKeyValDefaults :: KVITable v -> [(Key,a)] -> KeySpec
remainingKeyValDefaults :: forall v a. KVITable v -> [(Key, a)] -> KeySpec
remainingKeyValDefaults KVITable v
t = ((Key, a) -> (Key, KeyVal)) -> [(Key, a)] -> KeySpec
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Key
k,a
_) -> (Key
k, KVITable v -> Key -> KeyVal
forall v. KVITable v -> Key -> KeyVal
keyvalGen KVITable v
t Key
k))

addDefVal :: KVITable v -> (Key, [KeyVal]) ->  (Key, [KeyVal])
addDefVal :: forall v. KVITable v -> (Key, [KeyVal]) -> (Key, [KeyVal])
addDefVal KVITable v
t e :: (Key, [KeyVal])
e@(Key
k,[KeyVal]
vs) = if (KVITable v -> Key -> KeyVal
forall v. KVITable v -> Key -> KeyVal
keyvalGen KVITable v
t Key
k) KeyVal -> [KeyVal] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KeyVal]
vs
                       then (Key, [KeyVal])
e
                       else (Key
k, KVITable v -> Key -> KeyVal
forall v. KVITable v -> Key -> KeyVal
keyvalGen KVITable v
t Key
k KeyVal -> [KeyVal] -> [KeyVal]
forall a. a -> [a] -> [a]
: [KeyVal]
vs)

endsetWith :: (v -> v -> v) -> KVITable v -> v -> KeyVals -> KeySpec -> KeySpec -> KeyVals -> KVITable v
endsetWith :: forall v.
(v -> v -> v)
-> KVITable v
-> v
-> KeyVals
-> KeySpec
-> KeySpec
-> KeyVals
-> KVITable v
endsetWith v -> v -> v
f KVITable v
t v
val KeyVals
rkv [] KeySpec
tspec KeyVals
kvbld =
        -- Reached the end of the user's keyspec but there are more
        -- known keyvals in this KVITable, so add the entry with the
        -- default KeyVal for the remaining keyspec (and ensure the
        -- default KeyVal is listed in the table's keyvals).
        let spec :: KeySpec
spec = KeySpec
tspec KeySpec -> KeySpec -> KeySpec
forall a. Semigroup a => a -> a -> a
<> KVITable v -> KeyVals -> KeySpec
forall v a. KVITable v -> [(Key, a)] -> KeySpec
remainingKeyValDefaults KVITable v
t KeyVals
rkv
        in KVITable v
t { contents = Map.insertWith f spec val (contents t)
             , keyvals = kvbld <> (addDefVal t <$> rkv)
             }

endsetWith v -> v -> v
f KVITable v
t v
val [] KeySpec
spec KeySpec
tspec KeyVals
kvbld =
  -- Reached the end of the known keyvals for this table but the
  -- user's keyspec has additional elements.  This should extend
  -- the tables keyvals with the remaining keyspec; also all
  -- existing table values should be pushed out to use the
  -- default values for the new keys in their keyspec.
  let spec' :: KeySpec
spec' = KeySpec
tspec KeySpec -> KeySpec -> KeySpec
forall a. Semigroup a => a -> a -> a
<> KeySpec
spec
      keySpecElemToKeyVals :: (Key, KeyVal) -> (Key, [KeyVal])
keySpecElemToKeyVals (Key
k,KeyVal
v) = (Key
k, if [(KeySpec, v)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(KeySpec, v)]
curTblList
                                       then KeyVal -> [KeyVal]
forall e. e -> [e]
single KeyVal
v
                                       else [KeyVal
v, KVITable v -> Key -> KeyVal
forall v. KVITable v -> Key -> KeyVal
keyvalGen KVITable v
t Key
k])
      keyvals' :: KeyVals
keyvals' = KeyVals
kvbld KeyVals -> KeyVals -> KeyVals
forall a. Semigroup a => a -> a -> a
<> ((Key, KeyVal) -> (Key, [KeyVal])
keySpecElemToKeyVals ((Key, KeyVal) -> (Key, [KeyVal])) -> KeySpec -> KeyVals
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeySpec
spec)
      curTblList :: [(KeySpec, v)]
curTblList = Map KeySpec v -> [(KeySpec, v)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map KeySpec v -> [(KeySpec, v)])
-> Map KeySpec v -> [(KeySpec, v)]
forall a b. (a -> b) -> a -> b
$ KVITable v -> Map KeySpec v
forall v. KVITable v -> Map KeySpec v
contents KVITable v
t
      defaultsExtension :: KeySpec
defaultsExtension = KVITable v -> KeySpec -> KeySpec
forall v a. KVITable v -> [(Key, a)] -> KeySpec
remainingKeyValDefaults KVITable v
t KeySpec
spec
      updTblList :: [(KeySpec, v)]
updTblList = ((KeySpec, v) -> (KeySpec, v)) -> [(KeySpec, v)] -> [(KeySpec, v)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(KeySpec
ks,v
v) -> (KeySpec
ks KeySpec -> KeySpec -> KeySpec
forall a. Semigroup a => a -> a -> a
<> KeySpec
defaultsExtension, v
v)) [(KeySpec, v)]
curTblList
  in KVITable v
t { contents = Map.insertWith f spec' val $ Map.fromList updTblList
       , keyvals = keyvals'
       }

endsetWith v -> v -> v
f KVITable v
t v
val kvs :: KeyVals
kvs@((Key
k,[KeyVal]
vs):KeyVals
rkvs) ((Key
sk,KeyVal
sv):KeySpec
srs) KeySpec
tspec KeyVals
kvbld =
  if Key
k Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
sk
  then let kv' :: KeyVals
kv' = if KeyVal
sv KeyVal -> [KeyVal] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KeyVal]
vs
                 then KeyVals -> (Key, [KeyVal]) -> KeyVals
forall a. [a] -> a -> [a]
snoc KeyVals
kvbld (Key
k, [KeyVal]
vs)
                 else KeyVals -> (Key, [KeyVal]) -> KeyVals
forall a. [a] -> a -> [a]
snoc KeyVals
kvbld (Key
k, KeyVal
sv KeyVal -> [KeyVal] -> [KeyVal]
forall a. a -> [a] -> [a]
: [KeyVal]
vs)
       in (v -> v -> v)
-> KVITable v
-> v
-> KeyVals
-> KeySpec
-> KeySpec
-> KeyVals
-> KVITable v
forall v.
(v -> v -> v)
-> KVITable v
-> v
-> KeyVals
-> KeySpec
-> KeySpec
-> KeyVals
-> KVITable v
endsetWith v -> v -> v
f KVITable v
t v
val KeyVals
rkvs KeySpec
srs (KeySpec -> (Key, KeyVal) -> KeySpec
forall a. [a] -> a -> [a]
snoc KeySpec
tspec (Key
k,KeyVal
sv)) KeyVals
kv'
  else
    -- re-arrange user spec crudely by throwing invalid
    -- candidates to the end and retrying.  This isn't
    -- necessarily efficient, but keyspecs aren't expected to be
    -- longer than about a dozen entries.
    if Key
sk Key -> [Key] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Key, [KeyVal]) -> Key
forall a b. (a, b) -> a
fst ((Key, [KeyVal]) -> Key) -> KeyVals -> [Key]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyVals
rkvs) Bool -> Bool -> Bool
&& Key
k Key -> [Key] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Key, KeyVal) -> Key
forall a b. (a, b) -> a
fst ((Key, KeyVal) -> Key) -> KeySpec -> [Key]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeySpec
srs)
    then (v -> v -> v)
-> KVITable v
-> v
-> KeyVals
-> KeySpec
-> KeySpec
-> KeyVals
-> KVITable v
forall v.
(v -> v -> v)
-> KVITable v
-> v
-> KeyVals
-> KeySpec
-> KeySpec
-> KeyVals
-> KVITable v
endsetWith v -> v -> v
f KVITable v
t v
val KeyVals
kvs (KeySpec -> (Key, KeyVal) -> KeySpec
forall a. [a] -> a -> [a]
snoc KeySpec
srs (Key
sk,KeyVal
sv)) KeySpec
tspec KeyVals
kvbld
    else
      if (Key -> Bool) -> [Key] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Key -> [Key] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Key, [KeyVal]) -> Key
forall a b. (a, b) -> a
fst ((Key, [KeyVal]) -> Key) -> KeyVals -> [Key]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyVals
kvs)) ((Key, KeyVal) -> Key
forall a b. (a, b) -> a
fst ((Key, KeyVal) -> Key) -> KeySpec -> [Key]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeySpec
srs)
      then (v -> v -> v)
-> KVITable v
-> v
-> KeyVals
-> KeySpec
-> KeySpec
-> KeyVals
-> KVITable v
forall v.
(v -> v -> v)
-> KVITable v
-> v
-> KeyVals
-> KeySpec
-> KeySpec
-> KeyVals
-> KVITable v
endsetWith v -> v -> v
f KVITable v
t v
val KeyVals
kvs (KeySpec -> (Key, KeyVal) -> KeySpec
forall a. [a] -> a -> [a]
snoc KeySpec
srs (Key
sk,KeyVal
sv)) KeySpec
tspec KeyVals
kvbld
      else
        let defVal :: KeyVal
defVal = KVITable v -> Key -> KeyVal
forall v. KVITable v -> Key -> KeyVal
keyvalGen KVITable v
t Key
k
            vs' :: [KeyVal]
vs' = if KeyVal
defVal KeyVal -> [KeyVal] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KeyVal]
vs then [KeyVal]
vs else (KeyVal
defVal KeyVal -> [KeyVal] -> [KeyVal]
forall a. a -> [a] -> [a]
: [KeyVal]
vs)
        in (v -> v -> v)
-> KVITable v
-> v
-> KeyVals
-> KeySpec
-> KeySpec
-> KeyVals
-> KVITable v
forall v.
(v -> v -> v)
-> KVITable v
-> v
-> KeyVals
-> KeySpec
-> KeySpec
-> KeyVals
-> KVITable v
endsetWith v -> v -> v
f KVITable v
t v
val KeyVals
rkvs ((Key
sk,KeyVal
sv)(Key, KeyVal) -> KeySpec -> KeySpec
forall a. a -> [a] -> [a]
:KeySpec
srs) (KeySpec -> (Key, KeyVal) -> KeySpec
forall a. [a] -> a -> [a]
snoc KeySpec
tspec (Key
k,KeyVal
defVal)) (KeyVals -> (Key, [KeyVal]) -> KeyVals
forall a. [a] -> a -> [a]
snoc KeyVals
kvbld (Key
k,[KeyVal]
vs'))


-- | foldlInsert is a convenience function that can be specified
-- as the function argument of a foldl operation over the list form of
-- a KVITable to generate the associated KVITable.
--
-- This is equivalent to @foldlInsertWith const@.

foldlInsert :: KVITable v -> (KeySpec, v) -> KVITable v
foldlInsert :: forall v. KVITable v -> (KeySpec, v) -> KVITable v
foldlInsert = (v -> v -> v) -> KVITable v -> (KeySpec, v) -> KVITable v
forall v. (v -> v -> v) -> KVITable v -> (KeySpec, v) -> KVITable v
foldlInsertWith v -> v -> v
forall a b. a -> b -> a
const

-- | foldlInsertWith is a convenience function that, when curried with a
-- "combining" function, can be specified as the function argument of a foldl
-- operation over the list form of a KVITable to generate the associated
-- KVITable.

foldlInsertWith :: (v -> v -> v) -> KVITable v -> (KeySpec, v) -> KVITable v
foldlInsertWith :: forall v. (v -> v -> v) -> KVITable v -> (KeySpec, v) -> KVITable v
foldlInsertWith v -> v -> v
f KVITable v
t (KeySpec
k,v
v) = (v -> v -> v) -> KeySpec -> v -> KVITable v -> KVITable v
forall v. (v -> v -> v) -> KeySpec -> v -> KVITable v -> KVITable v
insertWith v -> v -> v
f KeySpec
k v
v KVITable v
t


-- | Filter 'KVITable' to retain only the elements that satisfy some predicate.

filter :: ((KeySpec, v) -> Bool) -> KVITable v -> KVITable v
filter :: forall v. ((KeySpec, v) -> Bool) -> KVITable v -> KVITable v
filter (KeySpec, v) -> Bool
f KVITable v
t = (KVITable v -> (KeySpec, v) -> KVITable v)
-> KVITable v -> [(KeySpec, v)] -> KVITable v
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl KVITable v -> (KeySpec, v) -> KVITable v
chkInsert (KVITable v -> KVITable v
forall {v} {v}. KVITable v -> KVITable v
emptyClone KVITable v
t) ([(KeySpec, v)] -> KVITable v) -> [(KeySpec, v)] -> KVITable v
forall a b. (a -> b) -> a -> b
$ KVITable v -> [Item (KVITable v)]
forall v. KVITable v -> [Item (KVITable v)]
toList KVITable v
t
  where emptyClone :: KVITable v -> KVITable v
emptyClone KVITable v
o = KVITable v
o { contents = mempty }
        chkInsert :: KVITable v -> (KeySpec, v) -> KVITable v
chkInsert KVITable v
o (KeySpec
k,v
v) = if (KeySpec, v) -> Bool
f (KeySpec
k,v
v) then KeySpec -> v -> KVITable v -> KVITable v
forall v. KeySpec -> v -> KVITable v -> KVITable v
insert KeySpec
k v
v KVITable v
o else KVITable v
o

-- | Delete the value at the specified keyspec location in the
-- 'KVITable'.  If the keyspec does not exist, the original table is
-- returned.

delete :: KeySpec -> KVITable v -> KVITable v
delete :: forall v. KeySpec -> KVITable v -> KVITable v
delete KeySpec
k KVITable v
t = KVITable v
t { contents = Map.delete (normalizeKeySpec t k) $ contents t }

-- | Adjust a value at the specified keyspec; return the original
-- 'KVITable' if that keyspec is not found in the table.

adjustWithKey :: (KeySpec -> v -> v) -> KeySpec -> KVITable v -> KVITable v
adjustWithKey :: forall v.
(KeySpec -> v -> v) -> KeySpec -> KVITable v -> KVITable v
adjustWithKey KeySpec -> v -> v
f KeySpec
k KVITable v
t =
  KVITable v
t { contents = Map.adjustWithKey f (normalizeKeySpec t k) $ contents t }

-- | Adjust a value at the specified keyspec; return the original
-- 'KVITable' if that keyspec is not found in the table.

adjust :: (v -> v) -> KeySpec -> KVITable v -> KVITable v
adjust :: forall v. (v -> v) -> KeySpec -> KVITable v -> KVITable v
adjust v -> v
f KeySpec
k KVITable v
t = KVITable v
t { contents = Map.adjust f (normalizeKeySpec t k) $ contents t }

-- | Update the 'KVITable' to remove or set a new value for the
-- specified entry if the updating function returns @Nothing@ or @Just
-- v@, respectively.  The update function is passed both the keyspec
-- and the current value at that key.  If the value does not exist in
-- the table, the original table is returned.

updateWithKey :: (KeySpec -> v -> Maybe v) -> KeySpec -> KVITable v -> KVITable v
updateWithKey :: forall v.
(KeySpec -> v -> Maybe v) -> KeySpec -> KVITable v -> KVITable v
updateWithKey KeySpec -> v -> Maybe v
f KeySpec
k KVITable v
t =
  KVITable v
t { contents = Map.updateWithKey f (normalizeKeySpec t k) $ contents t }

-- | Update the 'KVITable' to remove or set a new value for the
-- specified entry if the updating function returns @Nothing@ or @Just
-- v@, respectively.  The update function is passed the value for the
-- keyspec to be updated. If the value does not exist in the table,
-- the original table is returned.

update :: (v -> Maybe v) -> KeySpec -> KVITable v -> KVITable v
update :: forall v. (v -> Maybe v) -> KeySpec -> KVITable v -> KVITable v
update v -> Maybe v
f KeySpec
k KVITable v
t = KVITable v
t { contents = Map.update f (normalizeKeySpec t k) $ contents t }

-- | The 'rows' function returns a set of rows for the 'KVITable' as a
-- list structure, where each returned entry is a different row.  A row
-- consists of the /values/ of the keys for that row followed by the
-- value of the entry (to get the names of the keys, use 'keyVals').

rows :: KVITable v -> [ ([KeyVal], v) ]
rows :: forall v. KVITable v -> [([KeyVal], v)]
rows KVITable v
t = KeyVals -> KeySpec -> [([KeyVal], v)]
go (KVITable v -> KeyVals
forall v. KVITable v -> KeyVals
keyvals KVITable v
t) KeySpec
forall a. Monoid a => a
mempty
  where
    go :: KeyVals -> KeySpec -> [([KeyVal], v)]
go [] KeySpec
spec = let spec' :: KeySpec
spec' = KeySpec -> KeySpec
forall a. [a] -> [a]
reverse KeySpec
spec
                 in case KeySpec -> Map KeySpec v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeySpec
spec' (KVITable v -> Map KeySpec v
forall v. KVITable v -> Map KeySpec v
contents KVITable v
t) of
                      Maybe v
Nothing -> [([KeyVal], v)]
forall a. Monoid a => a
mempty
                      Just v
v -> ([KeyVal], v) -> [([KeyVal], v)]
forall e. e -> [e]
single ((Key, KeyVal) -> KeyVal
forall a b. (a, b) -> b
snd ((Key, KeyVal) -> KeyVal) -> KeySpec -> [KeyVal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeySpec
spec', v
v)
    go ((Key
key, [KeyVal]
vals):KeyVals
kvs) KeySpec
spec =
      (KeyVal -> [([KeyVal], v)]) -> [KeyVal] -> [([KeyVal], v)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\KeyVal
v -> let spec' :: KeySpec
spec' = (Key
key,KeyVal
v)(Key, KeyVal) -> KeySpec -> KeySpec
forall a. a -> [a] -> [a]
:KeySpec
spec in KeyVals -> KeySpec -> [([KeyVal], v)]
go KeyVals
kvs KeySpec
spec') [KeyVal]
vals