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

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE Rank2Types #-}
+
 module System.Nix.Store.DB.Query
   ( queryPathInfoEntity
   , queryPathInfo
@@ -23,7 +24,7 @@ module System.Nix.Store.DB.Query
 import Control.Monad.IO.Class (MonadIO)
 import Control.Monad.Logger (MonadLogger)
 import Data.Text (Text)
-import Database.Esqueleto
+import Database.Esqueleto.Experimental
 import System.Nix.StorePath (StoreDir, StorePath, StorePathHashPart)
 import System.Nix.Store.DB.Schema
 
@@ -43,9 +44,10 @@ queryPathInfoEntity
   => StorePath
   -> SqlReadT m (Maybe (Entity ValidPath))
 queryPathInfoEntity path = do
-  res <- select $ from $ \validPath -> do
-    where_ (validPath ^. ValidPathPath ==. val path)
-    pure validPath
+  res <- select $ do
+    validPaths <- from $ table @ValidPath
+    where_ (validPaths ^. ValidPathPath ==. val path)
+    pure validPaths
   pure $ Data.Maybe.listToMaybe res
 
 -- | Query @ValidPath@ for @StorePath@ if it exists.
@@ -55,7 +57,9 @@ queryPathInfo
      )
   => StorePath
   -> SqlReadT m (Maybe ValidPath)
-queryPathInfo = queryPathInfoEntity >>= pure . (fmap . fmap) entityVal
+queryPathInfo =
+  queryPathInfoEntity
+  >>= pure . (fmap . fmap) entityVal
 
 -- | Query references as a list of @Entity Ref@s for @ValidPath@
 -- using id of @Entity ValidPath@
@@ -66,10 +70,14 @@ queryReferencesEntity
   => Entity ValidPath
   -> SqlReadT m [Entity Ref]
 queryReferencesEntity referrer =
-  select $ from $ \(ref `InnerJoin` validPath) -> do
-    on (ref ^. RefReference ==. validPath ^. ValidPathId)
-    where_ (ref ^. RefReferrer ==. val (entityKey referrer))
-    pure ref
+  select $ do
+    (refs :& _validPaths) <-
+      from $ table @Ref
+      `innerJoin` table @ValidPath
+      `on` (\(refs :& validPaths) ->
+        refs ^. RefReference ==. validPaths ^. ValidPathId)
+    where_ (refs ^. RefReferrer ==. val (entityKey referrer))
+    pure refs
 
 -- | Query references as a list of @Ref@s for @ValidPath@
 -- by id of @Entity ValidPath@
@@ -79,7 +87,9 @@ queryReferences
      )
   => Entity ValidPath
   -> SqlReadT m [Ref]
-queryReferences = queryReferencesEntity >>= pure . (fmap . fmap) entityVal
+queryReferences =
+  queryReferencesEntity
+  >>= pure . (fmap . fmap) entityVal
 
 -- | Query referrers as a list of @Entity Ref@s for @StorePath@
 queryReferrersEntity
@@ -88,16 +98,24 @@ queryReferrersEntity
      )
   => StorePath
   -> SqlReadT m [Entity Ref]
-queryReferrersEntity path =
-  select $ from $ \(ref `InnerJoin` validPath) -> do
-    let sub =
-          subList_select $ from $ \vp -> do
-            where_ (vp ^. ValidPathPath ==. val path)
-            pure $ vp ^. ValidPathId
-
-    on (ref ^. RefReference ==. validPath ^. ValidPathId)
-    where_ (ref ^. RefReference `in_` sub)
-    pure ref
+queryReferrersEntity path = do
+  select $ do
+    (refs :& _validPaths) <-
+      from $ table @Ref
+      `innerJoin` table @ValidPath
+      `on` (\(refs :& validPaths) ->
+        (refs ^. RefReference ==. validPaths ^. ValidPathId))
+    where_
+      (
+        refs ^. RefReference
+        `in_`
+        (subList_select $ do
+          validPaths <- from $ table @ValidPath
+          where_ (validPaths ^. ValidPathPath ==. val path)
+          pure $ validPaths ^. ValidPathId
+        )
+      )
+    pure refs
 
 -- | Query referrers as a list of @Ref@s for @StorePath@
 queryReferrers
@@ -106,7 +124,9 @@ queryReferrers
      )
   => StorePath
   -> SqlReadT m [Ref]
-queryReferrers = queryReferrersEntity >>= pure . (fmap . fmap) entityVal
+queryReferrers =
+  queryReferrersEntity
+  >>= pure . (fmap . fmap) entityVal
 
 -- | Query valid derivers as a list of @(Text, StorePath)@s
 -- for some @StorePath@
@@ -117,10 +137,14 @@ queryValidDerivers
   => StorePath
   -> SqlReadT m [(Text, StorePath)]
 queryValidDerivers path = do
-  res <- select $ from $ \(drvOut `InnerJoin` validPath) -> do
-    on (drvOut ^. DerivationOutputDrv ==. validPath ^. ValidPathId)
-    where_ (drvOut ^. DerivationOutputPath ==. val path)
-    pure (drvOut ^. DerivationOutputName, drvOut ^. DerivationOutputPath)
+  res <- select $ do
+    (drvOuts :& _validPaths) <-
+      from $ table @DerivationOutput
+      `innerJoin` table @ValidPath
+      `on` (\(drvOuts :& validPaths) ->
+        (drvOuts ^. DerivationOutputDrv ==. validPaths ^. ValidPathId))
+    where_ (drvOuts ^. DerivationOutputPath ==. val path)
+    pure (drvOuts ^. DerivationOutputName, drvOuts ^. DerivationOutputPath)
 
   pure $ unValue2 <$> res
 
@@ -133,9 +157,10 @@ queryDerivationOutputs
   => Entity ValidPath
   -> SqlReadT m [(Text, StorePath)]
 queryDerivationOutputs drv = do
-  res <- select $ from $ \drvOut -> do
-    where_ (drvOut ^. DerivationOutputDrv ==. val (entityKey drv))
-    pure (drvOut ^. DerivationOutputName, drvOut ^. DerivationOutputPath)
+  res <- select $ do
+    drvOuts <- from $ table @DerivationOutput
+    where_ (drvOuts ^. DerivationOutputDrv ==. val (entityKey drv))
+    pure (drvOuts ^. DerivationOutputName, drvOuts ^. DerivationOutputPath)
 
   pure $ unValue2 <$> res
 
@@ -176,15 +201,18 @@ queryValidPathsEntity
      , MonadLogger m
      )
   => SqlReadT m [Entity ValidPath]
-queryValidPathsEntity = select $ from pure
+queryValidPathsEntity =
+  select $ from $ table @ValidPath
 
 -- | Query all valid paths as a list of @ValidPath@s
 queryValidPaths
   :: ( MonadIO m
      , MonadLogger m
      )
   => SqlReadT m [ValidPath]
-queryValidPaths = queryValidPathsEntity >>= pure . fmap entityVal
+queryValidPaths =
+  queryValidPathsEntity
+  >>= pure . fmap entityVal
 
 -- * For testing
 
@@ -194,31 +222,37 @@ queryAllRefsEntity
      , MonadLogger m
      )
   => SqlReadT m [Entity Ref]
-queryAllRefsEntity = select $ from pure
+queryAllRefsEntity =
+  select $ from $ table @Ref
 
 -- | Query all references as a list of @Ref@s
 queryAllRefs
   :: ( MonadIO m
      , MonadLogger m
      )
   => SqlReadT m [Ref]
-queryAllRefs = queryAllRefsEntity >>= pure . fmap entityVal
+queryAllRefs =
+  queryAllRefsEntity
+  >>= pure . fmap entityVal
 
 -- | Query all derivation outputs as a list of @Entity DerivationOutput@s
 queryAllDerivationOutputsEntity
   :: ( MonadIO m
      , MonadLogger m
      )
   => SqlReadT m [Entity DerivationOutput]
-queryAllDerivationOutputsEntity = select $ from pure
+queryAllDerivationOutputsEntity =
+  select $ from $ table @DerivationOutput
 
 -- | Query all derivation outputs as a list of @DerivationOutput@s
 queryAllDerivationOutputs
   :: ( MonadIO m
      , MonadLogger m
      )
   => SqlReadT m [DerivationOutput]
-queryAllDerivationOutputs = queryAllDerivationOutputsEntity >>= pure . fmap entityVal
+queryAllDerivationOutputs =
+  queryAllDerivationOutputsEntity
+  >>= pure . fmap entityVal
 
 -- | Query one random derivation as an @Entity ValidPath@
 queryOneValidDerivationEntity
@@ -227,7 +261,8 @@ queryOneValidDerivationEntity
      )
   => SqlReadT m (Maybe (Entity ValidPath))
 queryOneValidDerivationEntity = do
-  res <- select $ from $ \validPath -> do
+  res <- select $ do
+    validPath <- from $ table @ValidPath -- \validPath -> do
     where_
       (
         validPath ^. ValidPathUltimate
@@ -245,7 +280,9 @@ queryOneValidDerivation
      , MonadLogger m
      )
   => SqlReadT m (Maybe ValidPath)
-queryOneValidDerivation = queryOneValidDerivationEntity >>= pure . fmap entityVal
+queryOneValidDerivation =
+  queryOneValidDerivationEntity
+  >>= pure . fmap entityVal
 
 -- * Utility
 

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

@@ -4,7 +4,7 @@ module System.Nix.Store.DB.Run where
 import Control.Monad.Trans.Reader (ReaderT)
 import Data.Default.Class (Default(def))
 
-import Database.Esqueleto
+import Database.Esqueleto.Experimental (entityVal)
 
 import qualified Control.Monad
 import qualified Control.Monad.IO.Class
@@ -63,7 +63,7 @@ runner con act =
     Control.Monad.Trans.Resource.runResourceT
   $ Control.Monad.Logger.runStdoutLoggingT
   $ Database.Persist.Sqlite.withSqliteConn con
-  . runSqlConn
+  . Database.Persist.Sqlite.runSqlConn
   $ act
 
 runner' con act = Database.Persist.Sqlite.runSqlite con act