Merge branch 'remove-esqueleto'

.gitignore

@@ -22,6 +22,8 @@ html
 *.tix
 .hpc
 dist
+dist-newstyle
+result
 # Sandboxed builds
 cabal-dev
 .cabal-sandbox

CHANGELOG

@@ -4,7 +4,6 @@ git-annex (7.20181106) UNRELEASED; urgency=medium
     different clients at the same time. (Or when annex.pidlock is used,
     two different objects.)
   * Fixed some other potential hangs in the P2P protocol.
-  * Fix build with persistent-sqlite older than 2.6.3.
   * Fix bash completion of "git annex" to propertly handle files with
     spaces and other problem characters. (Completion of "git-annex"
     already did.)
@@ -23,6 +22,11 @@ git-annex (7.20181106) UNRELEASED; urgency=medium
     for many types of errors including IO errors.)
   * Fixed a crash when using -J with ssh password prompts in
     --quiet/--json mode.
+  * Remove esqueleto dependency to allow upgrading other dependencies to
+    newer versions.
+    Thanks Sean Parsons.
+  * stack.yaml: Update to lts-12.17.
+  * Fix build with persistent-sqlite older than 2.6.3.
 
  -- Joey Hess <id@joeyh.name>  Tue, 06 Nov 2018 12:44:27 -0400
 

Database/Export.hs

@@ -49,8 +49,8 @@ import Git.Sha
 import Git.FilePath
 import qualified Git.DiffTree
 
+import Database.Persist.Sql hiding (Key)
 import Database.Persist.TH
-import Database.Esqueleto hiding (Key)
 
 data ExportHandle = ExportHandle H.DbQueue UUID
 
@@ -108,17 +108,14 @@ flushDbQueue (ExportHandle h _) = H.flushDbQueue h
 
 recordExportTreeCurrent :: ExportHandle -> Sha -> IO ()
 recordExportTreeCurrent h s = queueDb h $ do
-	delete $ from $ \r -> do
+	deleteWhere ([] :: [Filter ExportTreeCurrent])
-		where_ (r ^. ExportTreeCurrentTree ==. r ^. ExportTreeCurrentTree)
 	void $ insertUnique $ ExportTreeCurrent $ toSRef s
 
 getExportTreeCurrent :: ExportHandle -> IO (Maybe Sha)
 getExportTreeCurrent (ExportHandle h _) = H.queryDbQueue h $ do
-	l <- select $ from $ \r -> do
+	l <- selectList ([] :: [Filter ExportTreeCurrent]) []
-		where_ (r ^. ExportTreeCurrentTree ==. r ^. ExportTreeCurrentTree)
-		return (r ^. ExportTreeCurrentTree)
 	case l of
-		(s:[]) -> return $ Just $ fromSRef $ unValue s
+		(s:[]) -> return $ Just $ fromSRef $ exportTreeCurrentTree $ entityVal s
 		_ -> return Nothing
 
 addExportedLocation :: ExportHandle -> Key -> ExportLocation -> IO ()
@@ -138,13 +135,10 @@ addExportedLocation h k el = queueDb h $ do
 
 removeExportedLocation :: ExportHandle -> Key -> ExportLocation -> IO ()
 removeExportedLocation h k el = queueDb h $ do
-	delete $ from $ \r -> do
+	deleteWhere [ExportedKey ==. ik, ExportedFile ==. ef]
-		where_ (r ^. ExportedKey ==. val ik &&. r ^. ExportedFile ==. val ef)
 	let subdirs = map (toSFilePath . fromExportDirectory)
 		(exportDirectories el)
-	delete $ from $ \r -> do
+	deleteWhere [ExportedDirectoryFile ==. ef, ExportedDirectorySubdir <-. subdirs]
-		where_ (r ^. ExportedDirectoryFile ==. val ef
-			&&. r ^. ExportedDirectorySubdir `in_` valList subdirs)
   where
 	ik = toIKey k
 	ef = toSFilePath (fromExportLocation el)
@@ -152,19 +146,15 @@ removeExportedLocation h k el = queueDb h $ do
 {- Note that this does not see recently queued changes. -}
 getExportedLocation :: ExportHandle -> Key -> IO [ExportLocation]
 getExportedLocation (ExportHandle h _) k = H.queryDbQueue h $ do
-	l <- select $ from $ \r -> do
+	l <- selectList [ExportedKey ==. ik] []
-		where_ (r ^. ExportedKey ==. val ik)
+	return $ map (mkExportLocation . fromSFilePath . exportedFile . entityVal) l
-		return (r ^. ExportedFile)
-	return $ map (mkExportLocation . fromSFilePath . unValue) l
   where
 	ik = toIKey k
 
 {- Note that this does not see recently queued changes. -}
 isExportDirectoryEmpty :: ExportHandle -> ExportDirectory -> IO Bool
 isExportDirectoryEmpty (ExportHandle h _) d = H.queryDbQueue h $ do
-	l <- select $ from $ \r -> do
+	l <- selectList [ExportedDirectorySubdir ==. ed] []
-		where_ (r ^. ExportedDirectorySubdir ==. val ed)
-		return (r ^. ExportedDirectoryFile)
 	return $ null l
   where
 	ed = toSFilePath $ fromExportDirectory d
@@ -172,10 +162,8 @@ isExportDirectoryEmpty (ExportHandle h _) d = H.queryDbQueue h $ do
 {- Get locations in the export that might contain a key. -}
 getExportTree :: ExportHandle -> Key -> IO [ExportLocation]
 getExportTree (ExportHandle h _) k = H.queryDbQueue h $ do
-	l <- select $ from $ \r -> do
+	l <- selectList [ExportTreeKey ==. ik] []
-		where_ (r ^. ExportTreeKey ==. val ik)
+	return $ map (mkExportLocation . fromSFilePath . exportTreeFile . entityVal) l
-		return (r ^. ExportTreeFile)
-	return $ map (mkExportLocation . fromSFilePath . unValue) l
   where
 	ik = toIKey k
 
@@ -188,8 +176,7 @@ addExportTree h k loc = queueDb h $
 
 removeExportTree :: ExportHandle -> Key -> ExportLocation -> IO ()
 removeExportTree h k loc = queueDb h $
-	delete $ from $ \r ->
+	deleteWhere [ExportTreeKey ==. ik, ExportTreeFile ==. ef]
-		where_ (r ^. ExportTreeKey ==. val ik &&. r ^. ExportTreeFile ==. val ef)
   where
 	ik = toIKey k
 	ef = toSFilePath (fromExportLocation loc)

Database/Fsck.hs

@@ -28,8 +28,8 @@ import Utility.Exception
 import Annex.Common
 import Annex.LockFile
 
+import Database.Persist.Sql hiding (Key)
 import Database.Persist.TH
-import Database.Esqueleto hiding (Key)
 import Data.Time.Clock
 
 data FsckHandle = FsckHandle H.DbQueue UUID
@@ -90,7 +90,5 @@ inDb (FsckHandle h _) = H.queryDbQueue h . inDb' . toSKey
 
 inDb' :: SKey -> SqlPersistM Bool
 inDb' sk = do
-	r <- select $ from $ \r -> do
+	r <- selectList [FsckedKey ==. sk] []
-		where_ (r ^. FsckedKey ==. val sk)
-		return (r ^. FsckedKey)
 	return $ not $ null r

Database/Keys/SQL.hs

@@ -18,8 +18,8 @@ import qualified Database.Queue as H
 import Utility.InodeCache
 import Git.FilePath
 
+import Database.Persist.Sql
 import Database.Persist.TH
-import Database.Esqueleto hiding (Key)
 import Data.Time.Clock
 import Control.Monad
 
@@ -62,8 +62,7 @@ addAssociatedFile :: IKey -> TopFilePath -> WriteHandle -> IO ()
 addAssociatedFile ik f = queueDb $ do
 	-- If the same file was associated with a different key before,
 	-- remove that.
-	delete $ from $ \r -> do
+	deleteWhere [AssociatedFile ==. af, AssociatedKey !=. ik]
-		where_ (r ^. AssociatedFile ==. val af &&. not_ (r ^. AssociatedKey ==. val ik))
 	void $ insertUnique $ Associated ik af
   where
 	af = toSFilePath (getTopFilePath f)
@@ -78,32 +77,27 @@ addAssociatedFileFast ik f = queueDb $ void $ insertUnique $ Associated ik af
 
 dropAllAssociatedFiles :: WriteHandle -> IO ()
 dropAllAssociatedFiles = queueDb $
-	delete $ from $ \(_r :: SqlExpr (Entity Associated)) -> return ()
+	deleteWhere ([] :: [Filter Associated])
 
 {- Note that the files returned were once associated with the key, but
  - some of them may not be any longer. -}
 getAssociatedFiles :: IKey -> ReadHandle -> IO [TopFilePath]
 getAssociatedFiles ik = readDb $ do
-	l <- select $ from $ \r -> do
+	l <- selectList [AssociatedKey ==. ik] []
-		where_ (r ^. AssociatedKey ==. val ik)
+	return $ map (asTopFilePath . fromSFilePath . associatedFile . entityVal) l
-		return (r ^. AssociatedFile)
-	return $ map (asTopFilePath . fromSFilePath . unValue) l
 
 {- Gets any keys that are on record as having a particular associated file.
  - (Should be one or none but the database doesn't enforce that.) -}
 getAssociatedKey :: TopFilePath -> ReadHandle -> IO [IKey]
 getAssociatedKey f = readDb $ do
-	l <- select $ from $ \r -> do
+	l <- selectList [AssociatedFile ==. af] []
-		where_ (r ^. AssociatedFile ==. val af)
+	return $ map (associatedKey . entityVal) l
-		return (r ^. AssociatedKey)
-	return $ map unValue l
   where
 	af = toSFilePath (getTopFilePath f)
 
 removeAssociatedFile :: IKey -> TopFilePath -> WriteHandle -> IO ()
 removeAssociatedFile ik f = queueDb $
-	delete $ from $ \r -> do
+	deleteWhere [AssociatedKey ==. ik, AssociatedFile ==. af]
-		where_ (r ^. AssociatedKey ==. val ik &&. r ^. AssociatedFile ==. val af)
   where
 	af = toSFilePath (getTopFilePath f)
 
@@ -115,12 +109,9 @@ addInodeCaches ik is = queueDb $
  - for each pointer file that is a copy of it. -}
 getInodeCaches :: IKey -> ReadHandle -> IO [InodeCache]
 getInodeCaches ik = readDb $ do
-	l <- select $ from $ \r -> do
+	l <- selectList [ContentKey ==. ik] []
-		where_ (r ^. ContentKey ==. val ik)
+	return $ map (fromSInodeCache . contentCache . entityVal) l
-		return (r ^. ContentCache)
-	return $ map (fromSInodeCache . unValue) l
 
 removeInodeCaches :: IKey -> WriteHandle -> IO ()
 removeInodeCaches ik = queueDb $
-	delete $ from $ \r -> do
+	deleteWhere [ContentKey ==. ik]
-		where_ (r ^. ContentKey ==. val ik)

debian/control

@@ -49,7 +49,6 @@ Build-Depends:
 	libghc-persistent-dev,
 	libghc-persistent-template-dev,
 	libghc-persistent-sqlite-dev,
-	libghc-esqueleto-dev,
 	libghc-microlens-dev,
 	libghc-securemem-dev,
 	libghc-byteable-dev,

git-annex.cabal

@@ -339,7 +339,6 @@ Executable git-annex
    conduit,
    time,
    old-locale,
-   esqueleto,
    persistent-sqlite (>= 2.1.3),
    persistent,
    persistent-template,