fixup! fixup! fixup! fixup! fixup! hnix-store-db: init

hnix-store-db/src/System/Nix/Store/DB/Instances.hs

@@ -34,20 +34,24 @@ instance PersistField StorePath where
       (System.Nix.StorePath.pathParser def)
       t
   fromPersistValue wrongValue = Left
-    $ Data.Text.pack
     $ "Received "
-    ++ show wrongValue
-    ++ " when a value of type PersistText was expected."
+    <> (Data.Text.pack $ show wrongValue)
+    <> " when a value of type PersistText was expected."
 
 instance PersistFieldSql StorePath where
   sqlType _ = SqlString
 
--- XXX: handle errors
 instance PersistField StorePathTrust where
   toPersistValue BuiltLocally     = PersistInt64 1
   toPersistValue BuiltElsewhere   = PersistNull
+
   fromPersistValue (PersistInt64 1) = pure BuiltLocally
-  fromPersistValue _                = pure BuiltElsewhere
+  fromPersistValue PersistNull      = pure BuiltElsewhere
+  fromPersistValue wrongValue = Left
+    $ "Received "
+    <> (Data.Text.pack $ show wrongValue)
+    <> " when a value of type PersistNull"
+    <> " or (PersistInt64 1) was expected."
 
 instance PersistFieldSql StorePathTrust where
   sqlType _ = SqlInt64
@@ -60,7 +64,10 @@ instance PersistField NixUTCTime where
     $ round $  Data.Time.Clock.POSIX.utcTimeToPOSIXSeconds u
   fromPersistValue (PersistInt64 i) = pure $ NixUTCTime
     $ Data.Time.Clock.POSIX.posixSecondsToUTCTime $ fromIntegral i
-  fromPersistValue _ = undefined
+  fromPersistValue wrongValue = Left
+    $ "Received "
+    <> (Data.Text.pack $ show wrongValue)
+    <> " when a value of (PersistInt64 _) was expected."
 
 instance PersistFieldSql NixUTCTime where
   sqlType _ = SqlInt64
@@ -72,14 +79,13 @@ instance PersistField ContentAddressableAddress where
     . System.Nix.Store.Remote.Builders.buildContentAddressableAddress
 
   fromPersistValue (PersistText t) =
-{--
- -- XXX: DBG
- -- error $ show t
---}
-    Data.Bifunctor.first (\e -> error $ show (e, t)) -- Data.Text.pack)
+    Data.Bifunctor.first (\e -> error $ show (e, t))
     $ System.Nix.Store.Remote.Parsers.parseContentAddressableAddress
         (Data.ByteString.Char8.pack $ Data.Text.unpack t)
-  fromPersistValue _ = undefined
+  fromPersistValue wrongValue = Left
+    $ "Received "
+    <> (Data.Text.pack $ show wrongValue)
+    <> " when a value of type PersistText was expected."
 
 instance PersistFieldSql ContentAddressableAddress where
   sqlType _ = SqlString

hnix-store-db/src/System/Nix/Store/DB/Run.hs

@@ -3,17 +3,15 @@ module System.Nix.Store.DB.Run where
 
 import Control.Monad.Trans.Reader (ReaderT)
 import Data.Default.Class (Default(def))
-
 import Database.Esqueleto.Experimental (entityVal)
+import System.Nix.Store.DB.Schema (validPathPath, migrateAll)
+import System.Nix.Store.DB.Query
 
 import qualified Control.Monad
 import qualified Control.Monad.IO.Class
 import qualified Control.Monad.Logger
 import qualified Control.Monad.Trans.Resource
 import qualified Database.Persist.Sqlite
-
-import System.Nix.Store.DB.Schema (validPathPath, migrateAll)
-import System.Nix.Store.DB.Query
 import qualified System.Nix.StorePath
 
 import           Control.Monad.IO.Class      (MonadIO, liftIO)
@@ -22,9 +20,6 @@ import           Control.Monad.Logger        (MonadLogger)
 import           Control.Monad.Reader        (MonadReader (..), runReaderT)
 import           Control.Monad.Trans.Control (MonadBaseControl)
 
-
-
-
 {--
 memTest :: IO ()
 memTest = runner' ":memory:" $ do

hnix-store-db/src/System/Nix/Store/DB/Schema.hs

@@ -16,8 +16,8 @@ import Database.Persist.TH ( mkMigrate
 import System.Nix.StorePath (StorePath, ContentAddressableAddress)
 import System.Nix.StorePathMetadata (StorePathTrust(..))
 
-import System.Nix.Store.DB.Instances
-import System.Nix.Store.DB.Util
+import System.Nix.Store.DB.Instances (NixUTCTime)
+import System.Nix.Store.DB.Util (persistLikeNix)
 
 -- shcema version 10
 -- cat /nix/var/nix/db/schema
@@ -32,8 +32,11 @@ share [ mkPersist sqlSettings
     deriver   StorePath Maybe
     narBytes  Word64 sql=narSize
     ultimate  StorePathTrust Maybe
+    -- ^ null is BuiltElsewhere, 1 is BuiltLocally
     sigs      Text Maybe
+    -- ^ space separated
     ca        ContentAddressableAddress Maybe
+    -- ^ if not null, an assertion that the path is content-addressed
     deriving Eq Show Ord
 
   Ref
@@ -45,9 +48,46 @@ share [ mkPersist sqlSettings
 
   DerivationOutput
     drv      ValidPathId
-    name     Text sql=id -- symbolic output id, usually "out"
+    name     Text sql=id
+    -- ^ symbolic output id, usually "out"
     path     StorePath
 
     Primary drv name
     deriving Eq Show Ord
 |]
+
+{--
+CREATE TABLE ValidPaths (
+    id               integer primary key autoincrement not null,
+    path             text unique not null,
+    hash             text not null,
+    registrationTime integer not null,
+    deriver          text,
+    narSize          integer,
+    ultimate         integer, -- null implies "false"
+    sigs             text, -- space-separated
+    ca               text -- if not null, an assertion that the path is content-addressed; see ValidPathInfo
+);
+CREATE TABLE sqlite_sequence(name,seq);
+CREATE TABLE Refs (
+    referrer  integer not null,
+    reference integer not null,
+    primary key (referrer, reference),
+    foreign key (referrer) references ValidPaths(id) on delete cascade,
+    foreign key (reference) references ValidPaths(id) on delete restrict
+);
+CREATE INDEX IndexReferrer on Refs(referrer);
+CREATE INDEX IndexReference on Refs(reference);
+CREATE TRIGGER DeleteSelfRefs before delete on ValidPaths
+  begin
+    delete from Refs where referrer = old.id and reference = old.id;
+  end;
+CREATE TABLE DerivationOutputs (
+    drv  integer not null,
+    id   text not null, -- symbolic output id, usually "out"
+    path text not null,
+    primary key (drv, id),
+    foreign key (drv) references ValidPaths(id) on delete cascade
+);
+CREATE INDEX IndexDerivationOutputs on DerivationOutputs(path);
+--}