{-# 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
  , keyVals
  , keyValGen
  , valueColName
  , insert
  , foldlInsert
  , 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.Text ( Text )
import qualified GHC.Exts
import           Lens.Micro ( Lens' )


-- | 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
  { KVITable v -> KeyVals
keyvals      :: KeyVals -- ^ allowed value for keys (in order)

  , KVITable v -> Key -> Key
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.

  , 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.

  , KVITable v -> Key
valuecolName :: Text  -- ^ 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
<> Key -> String
forall a. Show a => a -> String
show (KVITable v -> Key
forall v. KVITable v -> Key
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 = Text

-- | 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 = Text

-- | 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 (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 :: Key
valuecolName = KVITable v -> Key
forall v. KVITable v -> Key
valuecolName KVITable v
a
                   , keyvals :: KeyVals
keyvals = KVITable v -> KeyVals
forall v. KVITable v -> KeyVals
keyvals KVITable v
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 :: forall v.
KeyVals -> (Key -> Key) -> Map KeySpec v -> Key -> KVITable v
KVITable { keyvals :: KeyVals
keyvals = KeyVals
forall a. Monoid a => a
mempty
                    , keyvalGen :: Key -> Key
keyvalGen = Key -> Key -> Key
forall a b. a -> b -> a
const Key
""
                    , contents :: Map KeySpec v
contents = Map KeySpec v
forall a. Monoid a => a
mempty
                    , valuecolName :: Key
valuecolName = Key
"Value"
                    }

instance Functor KVITable where
  fmap :: (a -> b) -> KVITable a -> KVITable b
fmap a -> b
f KVITable a
t = KVITable :: forall v.
KeyVals -> (Key -> Key) -> Map KeySpec v -> Key -> KVITable v
KVITable { contents :: Map KeySpec b
contents = (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 -> Key
keyvalGen = KVITable a -> Key -> Key
forall v. KVITable v -> Key -> Key
keyvalGen KVITable a
t
                      , keyvals :: KeyVals
keyvals = KVITable a -> KeyVals
forall v. KVITable v -> KeyVals
keyvals KVITable a
t
                      , valuecolName :: Key
valuecolName = KVITable a -> Key
forall v. KVITable v -> Key
valuecolName KVITable a
t
                      }

instance Foldable KVITable where
  foldMap :: (a -> m) -> KVITable a -> m
foldMap a -> m
f = (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 :: (a -> f b) -> KVITable a -> f (KVITable b)
traverse a -> f b
f KVITable a
t = (\Map KeySpec b
c -> KVITable :: forall v.
KeyVals -> (Key -> Key) -> Map KeySpec v -> Key -> KVITable v
KVITable { contents :: Map KeySpec b
contents = Map KeySpec b
c
                                 , valuecolName :: Key
valuecolName = KVITable a -> Key
forall v. KVITable v -> Key
valuecolName KVITable a
t
                                 , keyvals :: KeyVals
keyvals = KVITable a -> KeyVals
forall v. KVITable v -> KeyVals
keyvals KVITable a
t
                                 , keyvalGen :: Key -> Key
keyvalGen = KVITable a -> Key -> Key
forall v. KVITable v -> Key -> Key
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)
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 (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)]
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 :: [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 :: 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.

keyVals :: Lens' (KVITable v) KeyVals
keyVals :: (KeyVals -> f KeyVals) -> KVITable v -> f (KVITable v)
keyVals KeyVals -> f KeyVals
f KVITable v
t = (\KeyVals
kvs ->
                 KVITable v
t { keyvals :: KeyVals
keyvals = KeyVals
kvs
                   , contents :: Map KeySpec v
contents =
                     let inKVS :: KeySpec -> v -> Bool
inKVS KeySpec
spec v
_ = KeySpec -> KeyVals -> Bool
forall (t :: * -> *) a a.
(Foldable t, Eq a, Eq a) =>
[(a, a)] -> [(a, t a)] -> Bool
inkv KeySpec
spec KeyVals
kvs
                         inkv :: [(a, a)] -> [(a, t a)] -> Bool
inkv [] [] = Bool
True
                         inkv ((a
sk,a
sv):[(a, a)]
srs) ((a
k,t a
vs):[(a, t a)]
kv)
                           | a
sk a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
k Bool -> Bool -> Bool
&& a
sv a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
vs = [(a, a)] -> [(a, t a)] -> Bool
inkv [(a, a)]
srs [(a, t a)]
kv
                         inkv [(a, a)]
_ [(a, t a)]
_ = Bool
False
                     in (KeySpec -> v -> Bool) -> Map KeySpec v -> Map KeySpec v
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey KeySpec -> v -> Bool
inKVS (KVITable v -> Map KeySpec v
forall v. KVITable v -> Map KeySpec v
contents KVITable v
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 :: ((Key -> Key) -> f (Key -> Key)) -> KVITable v -> f (KVITable v)
keyValGen (Key -> Key) -> f (Key -> Key)
f KVITable v
t = (\Key -> Key
n -> KVITable v
t { keyvalGen :: Key -> Key
keyvalGen = Key -> Key
n } ) ((Key -> Key) -> KVITable v) -> f (Key -> Key) -> f (KVITable v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Key -> Key) -> f (Key -> Key)
f (KVITable v -> Key -> Key
forall v. KVITable v -> Key -> Key
keyvalGen KVITable v
t)

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

valueColName :: Lens' (KVITable v) Text
valueColName :: (Key -> f Key) -> KVITable v -> f (KVITable v)
valueColName Key -> f Key
f KVITable v
t = (\Key
n -> KVITable v
t { valuecolName :: Key
valuecolName = Key
n } ) (Key -> KVITable v) -> f Key -> f (KVITable v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> f Key
f (KVITable v -> Key
forall v. KVITable v -> Key
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.

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

-- | 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.

insert :: KeySpec -> v -> KVITable v -> KVITable v
insert :: KeySpec -> v -> KVITable v -> KVITable v
insert KeySpec
keyspec v
val KVITable v
t = KVITable v
-> v -> KeyVals -> KeySpec -> KeySpec -> KeyVals -> KVITable v
forall v.
KVITable v
-> v -> KeyVals -> KeySpec -> KeySpec -> KeyVals -> KVITable v
endset KVITable v
t v
val (KVITable v -> KeyVals
forall v. KVITable v -> KeyVals
keyvals KVITable v
t) KeySpec
keyspec [] []

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

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

endset :: KVITable v -> v -> KeyVals -> KeySpec -> KeySpec -> KeyVals -> KVITable v
endset :: KVITable v
-> v -> KeyVals -> KeySpec -> KeySpec -> KeyVals -> KVITable v
endset 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 KeySpec v
contents = KeySpec -> v -> Map KeySpec v -> Map KeySpec v
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert KeySpec
spec v
val (KVITable v -> Map KeySpec v
forall v. KVITable v -> Map KeySpec v
contents KVITable v
t)
             , keyvals :: KeyVals
keyvals = KeyVals
kvbld KeyVals -> KeyVals -> KeyVals
forall a. Semigroup a => a -> a -> a
<> (KVITable v -> (Key, [Key]) -> (Key, [Key])
forall v. KVITable v -> (Key, [Key]) -> (Key, [Key])
addDefVal KVITable v
t ((Key, [Key]) -> (Key, [Key])) -> KeyVals -> KeyVals
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyVals
rkv)
             }

endset 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, Key) -> (Key, [Key])
keySpecElemToKeyVals (Key
k,Key
v) = (Key
k, if [(KeySpec, v)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(KeySpec, v)]
curTblList
                                       then [Key
v]
                                       else [Key
v, KVITable v -> Key -> Key
forall v. KVITable v -> Key -> Key
keyvalGen KVITable v
t Key
k])
      keyvals' :: KeyVals
keyvals' = KeyVals
kvbld KeyVals -> KeyVals -> KeyVals
forall a. Semigroup a => a -> a -> a
<> ((Key, Key) -> (Key, [Key])
keySpecElemToKeyVals ((Key, Key) -> (Key, [Key])) -> 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 (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 KeySpec v
contents = KeySpec -> v -> Map KeySpec v -> Map KeySpec v
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert KeySpec
spec' v
val (Map KeySpec v -> Map KeySpec v) -> Map KeySpec v -> Map KeySpec v
forall a b. (a -> b) -> a -> b
$ [(KeySpec, v)] -> Map KeySpec v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(KeySpec, v)]
updTblList
       , keyvals :: KeyVals
keyvals = KeyVals
keyvals'
       }

endset KVITable v
t v
val kvs :: KeyVals
kvs@((Key
k,[Key]
vs):KeyVals
rkvs) ((Key
sk,Key
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 Key
sv Key -> [Key] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key]
vs
                 then KeyVals
kvbld KeyVals -> KeyVals -> KeyVals
forall a. Semigroup a => a -> a -> a
<> [(Key
k, [Key]
vs)]
                 else KeyVals
kvbld KeyVals -> KeyVals -> KeyVals
forall a. Semigroup a => a -> a -> a
<> [(Key
k, Key
sv Key -> [Key] -> [Key]
forall a. a -> [a] -> [a]
: [Key]
vs)]
       in KVITable v
-> v -> KeyVals -> KeySpec -> KeySpec -> KeyVals -> KVITable v
forall v.
KVITable v
-> v -> KeyVals -> KeySpec -> KeySpec -> KeyVals -> KVITable v
endset KVITable v
t v
val KeyVals
rkvs KeySpec
srs (KeySpec
tspec KeySpec -> KeySpec -> KeySpec
forall a. Semigroup a => a -> a -> a
<> [(Key
k,Key
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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Key, [Key]) -> Key
forall a b. (a, b) -> a
fst ((Key, [Key]) -> 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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Key, Key) -> Key
forall a b. (a, b) -> a
fst ((Key, Key) -> Key) -> KeySpec -> [Key]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeySpec
srs)
    then KVITable v
-> v -> KeyVals -> KeySpec -> KeySpec -> KeyVals -> KVITable v
forall v.
KVITable v
-> v -> KeyVals -> KeySpec -> KeySpec -> KeyVals -> KVITable v
endset KVITable v
t v
val KeyVals
kvs (KeySpec
srs KeySpec -> KeySpec -> KeySpec
forall a. Semigroup a => a -> a -> a
<> [(Key
sk,Key
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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Key, [Key]) -> Key
forall a b. (a, b) -> a
fst ((Key, [Key]) -> Key) -> KeyVals -> [Key]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyVals
kvs)) ((Key, Key) -> Key
forall a b. (a, b) -> a
fst ((Key, Key) -> Key) -> KeySpec -> [Key]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeySpec
srs)
      then KVITable v
-> v -> KeyVals -> KeySpec -> KeySpec -> KeyVals -> KVITable v
forall v.
KVITable v
-> v -> KeyVals -> KeySpec -> KeySpec -> KeyVals -> KVITable v
endset KVITable v
t v
val KeyVals
kvs (KeySpec
srs KeySpec -> KeySpec -> KeySpec
forall a. Semigroup a => a -> a -> a
<> [(Key
sk,Key
sv)]) KeySpec
tspec KeyVals
kvbld
      else
        let defVal :: Key
defVal = KVITable v -> Key -> Key
forall v. KVITable v -> Key -> Key
keyvalGen KVITable v
t Key
k
            vs' :: [Key]
vs' = if Key
defVal Key -> [Key] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key]
vs then [Key]
vs else (Key
defVal Key -> [Key] -> [Key]
forall a. a -> [a] -> [a]
: [Key]
vs)
        in KVITable v
-> v -> KeyVals -> KeySpec -> KeySpec -> KeyVals -> KVITable v
forall v.
KVITable v
-> v -> KeyVals -> KeySpec -> KeySpec -> KeyVals -> KVITable v
endset KVITable v
t v
val KeyVals
rkvs ((Key
sk,Key
sv)(Key, Key) -> KeySpec -> KeySpec
forall a. a -> [a] -> [a]
:KeySpec
srs) (KeySpec
tspec KeySpec -> KeySpec -> KeySpec
forall a. Semigroup a => a -> a -> a
<> [(Key
k,Key
defVal)]) (KeyVals
kvbld KeyVals -> KeyVals -> KeyVals
forall a. Semigroup a => a -> a -> a
<> [(Key
k,[Key]
vs')])


-- | The 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.

foldlInsert :: KVITable v -> (KeySpec, v) -> KVITable v
foldlInsert :: KVITable v -> (KeySpec, v) -> KVITable v
foldlInsert KVITable v
t (KeySpec
k,v
v) = KeySpec -> v -> KVITable v -> KVITable v
forall v. KeySpec -> v -> KVITable v -> KVITable v
insert 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 :: ((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 (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 :: Map KeySpec v
contents = Map KeySpec v
forall a. Monoid a => a
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 :: KeySpec -> KVITable v -> KVITable v
delete KeySpec
k KVITable v
t = KVITable v
t { contents :: Map KeySpec v
contents = KeySpec -> Map KeySpec v -> Map KeySpec v
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (KVITable v -> KeySpec -> KeySpec
forall v. KVITable v -> KeySpec -> KeySpec
normalizeKeySpec KVITable v
t KeySpec
k) (Map KeySpec v -> Map KeySpec v) -> Map KeySpec v -> Map 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 }

-- | 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 :: (KeySpec -> v -> v) -> KeySpec -> KVITable v -> KVITable v
adjustWithKey KeySpec -> v -> v
f KeySpec
k KVITable v
t =
  KVITable v
t { contents :: Map KeySpec v
contents = (KeySpec -> v -> v) -> KeySpec -> Map KeySpec v -> Map KeySpec v
forall k a. Ord k => (k -> a -> a) -> k -> Map k a -> Map k a
Map.adjustWithKey KeySpec -> v -> v
f (KVITable v -> KeySpec -> KeySpec
forall v. KVITable v -> KeySpec -> KeySpec
normalizeKeySpec KVITable v
t KeySpec
k) (Map KeySpec v -> Map KeySpec v) -> Map KeySpec v -> Map 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 }

-- | 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 :: (v -> v) -> KeySpec -> KVITable v -> KVITable v
adjust v -> v
f KeySpec
k KVITable v
t = KVITable v
t { contents :: Map KeySpec v
contents = (v -> v) -> KeySpec -> Map KeySpec v -> Map KeySpec v
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust v -> v
f (KVITable v -> KeySpec -> KeySpec
forall v. KVITable v -> KeySpec -> KeySpec
normalizeKeySpec KVITable v
t KeySpec
k) (Map KeySpec v -> Map KeySpec v) -> Map KeySpec v -> Map 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 }

-- | 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 :: (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 KeySpec v
contents = (KeySpec -> v -> Maybe v)
-> KeySpec -> Map KeySpec v -> Map KeySpec v
forall k a. Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
Map.updateWithKey KeySpec -> v -> Maybe v
f (KVITable v -> KeySpec -> KeySpec
forall v. KVITable v -> KeySpec -> KeySpec
normalizeKeySpec KVITable v
t KeySpec
k) (Map KeySpec v -> Map KeySpec v) -> Map KeySpec v -> Map 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 }

-- | 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 :: (v -> Maybe v) -> KeySpec -> KVITable v -> KVITable v
update v -> Maybe v
f KeySpec
k KVITable v
t = KVITable v
t { contents :: Map KeySpec v
contents = (v -> Maybe v) -> KeySpec -> Map KeySpec v -> Map KeySpec v
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update v -> Maybe v
f (KVITable v -> KeySpec -> KeySpec
forall v. KVITable v -> KeySpec -> KeySpec
normalizeKeySpec KVITable v
t KeySpec
k) (Map KeySpec v -> Map KeySpec v) -> Map KeySpec v -> Map 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 }

-- | The 'rows' function returns a set of rows for the 'KVITable' as a
-- list structure, where each list 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 :: KVITable v -> [([Key], v)]
rows KVITable v
t = KeyVals -> KeySpec -> [([Key], v)]
go (KVITable v -> KeyVals
forall v. KVITable v -> KeyVals
keyvals KVITable v
t) []
  where
    go :: KeyVals -> KeySpec -> [([Key], 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 -> []
                      Just v
v -> [ ((Key, Key) -> Key
forall a b. (a, b) -> b
snd ((Key, Key) -> Key) -> KeySpec -> [Key]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeySpec
spec', v
v) ]
    go ((Key
key, [Key]
vals):KeyVals
kvs) KeySpec
spec =
      (Key -> [([Key], v)]) -> [Key] -> [([Key], v)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Key
v -> let spec' :: KeySpec
spec' = (Key
key,Key
v)(Key, Key) -> KeySpec -> KeySpec
forall a. a -> [a] -> [a]
:KeySpec
spec in KeyVals -> KeySpec -> [([Key], v)]
go KeyVals
kvs KeySpec
spec') [Key]
vals