{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Drasil.Database.ChunkDB (
  -- * Core database types and functions.
  ChunkDB,
  empty, fromList,
  registered, typesRegistered, size,
  isRegistered,
  findUnused,
  find, findOrErr,
  findAll, findAll',
  dependants, dependantsOrErr,
  findTypeOf,
  insert, insertAll,
  -- * Temporary functions
  insertAllOutOfOrder11,
) where

import Control.Lens ((^.))
import Data.Foldable (foldl')
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Typeable (Proxy (Proxy), TypeRep, Typeable, typeOf, typeRep)

-- NOTE: Strictness is important for (a) performance, (b) space leaks, (c)
-- avoiding chunk dependancy cycles and (d) ensuring operation consistency with
-- other databases.
import qualified Data.Map.Strict as M

import qualified Data.Set as S

import Drasil.Database.Chunk (Chunk, HasChunkRefs(chunkRefs), IsChunk,
  mkChunk, unChunk, chunkType)
import Drasil.Database.UID (HasUID(..), UID)
import Utils.Drasil (invert)

-- | A chunk that depends on another.
type Dependant = UID

-- | Mapping of 'UID's to 'Chunk's and their dependants.
type ChunkByUID = M.Map UID (Chunk, [Dependant])

-- | Mapping of chunk types to lists of instances of them (chunks).
type ChunksByTypeRep = M.Map TypeRep [Chunk]

-- | Drasil's knowledge database.
data ChunkDB = ChunkDB {
    ChunkDB -> ChunkByUID
chunkTable     :: ChunkByUID
  , ChunkDB -> ChunksByTypeRep
chunkTypeTable :: ChunksByTypeRep
}

-- | An empty 'ChunkDB'.
empty :: ChunkDB
empty :: ChunkDB
empty = ChunkByUID -> ChunksByTypeRep -> ChunkDB
ChunkDB ChunkByUID
forall k a. Map k a
M.empty ChunksByTypeRep
forall k a. Map k a
M.empty

-- | Create a 'ChunkDB' from a list of chunks. This will insert all chunks into
-- the database from the list, from left to right.
fromList :: IsChunk a => [a] -> ChunkDB
fromList :: forall a. IsChunk a => [a] -> ChunkDB
fromList = ([a] -> ChunkDB -> ChunkDB) -> ChunkDB -> [a] -> ChunkDB
forall a b c. (a -> b -> c) -> b -> a -> c
flip [a] -> ChunkDB -> ChunkDB
forall a. IsChunk a => [a] -> ChunkDB -> ChunkDB
insertAll ChunkDB
empty

-- | Query the 'ChunkDB' for all registered chunks (by their 'UID's).
registered :: ChunkDB -> [UID]
registered :: ChunkDB -> [UID]
registered = ChunkByUID -> [UID]
forall k a. Map k a -> [k]
M.keys (ChunkByUID -> [UID])
-> (ChunkDB -> ChunkByUID) -> ChunkDB -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChunkDB -> ChunkByUID
chunkTable

-- | Check if a 'UID' is registered in the 'ChunkDB'.
isRegistered :: UID -> ChunkDB -> Bool
isRegistered :: UID -> ChunkDB -> Bool
isRegistered UID
u = UID -> ChunkByUID -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member UID
u (ChunkByUID -> Bool) -> (ChunkDB -> ChunkByUID) -> ChunkDB -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChunkDB -> ChunkByUID
chunkTable

-- | Enumerate all types registered in the 'ChunkDB'.
typesRegistered :: ChunkDB -> [TypeRep]
typesRegistered :: ChunkDB -> [TypeRep]
typesRegistered = ChunksByTypeRep -> [TypeRep]
forall k a. Map k a -> [k]
M.keys (ChunksByTypeRep -> [TypeRep])
-> (ChunkDB -> ChunksByTypeRep) -> ChunkDB -> [TypeRep]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChunkDB -> ChunksByTypeRep
chunkTypeTable

-- | Get the number of chunks registered in the 'ChunkDB'.
size :: ChunkDB -> Int
size :: ChunkDB -> Int
size = ChunkByUID -> Int
forall k a. Map k a -> Int
M.size (ChunkByUID -> Int) -> (ChunkDB -> ChunkByUID) -> ChunkDB -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChunkDB -> ChunkByUID
chunkTable

-- | Filter the 'ChunkDB' for chunks that are not needed by any other chunks.
-- These are the only chunks that can safely be removed from the database,
-- though we do not include this functionality.
findUnused :: ChunkDB -> [UID]
findUnused :: ChunkDB -> [UID]
findUnused = ChunkByUID -> [UID]
forall k a. Map k a -> [k]
M.keys (ChunkByUID -> [UID])
-> (ChunkDB -> ChunkByUID) -> ChunkDB -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Chunk, [UID]) -> Bool) -> ChunkByUID -> ChunkByUID
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (\(Chunk
_, [UID]
refs) -> [UID] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UID]
refs) (ChunkByUID -> ChunkByUID)
-> (ChunkDB -> ChunkByUID) -> ChunkDB -> ChunkByUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChunkDB -> ChunkByUID
chunkTable

-- | Find a chunk by its 'UID' in the 'ChunkDB'.
find :: Typeable a => UID -> ChunkDB -> Maybe a
find :: forall a. Typeable a => UID -> ChunkDB -> Maybe a
find UID
u ChunkDB
cdb = do
  (Chunk
c', [UID]
_) <- UID -> ChunkByUID -> Maybe (Chunk, [UID])
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup UID
u (ChunkDB -> ChunkByUID
chunkTable ChunkDB
cdb)
  Chunk -> Maybe a
forall a. Typeable a => Chunk -> Maybe a
unChunk Chunk
c'

-- | Find a chunk by its 'UID' in the 'ChunkDB', throwing a hard error if it is
-- not found.
findOrErr :: forall a. Typeable a => UID -> ChunkDB -> a
findOrErr :: forall a. Typeable a => UID -> ChunkDB -> a
findOrErr UID
u = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"Failed to find chunk " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UID -> [Char]
forall a. Show a => a -> [Char]
show UID
u [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" (expected type: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TypeRep -> [Char]
forall a. Show a => a -> [Char]
show (Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")") (Maybe a -> a) -> (ChunkDB -> Maybe a) -> ChunkDB -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UID -> ChunkDB -> Maybe a
forall a. Typeable a => UID -> ChunkDB -> Maybe a
find UID
u

-- | Find all chunks of a specific type in the 'ChunkDB'.
findAll :: forall a. IsChunk a => ChunkDB -> [a]
findAll :: forall a. IsChunk a => ChunkDB -> [a]
findAll ChunkDB
cdb = [a] -> ([Chunk] -> [a]) -> Maybe [Chunk] -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Chunk -> Maybe a) -> [Chunk] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Chunk -> Maybe a
forall a. Typeable a => Chunk -> Maybe a
unChunk) (Maybe [Chunk] -> [a]) -> Maybe [Chunk] -> [a]
forall a b. (a -> b) -> a -> b
$ TypeRep -> ChunksByTypeRep -> Maybe [Chunk]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup TypeRep
tr (ChunkDB -> ChunksByTypeRep
chunkTypeTable ChunkDB
cdb)
  where
    tr :: TypeRep
tr = Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

-- | Find all chunks of a specific type in the 'ChunkDB', returning their 'UID's
-- rather than the chunks themselves.
findAll' :: TypeRep -> ChunkDB -> [UID]
findAll' :: TypeRep -> ChunkDB -> [UID]
findAll' TypeRep
tr ChunkDB
cdb = [UID] -> ([Chunk] -> [UID]) -> Maybe [Chunk] -> [UID]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Chunk -> UID) -> [Chunk] -> [UID]
forall a b. (a -> b) -> [a] -> [b]
map (Chunk -> Getting UID Chunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID Chunk UID
forall c. HasUID c => Getter c UID
Getter Chunk UID
uid)) (Maybe [Chunk] -> [UID]) -> Maybe [Chunk] -> [UID]
forall a b. (a -> b) -> a -> b
$ TypeRep -> ChunksByTypeRep -> Maybe [Chunk]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup TypeRep
tr (ChunkDB -> ChunksByTypeRep
chunkTypeTable ChunkDB
cdb)

-- | Find all chunks that depend on a specific one.
dependants :: UID -> ChunkDB -> Maybe [UID]
dependants :: UID -> ChunkDB -> Maybe [UID]
dependants UID
u ChunkDB
cdb = do
  (Chunk
_, [UID]
refs) <- UID -> ChunkByUID -> Maybe (Chunk, [UID])
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup UID
u (ChunkDB -> ChunkByUID
chunkTable ChunkDB
cdb)
  [UID] -> Maybe [UID]
forall a. a -> Maybe a
Just [UID]
refs

-- | Find all chunks that depend on a specific one, throwing a hard error if the
-- dependency chunk is not found.
dependantsOrErr :: UID -> ChunkDB -> [UID]
dependantsOrErr :: UID -> ChunkDB -> [UID]
dependantsOrErr UID
u = [UID] -> Maybe [UID] -> [UID]
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> [UID]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [UID]) -> [Char] -> [UID]
forall a b. (a -> b) -> a -> b
$ [Char]
"Failed to find references for unknown chunk " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UID -> [Char]
forall a. Show a => a -> [Char]
show UID
u) (Maybe [UID] -> [UID])
-> (ChunkDB -> Maybe [UID]) -> ChunkDB -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UID -> ChunkDB -> Maybe [UID]
forall a. Typeable a => UID -> ChunkDB -> Maybe a
find UID
u

-- | Find the type of a chunk by its 'UID'.
findTypeOf :: UID -> ChunkDB -> Maybe TypeRep
findTypeOf :: UID -> ChunkDB -> Maybe TypeRep
findTypeOf UID
u ChunkDB
cdb = Chunk -> TypeRep
chunkType (Chunk -> TypeRep)
-> ((Chunk, [UID]) -> Chunk) -> (Chunk, [UID]) -> TypeRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chunk, [UID]) -> Chunk
forall a b. (a, b) -> a
fst ((Chunk, [UID]) -> TypeRep)
-> Maybe (Chunk, [UID]) -> Maybe TypeRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UID -> ChunkByUID -> Maybe (Chunk, [UID])
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup UID
u (ChunkDB -> ChunkByUID
chunkTable ChunkDB
cdb)

-- | Internal function for updating a chunk's list of depndant chunks (i.e.,
-- chunks that reference it).
insertRefsExpectingExistence :: [UID] -> UID -> ChunkByUID -> ChunkByUID
insertRefsExpectingExistence :: [UID] -> UID -> ChunkByUID -> ChunkByUID
insertRefsExpectingExistence [UID]
newDpdnts UID
depdncy ChunkByUID
cbu =
  case (UID -> (Chunk, [UID]) -> (Chunk, [UID]) -> (Chunk, [UID]))
-> UID
-> (Chunk, [UID])
-> ChunkByUID
-> (Maybe (Chunk, [UID]), ChunkByUID)
forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a, Map k a)
M.insertLookupWithKey (\UID
_ (Chunk, [UID])
_ (Chunk
c, [UID]
dpdnts) -> (Chunk
c, [UID]
newDpdnts [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ [UID]
dpdnts)) UID
depdncy (Chunk
forall a. HasCallStack => a
undefined, []) ChunkByUID
cbu of
    (Just (Chunk, [UID])
_, ChunkByUID
cbu') -> ChunkByUID
cbu' -- If the chunk is already registered, we just updated its dependants, and everything is fine.
    (Maybe (Chunk, [UID])
Nothing, ChunkByUID
_) -> -- But if no data was found, then we have a problem: the chunk we are inserting depends on a chunk that does not exist.
      [Char] -> ChunkByUID
forall a. HasCallStack => [Char] -> a
error ([Char] -> ChunkByUID) -> [Char] -> ChunkByUID
forall a b. (a -> b) -> a -> b
$ [Char]
"Chunk dependancy is missing for `" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [UID] -> [Char]
forall a. Show a => a -> [Char]
show [UID]
newDpdnts [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"`. Missing: `" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UID -> [Char]
forall a. Show a => a -> [Char]
show UID
depdncy [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"`."

-- | Internal function to insert a chunk into the 'ChunkDB'. This function
-- assumes that the chunk is not already registered in the database, and quietly
-- break table synchronicity if it is.
insert0 :: IsChunk a => ChunkDB -> a -> ChunkDB
insert0 :: forall a. IsChunk a => ChunkDB -> a -> ChunkDB
insert0 ChunkDB
cdb a
c = ChunkDB
cdb'
  where
    -- Box our chunk.
    c' :: Chunk
c' = a -> Chunk
forall a. IsChunk a => a -> Chunk
mkChunk a
c

    -- Insert our chunk, it is not currently depended on by anything.
    chunkTable' :: ChunkByUID
chunkTable' = UID -> (Chunk, [UID]) -> ChunkByUID -> ChunkByUID
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (a
c a -> Getting UID a UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID a UID
forall c. HasUID c => Getter c UID
Getter a UID
uid) (Chunk
c', [UID]
forall a. Monoid a => a
mempty) (ChunkDB -> ChunkByUID
chunkTable ChunkDB
cdb)

    -- Capture all dependencies of this chunk.
    chunkTable'' :: ChunkByUID
chunkTable'' = (UID -> ChunkByUID -> ChunkByUID)
-> ChunkByUID -> Set UID -> ChunkByUID
forall a b. (a -> b -> b) -> b -> Set a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([UID] -> UID -> ChunkByUID -> ChunkByUID
insertRefsExpectingExistence [Chunk
c' Chunk -> Getting UID Chunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID Chunk UID
forall c. HasUID c => Getter c UID
Getter Chunk UID
uid]) ChunkByUID
chunkTable'
      (Set UID -> ChunkByUID) -> Set UID -> ChunkByUID
forall a b. (a -> b) -> a -> b
$ a -> Set UID
forall a. HasChunkRefs a => a -> Set UID
chunkRefs a
c

    -- Add our chunk to its corresponding 'chunks by type' list.
    chunkTypeTable' :: ChunksByTypeRep
chunkTypeTable' = (Maybe [Chunk] -> Maybe [Chunk])
-> TypeRep -> ChunksByTypeRep -> ChunksByTypeRep
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter ([Chunk] -> Maybe [Chunk]
forall a. a -> Maybe a
Just ([Chunk] -> Maybe [Chunk])
-> (Maybe [Chunk] -> [Chunk]) -> Maybe [Chunk] -> Maybe [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Chunk] -> ([Chunk] -> [Chunk]) -> Maybe [Chunk] -> [Chunk]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Chunk
c'] ([Chunk] -> [Chunk] -> [Chunk]
forall a. [a] -> [a] -> [a]
++ [Chunk
c'])) (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
c) (ChunkDB -> ChunksByTypeRep
chunkTypeTable ChunkDB
cdb)

    -- Finally, build the updated database.
    cdb' :: ChunkDB
cdb' = ChunkDB
cdb { chunkTable = chunkTable'', chunkTypeTable = chunkTypeTable' }

-- | Insert a chunk into the 'ChunkDB' if it is sensible to do so (i.e., does
-- not depend on itself, is not a 'ChunkDB', and does not overwrite another
-- chunk).
insert :: IsChunk a => a -> ChunkDB -> ChunkDB
insert :: forall a. IsChunk a => a -> ChunkDB -> ChunkDB
insert a
c ChunkDB
cdb
  | a
c a -> Getting UID a UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID a UID
forall c. HasUID c => Getter c UID
Getter a UID
uid UID -> Set UID -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` a -> Set UID
forall a. HasChunkRefs a => a -> Set UID
chunkRefs a
c =
      [Char] -> ChunkDB
forall a. HasCallStack => [Char] -> a
error ([Char] -> ChunkDB) -> [Char] -> ChunkDB
forall a b. (a -> b) -> a -> b
$ [Char]
"Chunk `" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UID -> [Char]
forall a. Show a => a -> [Char]
show (a
c a -> Getting UID a UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID a UID
forall c. HasUID c => Getter c UID
Getter a UID
uid) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"` cannot reference itself as a dependancy."
  | a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
c TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy ChunkDB -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ChunkDB) =
      [Char] -> ChunkDB
forall a. HasCallStack => [Char] -> a
error [Char]
"Insertion of ChunkDBs in ChunkDBs is disallowed; please perform unions with them instead."
  | (Just TypeRep
x) <- UID -> ChunkDB -> Maybe TypeRep
findTypeOf (a
c a -> Getting UID a UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID a UID
forall c. HasUID c => Getter c UID
Getter a UID
uid) ChunkDB
cdb =
      -- Overwrite: remove previous chunk from chunk refs and chunksByType
      -- tables before inserting new one.
      let prevChunk :: Chunk
prevChunk = (Chunk, [UID]) -> Chunk
forall a b. (a, b) -> a
fst ((Chunk, [UID]) -> Chunk) -> (Chunk, [UID]) -> Chunk
forall a b. (a -> b) -> a -> b
$ (Chunk, [UID]) -> Maybe (Chunk, [UID]) -> (Chunk, [UID])
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> (Chunk, [UID])
forall a. HasCallStack => [Char] -> a
error [Char]
"Internal error: chunk missing after findTypeOf succeeded") (UID -> ChunkByUID -> Maybe (Chunk, [UID])
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (a
c a -> Getting UID a UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID a UID
forall c. HasUID c => Getter c UID
Getter a UID
uid) (ChunkDB -> ChunkByUID
chunkTable ChunkDB
cdb))
          prevType :: TypeRep
prevType  = Chunk -> TypeRep
chunkType Chunk
prevChunk
          cu' :: ChunkByUID
cu' = UID -> ChunkByUID -> ChunkByUID
forall k a. Ord k => k -> Map k a -> Map k a
M.delete (a
c a -> Getting UID a UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID a UID
forall c. HasUID c => Getter c UID
Getter a UID
uid) (ChunkDB -> ChunkByUID
chunkTable ChunkDB
cdb)
          ctr' :: ChunksByTypeRep
ctr' = ([Chunk] -> [Chunk])
-> TypeRep -> ChunksByTypeRep -> ChunksByTypeRep
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust ((Chunk -> Bool) -> [Chunk] -> [Chunk]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Chunk
c_ -> (Chunk
c_ Chunk -> Getting UID Chunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID Chunk UID
forall c. HasUID c => Getter c UID
Getter Chunk UID
uid) UID -> UID -> Bool
forall a. Eq a => a -> a -> Bool
/= (a
c a -> Getting UID a UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID a UID
forall c. HasUID c => Getter c UID
Getter a UID
uid))) TypeRep
prevType (ChunkDB -> ChunksByTypeRep
chunkTypeTable ChunkDB
cdb)
          cdb' :: ChunkDB
cdb' = ChunkDB
cdb { chunkTable = cu', chunkTypeTable = ctr' }
          cdb'' :: ChunkDB
cdb'' = ChunkDB -> a -> ChunkDB
forall a. IsChunk a => ChunkDB -> a -> ChunkDB
insert0 ChunkDB
cdb' a
c
      in if a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
c TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== TypeRep
x
            then [Char] -> ChunkDB -> ChunkDB
forall a. HasCallStack => [Char] -> a
error ([Char]
"ERROR! Attempting to insert duplicate chunk: `" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UID -> [Char]
forall a. Show a => a -> [Char]
show (a
c a -> Getting UID a UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID a UID
forall c. HasUID c => Getter c UID
Getter a UID
uid) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"` :: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TypeRep -> [Char]
forall a. Show a => a -> [Char]
show TypeRep
x) ChunkDB
cdb''
            else [Char] -> ChunkDB
forall a. HasCallStack => [Char] -> a
error ([Char] -> ChunkDB) -> [Char] -> ChunkDB
forall a b. (a -> b) -> a -> b
$ [Char]
"ERROR! Attempting to overwrite a chunk (`" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UID -> [Char]
forall a. Show a => a -> [Char]
show (a
c a -> Getting UID a UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID a UID
forall c. HasUID c => Getter c UID
Getter a UID
uid) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"` :: `" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TypeRep -> [Char]
forall a. Show a => a -> [Char]
show TypeRep
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"`) with a chunk of a different type: `" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TypeRep -> [Char]
forall a. Show a => a -> [Char]
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
c) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"`"
  | Bool
otherwise = ChunkDB -> a -> ChunkDB
forall a. IsChunk a => ChunkDB -> a -> ChunkDB
insert0 ChunkDB
cdb a
c

-- | Insert a list of chunks into a 'ChunkDB'.
insertAll :: IsChunk a => [a] -> ChunkDB -> ChunkDB
insertAll :: forall a. IsChunk a => [a] -> ChunkDB -> ChunkDB
insertAll [a]
as ChunkDB
cdb = (ChunkDB -> a -> ChunkDB) -> ChunkDB -> [a] -> ChunkDB
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((a -> ChunkDB -> ChunkDB) -> ChunkDB -> a -> ChunkDB
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> ChunkDB -> ChunkDB
forall a. IsChunk a => a -> ChunkDB -> ChunkDB
insert) ChunkDB
cdb [a]
as

--------------------------------------------------------------------------------
-- Temporary functions
--------------------------------------------------------------------------------

-- | Insert 11 lists of /unique/ chunk types into a 'ChunkDB', assuming the
-- input 'ChunkDB' does not already contain any of the chunks from the chunk
-- lists.
insertAllOutOfOrder11 ::
  (IsChunk a, IsChunk b, IsChunk c, IsChunk d, IsChunk e,
   IsChunk f, IsChunk g, IsChunk h, IsChunk i, IsChunk j,
   IsChunk k) =>
   ChunkDB ->
   [a] -> [b] -> [c] -> [d] -> [e] ->
   [f] -> [g] -> [h] -> [i] -> [j] ->
   [k] -> ChunkDB
insertAllOutOfOrder11 :: forall a b c d e f g h i j k.
(IsChunk a, IsChunk b, IsChunk c, IsChunk d, IsChunk e, IsChunk f,
 IsChunk g, IsChunk h, IsChunk i, IsChunk j, IsChunk k) =>
ChunkDB
-> [a]
-> [b]
-> [c]
-> [d]
-> [e]
-> [f]
-> [g]
-> [h]
-> [i]
-> [j]
-> [k]
-> ChunkDB
insertAllOutOfOrder11 ChunkDB
strtr [a]
as [b]
bs [c]
cs [d]
ds [e]
es [f]
fs [g]
gs [h]
hs [i]
is [j]
js [k]
ks =
  let
    -- Box all of our chunks
    as' :: [Chunk]
as' = (a -> Chunk) -> [a] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map a -> Chunk
forall a. IsChunk a => a -> Chunk
mkChunk [a]
as
    bs' :: [Chunk]
bs' = (b -> Chunk) -> [b] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map b -> Chunk
forall a. IsChunk a => a -> Chunk
mkChunk [b]
bs
    cs' :: [Chunk]
cs' = (c -> Chunk) -> [c] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map c -> Chunk
forall a. IsChunk a => a -> Chunk
mkChunk [c]
cs
    ds' :: [Chunk]
ds' = (d -> Chunk) -> [d] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map d -> Chunk
forall a. IsChunk a => a -> Chunk
mkChunk [d]
ds
    es' :: [Chunk]
es' = (e -> Chunk) -> [e] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map e -> Chunk
forall a. IsChunk a => a -> Chunk
mkChunk [e]
es
    fs' :: [Chunk]
fs' = (f -> Chunk) -> [f] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map f -> Chunk
forall a. IsChunk a => a -> Chunk
mkChunk [f]
fs
    gs' :: [Chunk]
gs' = (g -> Chunk) -> [g] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map g -> Chunk
forall a. IsChunk a => a -> Chunk
mkChunk [g]
gs
    hs' :: [Chunk]
hs' = (h -> Chunk) -> [h] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map h -> Chunk
forall a. IsChunk a => a -> Chunk
mkChunk [h]
hs
    is' :: [Chunk]
is' = (i -> Chunk) -> [i] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map i -> Chunk
forall a. IsChunk a => a -> Chunk
mkChunk [i]
is
    js' :: [Chunk]
js' = (j -> Chunk) -> [j] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map j -> Chunk
forall a. IsChunk a => a -> Chunk
mkChunk [j]
js
    ks' :: [Chunk]
ks' = (k -> Chunk) -> [k] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map k -> Chunk
forall a. IsChunk a => a -> Chunk
mkChunk [k]
ks

    -- Put all of our chunks in a list of lists, with each list carrying a
    -- unique type of chunk, filtering out empty lists
    altogether :: [[Chunk]]
altogether = ([Chunk] -> Bool) -> [[Chunk]] -> [[Chunk]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Chunk] -> Bool) -> [Chunk] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Chunk] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
                  [[Chunk]
as', [Chunk]
bs', [Chunk]
cs', [Chunk]
ds', [Chunk]
es', [Chunk]
fs', [Chunk]
gs', [Chunk]
hs', [Chunk]
is', [Chunk]
js', [Chunk]
ks']
    calt :: [Chunk]
calt = [[Chunk]] -> [Chunk]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Chunk]]
altogether

    -- Calculate what chunks are depended on (i.e., UID -> Dependants)
    chDpdts :: Map UID [UID]
chDpdts = Map UID [UID] -> Map UID [UID]
forall v k. Ord v => Map k [v] -> Map v [k]
invert (Map UID [UID] -> Map UID [UID]) -> Map UID [UID] -> Map UID [UID]
forall a b. (a -> b) -> a -> b
$ [(UID, [UID])] -> Map UID [UID]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(UID, [UID])] -> Map UID [UID])
-> [(UID, [UID])] -> Map UID [UID]
forall a b. (a -> b) -> a -> b
$ (Chunk -> (UID, [UID])) -> [Chunk] -> [(UID, [UID])]
forall a b. (a -> b) -> [a] -> [b]
map (\Chunk
c -> (Chunk
c Chunk -> Getting UID Chunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID Chunk UID
forall c. HasUID c => Getter c UID
Getter Chunk UID
uid, Set UID -> [UID]
forall a. Set a -> [a]
S.toList (Set UID -> [UID]) -> Set UID -> [UID]
forall a b. (a -> b) -> a -> b
$ Chunk -> Set UID
forall a. HasChunkRefs a => a -> Set UID
chunkRefs Chunk
c)) [Chunk]
calt

    -- Insert all incoming chunks with the existing chunk table, asserting that
    -- none of the inserted chunks were already inserted.
    chTab :: ChunkByUID
chTab = ((Chunk, [UID]) -> (Chunk, [UID]) -> (Chunk, [UID]))
-> ChunkByUID -> ChunkByUID -> ChunkByUID
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith
      (\(Chunk
x, [UID]
_) (Chunk, [UID])
_ -> [Char] -> (Chunk, [UID])
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Chunk, [UID])) -> [Char] -> (Chunk, [UID])
forall a b. (a -> b) -> a -> b
$ [Char]
"duplicate chunk found in mass insertion: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UID -> [Char]
forall a. Show a => a -> [Char]
show (Chunk
x Chunk -> Getting UID Chunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID Chunk UID
forall c. HasUID c => Getter c UID
Getter Chunk UID
uid))
      (ChunkDB -> ChunkByUID
chunkTable ChunkDB
strtr)
      ([(UID, (Chunk, [UID]))] -> ChunkByUID
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(UID, (Chunk, [UID]))] -> ChunkByUID)
-> [(UID, (Chunk, [UID]))] -> ChunkByUID
forall a b. (a -> b) -> a -> b
$ (Chunk -> (UID, (Chunk, [UID])))
-> [Chunk] -> [(UID, (Chunk, [UID]))]
forall a b. (a -> b) -> [a] -> [b]
map (\Chunk
c -> (Chunk
c Chunk -> Getting UID Chunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID Chunk UID
forall c. HasUID c => Getter c UID
Getter Chunk UID
uid, (Chunk
c, []))) [Chunk]
calt)

    -- Merge the chunk-deps table with that existing chunks table
    chTabWDeps :: ChunkByUID
chTabWDeps = (ChunkByUID -> UID -> [UID] -> ChunkByUID)
-> ChunkByUID -> Map UID [UID] -> ChunkByUID
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
M.foldlWithKey'
      (\ChunkByUID
acc UID
k [UID]
dpdts -> [UID] -> UID -> ChunkByUID -> ChunkByUID
insertRefsExpectingExistence [UID]
dpdts UID
k ChunkByUID
acc) ChunkByUID
chTab Map UID [UID]
chDpdts

    -- Create the list of new chunk types and add them to the previous list of chunk types
    chTys :: ChunksByTypeRep
chTys = [(TypeRep, [Chunk])] -> ChunksByTypeRep
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (([Chunk] -> (TypeRep, [Chunk]))
-> [[Chunk]] -> [(TypeRep, [Chunk])]
forall a b. (a -> b) -> [a] -> [b]
map (\[Chunk]
chs -> (Chunk -> TypeRep
chunkType (Chunk -> TypeRep) -> Chunk -> TypeRep
forall a b. (a -> b) -> a -> b
$ [Chunk] -> Chunk
forall a. HasCallStack => [a] -> a
head [Chunk]
chs, [Chunk]
chs)) [[Chunk]]
altogether)
    chTT :: ChunksByTypeRep
chTT = ([Chunk] -> [Chunk] -> [Chunk])
-> ChunksByTypeRep -> ChunksByTypeRep -> ChunksByTypeRep
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith [Chunk] -> [Chunk] -> [Chunk]
forall a. [a] -> [a] -> [a]
(++) (ChunkDB -> ChunksByTypeRep
chunkTypeTable ChunkDB
strtr) ChunksByTypeRep
chTys
  in
    -- Create the updated chunk database, adding the LCs and Rs, ignoring their dependencies.
    ChunkDB
strtr { chunkTable = chTabWDeps
          , chunkTypeTable = chTT }