Picking development back up

Merge Kiselyov optimizations and De Bruijn indices
General clean up

src/ContentStore.hs

@@ -3,17 +3,17 @@ module ContentStore where
 import Research
 import Parser
 
-import Control.Monad                  (foldM, forM)
+import Control.Monad                  (foldM, forM_, void)
 import Data.ByteString                (ByteString)
 import Data.List                      (nub, sort)
-import Data.Maybe                     (catMaybes, fromJust)
+import Data.Maybe                     (catMaybes, fromMaybe)
 import Data.Text                      (Text)
 import Database.SQLite.Simple
 import Database.SQLite.Simple.FromRow (FromRow(..), field)
 import System.Directory               (createDirectoryIfMissing, getXdgDirectory, XdgDirectory(..))
 import System.FilePath                ((</>), takeDirectory)
 
-import qualified Data.ByteString      as BS
+
 import qualified Data.Map             as Map
 import qualified Data.Text            as T
 
@@ -47,7 +47,6 @@ initContentStore = do
   execute_ conn "CREATE TABLE IF NOT EXISTS terms (\
                 \hash TEXT PRIMARY KEY, \
                 \names TEXT, \
-                \term_data BLOB, \
                 \metadata TEXT, \
                 \created_at INTEGER DEFAULT (strftime('%s','now')), \
                 \tags TEXT DEFAULT '')"
@@ -83,8 +82,8 @@ storeTerm conn newNamesStrList term = do
     [] -> do
       let allNamesToStore = serializeNameList newNamesTextList
       execute conn
-        "INSERT INTO terms (hash, names, term_data, metadata, tags) VALUES (?, ?, ?, ?, ?)"
-        (termHashText, allNamesToStore, BS.pack [], metadataText, T.pack "")
+        "INSERT INTO terms (hash, names, metadata, tags) VALUES (?, ?, ?, ?)"
+        (termHashText, allNamesToStore, metadataText, T.pack "")
     [(Only currentNamesText)] -> do
       let currentNamesList = parseNameList currentNamesText
       let combinedNamesList = currentNamesList ++ newNamesTextList
@@ -92,7 +91,7 @@ storeTerm conn newNamesStrList term = do
       execute conn
         "UPDATE terms SET names = ?, metadata = ? WHERE hash = ?"
         (allNamesToStore, metadataText, termHashText)
-    _ -> error $ "Multiple terms with same hash? " ++ show (length existingNamesQuery)
+    _ -> errorWithoutStackTrace $ "Multiple terms with same hash? " ++ show (length existingNamesQuery)
 
   return termHashText
 
@@ -108,11 +107,11 @@ loadTree conn h
   where
     buildTree :: Node -> IO T
     buildTree (NStem childHash) = do
-      child <- fromJust <$> loadTree conn childHash
+      child <- fromMaybe (errorWithoutStackTrace "BUG: stored hash not found") <$> loadTree conn childHash
       return (Stem child)
     buildTree (NFork lHash rHash) = do
-      left <- fromJust <$> loadTree conn lHash
-      right <- fromJust <$> loadTree conn rHash
+      left <- fromMaybe (errorWithoutStackTrace "BUG: stored hash not found") <$> loadTree conn lHash
+      right <- fromMaybe (errorWithoutStackTrace "BUG: stored hash not found") <$> loadTree conn rHash
       return (Fork left right)
 
 -- | Store all nodes of a Merkle DAG by traversing the Term and building/storing nodes.
@@ -161,14 +160,14 @@ listStoredTerms :: Connection -> IO [StoredTerm]
 listStoredTerms conn =
   query_ conn (selectStoredTermFields <> " ORDER BY created_at DESC")
 
-storeEnvironment :: Connection -> Env -> IO [(String, Text)]
+storeEnvironment :: Connection -> Env -> IO ()
 storeEnvironment conn env = do
   let defs = Map.toList $ Map.delete "!result" env
   let groupedDefs = Map.toList $ Map.fromListWith (++) [(term, [name]) | (name, term) <- defs]
 
-  forM groupedDefs $ \(term, namesList) -> do
-    hashVal <- storeTerm conn namesList term
-    return (head namesList, hashVal)
+  forM_ groupedDefs $ \(term, namesList) -> case namesList of
+    n:ns -> void $ storeTerm conn namesList term
+    _ -> errorWithoutStackTrace "storeEnvironment: empty names list"
 
 loadTerm :: Connection -> String -> IO (Maybe T)
 loadTerm conn identifier = do