{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Database.Drasil.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 for working with non-chunk tables
  UMap, idMap,
  refTable, refFind,
  labelledcontentTable, labelledcontentFind,
  refbyTable, refbyLookup,
  traceTable, traceLookup
) where

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

-- NOTE: Debug.Trace should only be used for warnings and errors, not for
-- general logging, as it can affect program behavior in unexpected ways.
-- However, we (ab)use it here to provide *soft* warnings when overwriting
-- chunks in the database.
import Debug.Trace (trace)

-- 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 Drasil.Database.Chunk (Chunk, HasChunkRefs(chunkRefs), IsChunk,
  mkChunk, unChunk, chunkType)
import Language.Drasil (HasUID(..), UID, LabelledContent, Reference)

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

  -- FIXME: All things below need to be rebuilt!!

  -- FIXME: All code in this file contains hacks specifically for the old
  -- LabelledContent and Reference chunks. Once rebuilt, these chunks should not
  -- have a unique 'UID' and should be registered in the 'ChunkDB' like any
  -- other chunk.

  -- TODO: LabelledContent needs to be rebuilt. See JacquesCarette/Drasil#4023.
  , ChunkDB -> UMap LabelledContent
labelledcontentTable :: UMap LabelledContent
  -- TODO: References need to be rebuilt. See JacquesCarette/Drasil#4022.
  , ChunkDB -> UMap Reference
refTable             :: UMap Reference
  , ChunkDB -> Map UID [UID]
traceTable           :: M.Map UID [UID]
  , ChunkDB -> Map UID [UID]
refbyTable           :: M.Map UID [UID]
}

-- | An empty 'ChunkDB'.
empty :: ChunkDB
empty :: ChunkDB
empty = ChunkByUID
-> ChunksByTypeRep
-> UMap LabelledContent
-> UMap Reference
-> Map UID [UID]
-> Map UID [UID]
-> ChunkDB
ChunkDB ChunkByUID
forall k a. Map k a
M.empty ChunksByTypeRep
forall k a. Map k a
M.empty UMap LabelledContent
forall k a. Map k a
M.empty UMap Reference
forall k a. Map k a
M.empty Map UID [UID]
forall k a. Map k a
M.empty Map UID [UID]
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 ChunkDB
cdb =
     ChunkByUID -> [UID]
forall k a. Map k a -> [k]
M.keys (ChunkDB -> ChunkByUID
chunkTable ChunkDB
cdb)
  [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ UMap LabelledContent -> [UID]
forall k a. Map k a -> [k]
M.keys (ChunkDB -> UMap LabelledContent
labelledcontentTable ChunkDB
cdb)
  [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ UMap Reference -> [UID]
forall k a. Map k a -> [k]
M.keys (ChunkDB -> UMap Reference
refTable ChunkDB
cdb)

-- | Check if a 'UID' is registered in the 'ChunkDB'.
isRegistered :: UID -> ChunkDB -> Bool
isRegistered :: UID -> ChunkDB -> Bool
isRegistered UID
u ChunkDB
cdb =
     UID -> ChunkByUID -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member UID
u (ChunkDB -> ChunkByUID
chunkTable ChunkDB
cdb)
  Bool -> Bool -> Bool
|| UID -> UMap LabelledContent -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member UID
u (ChunkDB -> UMap LabelledContent
labelledcontentTable ChunkDB
cdb)
  Bool -> Bool -> Bool
|| UID -> UMap Reference -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member UID
u (ChunkDB -> UMap Reference
refTable ChunkDB
cdb)

-- | Enumerate all types registered in the 'ChunkDB'.
typesRegistered :: ChunkDB -> [TypeRep]
typesRegistered :: ChunkDB -> [TypeRep]
typesRegistered ChunkDB
cdb =
    Proxy LabelledContent -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @LabelledContent)
  TypeRep -> [TypeRep] -> [TypeRep]
forall a. a -> [a] -> [a]
: Proxy Reference -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Reference)
  TypeRep -> [TypeRep] -> [TypeRep]
forall a. a -> [a] -> [a]
: ChunksByTypeRep -> [TypeRep]
forall k a. Map k a -> [k]
M.keys (ChunkDB -> ChunksByTypeRep
chunkTypeTable ChunkDB
cdb)

-- | Get the number of chunks registered in the 'ChunkDB'.
size :: ChunkDB -> Int
size :: ChunkDB -> Int
size ChunkDB
cdb =
    ChunkByUID -> Int
forall k a. Map k a -> Int
M.size (ChunkDB -> ChunkByUID
chunkTable ChunkDB
cdb)
  Int -> Int -> Int
forall a. Num a => a -> a -> a
+ UMap LabelledContent -> Int
forall k a. Map k a -> Int
M.size (ChunkDB -> UMap LabelledContent
labelledcontentTable ChunkDB
cdb)
  Int -> Int -> Int
forall a. Num a => a -> a -> a
+ UMap Reference -> Int
forall k a. Map k a -> Int
M.size (ChunkDB -> UMap Reference
refTable ChunkDB
cdb)

-- | 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
  | TypeRep
tr TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy LabelledContent -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @LabelledContent) =
      ((LabelledContent, Int) -> Maybe a)
-> [(LabelledContent, Int)] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (LabelledContent -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast (LabelledContent -> Maybe a)
-> ((LabelledContent, Int) -> LabelledContent)
-> (LabelledContent, Int)
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LabelledContent, Int) -> LabelledContent
forall a b. (a, b) -> a
fst) ([(LabelledContent, Int)] -> [a])
-> [(LabelledContent, Int)] -> [a]
forall a b. (a -> b) -> a -> b
$ UMap LabelledContent -> [(LabelledContent, Int)]
forall k a. Map k a -> [a]
M.elems (UMap LabelledContent -> [(LabelledContent, Int)])
-> UMap LabelledContent -> [(LabelledContent, Int)]
forall a b. (a -> b) -> a -> b
$ ChunkDB -> UMap LabelledContent
labelledcontentTable ChunkDB
cdb
  | TypeRep
tr TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy Reference -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Reference) =
      ((Reference, Int) -> Maybe a) -> [(Reference, Int)] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Reference -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast (Reference -> Maybe a)
-> ((Reference, Int) -> Reference) -> (Reference, Int) -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference, Int) -> Reference
forall a b. (a, b) -> a
fst) ([(Reference, Int)] -> [a]) -> [(Reference, Int)] -> [a]
forall a b. (a -> b) -> a -> b
$ UMap Reference -> [(Reference, Int)]
forall k a. Map k a -> [a]
M.elems (UMap Reference -> [(Reference, Int)])
-> UMap Reference -> [(Reference, Int)]
forall a b. (a -> b) -> a -> b
$ ChunkDB -> UMap Reference
refTable ChunkDB
cdb
  | Bool
otherwise =
      [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
  | TypeRep
tr TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy LabelledContent -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @LabelledContent) =
      UMap LabelledContent -> [UID]
forall k a. Map k a -> [k]
M.keys (UMap LabelledContent -> [UID]) -> UMap LabelledContent -> [UID]
forall a b. (a -> b) -> a -> b
$ ChunkDB -> UMap LabelledContent
labelledcontentTable ChunkDB
cdb
  | TypeRep
tr TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy Reference -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Reference) =
      UMap Reference -> [UID]
forall k a. Map k a -> [k]
M.keys (UMap Reference -> [UID]) -> UMap Reference -> [UID]
forall a b. (a -> b) -> a -> b
$ ChunkDB -> UMap Reference
refTable ChunkDB
cdb
  | Bool
otherwise =
      [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 inserting a dependancy of a chunk into the
-- dependancy's respective dependants list.
insertRefExpectingExistence :: UID -> UID -> ChunkByUID -> ChunkByUID
insertRefExpectingExistence :: UID -> UID -> ChunkByUID -> ChunkByUID
insertRefExpectingExistence UID
depdnt 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]
depdnts) -> (Chunk
c, UID
depdnt UID -> [UID] -> [UID]
forall a. a -> [a] -> [a]
: [UID]
depdnts)) 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
depdnt [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
insertRefExpectingExistence (UID -> UID -> ChunkByUID -> ChunkByUID)
-> UID -> UID -> ChunkByUID -> ChunkByUID
forall a b. (a -> b) -> a -> b
$ 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 sensibly to do so (i.e., does
-- not depend on itself and is not a 'ChunkDB'). We temporarily allow chunks to
-- overwrite other ones, but we warn when this happens.
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. [Char] -> a -> a
trace ([Char]
"WARNING! Overwriting `" [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! Overwriting 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 for working with non-chunk tables
--
-- Everything below is temporary and should be removed once the LabelledContent
-- and Reference chunks are properly implemented and the "chunk refs" tables are
-- built properly (i.e., using the `HasChunkRefs` typeclass).
--------------------------------------------------------------------------------

-- | An ordered map based on 'Data.Map.Strict' for looking up chunks by their
-- 'UID's.
type UMap a = M.Map UID (a, Int)

-- | Create a 'UMap' from a list of chunks. Assumes that the leftmost chunk in
-- the list has index 0, increasing by 1 each step to the right.
idMap :: HasUID a => [a] -> UMap a
idMap :: forall a. HasUID a => [a] -> UMap a
idMap [a]
vals = [(UID, (a, Int))] -> Map UID (a, Int)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(UID, (a, Int))] -> Map UID (a, Int))
-> [(UID, (a, Int))] -> Map UID (a, Int)
forall a b. (a -> b) -> a -> b
$ (a -> Int -> (UID, (a, Int))) -> [a] -> [Int] -> [(UID, (a, Int))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\a
v Int
i -> (a
v 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, (a
v, Int
i))) [a]
vals [Int
0..]

-- | Looks up a 'UID' in a 'UMap' table. If nothing is found, an error is thrown.
uMapLookup :: String -> String -> UID -> UMap a -> a
uMapLookup :: forall a. [Char] -> [Char] -> UID -> UMap a -> a
uMapLookup [Char]
tys [Char]
ms UID
u UMap a
t = Maybe (a, Int) -> a
getFM (Maybe (a, Int) -> a) -> Maybe (a, Int) -> a
forall a b. (a -> b) -> a -> b
$ UID -> UMap a -> Maybe (a, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup UID
u UMap a
t
  where getFM :: Maybe (a, Int) -> a
getFM = a -> ((a, Int) -> a) -> Maybe (a, Int) -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
tys [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [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]
" not found in " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
ms) (a, Int) -> a
forall a b. (a, b) -> a
fst

-- | Find a 'LabelledContent' by its 'UID', throwing an error if it is not
-- found.
labelledcontentFind :: UID -> ChunkDB -> LabelledContent
labelledcontentFind :: UID -> ChunkDB -> LabelledContent
labelledcontentFind UID
u ChunkDB
cdb = [Char] -> [Char] -> UID -> UMap LabelledContent -> LabelledContent
forall a. [Char] -> [Char] -> UID -> UMap a -> a
uMapLookup [Char]
"LabelledContent" [Char]
"labelledcontentTable" UID
u (ChunkDB -> UMap LabelledContent
labelledcontentTable ChunkDB
cdb)

-- | Find a 'Reference' by its 'UID', throwing an error if it is not found.
refFind :: UID -> ChunkDB -> Reference
refFind :: UID -> ChunkDB -> Reference
refFind UID
u ChunkDB
cdb = [Char] -> [Char] -> UID -> UMap Reference -> Reference
forall a. [Char] -> [Char] -> UID -> UMap a -> a
uMapLookup [Char]
"Reference" [Char]
"refTable" UID
u (ChunkDB -> UMap Reference
refTable ChunkDB
cdb)

-- | Find what chunks reference a given 'UID'.
refbyLookup :: UID -> M.Map UID [UID] -> [UID]
refbyLookup :: UID -> Map UID [UID] -> [UID]
refbyLookup UID
c = [UID] -> Maybe [UID] -> [UID]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [UID] -> [UID])
-> (Map UID [UID] -> Maybe [UID]) -> Map UID [UID] -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UID -> Map UID [UID] -> Maybe [UID]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup UID
c

-- | Query a chunk for to what chunks it refers to.
traceLookup :: UID -> M.Map UID [UID] -> [UID]
traceLookup :: UID -> Map UID [UID] -> [UID]
traceLookup = UID -> Map UID [UID] -> [UID]
refbyLookup -- Same implementation, just different name for code clarity.