diff --git a/.gitignore b/.gitignore index 13c0765d0e..aa86618299 100644 --- a/.gitignore +++ b/.gitignore @@ -22,6 +22,8 @@ html *.tix .hpc dist +dist-newstyle +result # Sandboxed builds cabal-dev .cabal-sandbox diff --git a/CHANGELOG b/CHANGELOG index c482fd40b7..8204d4e188 100644 --- a/CHANGELOG +++ b/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 Tue, 06 Nov 2018 12:44:27 -0400 diff --git a/Database/Export.hs b/Database/Export.hs index f84f31d9bd..9786196b46 100644 --- a/Database/Export.hs +++ b/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 - where_ (r ^. ExportTreeCurrentTree ==. r ^. ExportTreeCurrentTree) + deleteWhere ([] :: [Filter ExportTreeCurrent]) void $ insertUnique $ ExportTreeCurrent $ toSRef s getExportTreeCurrent :: ExportHandle -> IO (Maybe Sha) getExportTreeCurrent (ExportHandle h _) = H.queryDbQueue h $ do - l <- select $ from $ \r -> do - where_ (r ^. ExportTreeCurrentTree ==. r ^. ExportTreeCurrentTree) - return (r ^. ExportTreeCurrentTree) + l <- selectList ([] :: [Filter ExportTreeCurrent]) [] 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 - where_ (r ^. ExportedKey ==. val ik &&. r ^. ExportedFile ==. val ef) + deleteWhere [ExportedKey ==. ik, ExportedFile ==. ef] let subdirs = map (toSFilePath . fromExportDirectory) (exportDirectories el) - delete $ from $ \r -> do - where_ (r ^. ExportedDirectoryFile ==. val ef - &&. r ^. ExportedDirectorySubdir `in_` valList subdirs) + deleteWhere [ExportedDirectoryFile ==. ef, ExportedDirectorySubdir <-. 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 - where_ (r ^. ExportedKey ==. val ik) - return (r ^. ExportedFile) - return $ map (mkExportLocation . fromSFilePath . unValue) l + l <- selectList [ExportedKey ==. ik] [] + return $ map (mkExportLocation . fromSFilePath . exportedFile . entityVal) 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 - where_ (r ^. ExportedDirectorySubdir ==. val ed) - return (r ^. ExportedDirectoryFile) + l <- selectList [ExportedDirectorySubdir ==. ed] [] 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 - where_ (r ^. ExportTreeKey ==. val ik) - return (r ^. ExportTreeFile) - return $ map (mkExportLocation . fromSFilePath . unValue) l + l <- selectList [ExportTreeKey ==. ik] [] + return $ map (mkExportLocation . fromSFilePath . exportTreeFile . entityVal) l where ik = toIKey k @@ -187,9 +175,8 @@ addExportTree h k loc = queueDb h $ ef = toSFilePath (fromExportLocation loc) removeExportTree :: ExportHandle -> Key -> ExportLocation -> IO () -removeExportTree h k loc = queueDb h $ - delete $ from $ \r -> - where_ (r ^. ExportTreeKey ==. val ik &&. r ^. ExportTreeFile ==. val ef) +removeExportTree h k loc = queueDb h $ + deleteWhere [ExportTreeKey ==. ik, ExportTreeFile ==. ef] where ik = toIKey k ef = toSFilePath (fromExportLocation loc) diff --git a/Database/Fsck.hs b/Database/Fsck.hs index 1ce513dcf9..fcfb1c9571 100644 --- a/Database/Fsck.hs +++ b/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 @@ -72,7 +72,7 @@ closeDb (FsckHandle h u) = do unlockFile =<< fromRepo (gitAnnexFsckDbLock u) addDb :: FsckHandle -> Key -> IO () -addDb (FsckHandle h _) k = H.queueDb h checkcommit $ +addDb (FsckHandle h _) k = H.queueDb h checkcommit $ void $ insertUnique $ Fscked sk where sk = toSKey k @@ -90,7 +90,5 @@ inDb (FsckHandle h _) = H.queryDbQueue h . inDb' . toSKey inDb' :: SKey -> SqlPersistM Bool inDb' sk = do - r <- select $ from $ \r -> do - where_ (r ^. FsckedKey ==. val sk) - return (r ^. FsckedKey) + r <- selectList [FsckedKey ==. sk] [] return $ not $ null r diff --git a/Database/Keys/SQL.hs b/Database/Keys/SQL.hs index 77c1e4429c..06ca08c7ef 100644 --- a/Database/Keys/SQL.hs +++ b/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 - where_ (r ^. AssociatedFile ==. val af &&. not_ (r ^. AssociatedKey ==. val ik)) + deleteWhere [AssociatedFile ==. af, AssociatedKey !=. 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 - where_ (r ^. AssociatedKey ==. val ik) - return (r ^. AssociatedFile) - return $ map (asTopFilePath . fromSFilePath . unValue) l + l <- selectList [AssociatedKey ==. ik] [] + return $ map (asTopFilePath . fromSFilePath . associatedFile . entityVal) 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 - where_ (r ^. AssociatedFile ==. val af) - return (r ^. AssociatedKey) - return $ map unValue l + l <- selectList [AssociatedFile ==. af] [] + return $ map (associatedKey . entityVal) l where af = toSFilePath (getTopFilePath f) removeAssociatedFile :: IKey -> TopFilePath -> WriteHandle -> IO () -removeAssociatedFile ik f = queueDb $ - delete $ from $ \r -> do - where_ (r ^. AssociatedKey ==. val ik &&. r ^. AssociatedFile ==. val af) +removeAssociatedFile ik f = queueDb $ + deleteWhere [AssociatedKey ==. ik, AssociatedFile ==. 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 - where_ (r ^. ContentKey ==. val ik) - return (r ^. ContentCache) - return $ map (fromSInodeCache . unValue) l + l <- selectList [ContentKey ==. ik] [] + return $ map (fromSInodeCache . contentCache . entityVal) l removeInodeCaches :: IKey -> WriteHandle -> IO () -removeInodeCaches ik = queueDb $ - delete $ from $ \r -> do - where_ (r ^. ContentKey ==. val ik) +removeInodeCaches ik = queueDb $ + deleteWhere [ContentKey ==. ik] diff --git a/debian/control b/debian/control index c2defcd39c..185aaeba91 100644 --- a/debian/control +++ b/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, diff --git a/git-annex.cabal b/git-annex.cabal index 391e082cc0..21dbecfe00 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -301,7 +301,7 @@ Executable git-annex base (>= 4.9 && < 5.0), network (>= 2.6.3.0), network-uri (>= 2.6), - optparse-applicative (>= 0.11.0), + optparse-applicative (>= 0.11.0), containers (>= 0.5.7.1), exceptions (>= 0.6), stm (>= 2.3), @@ -339,8 +339,7 @@ Executable git-annex conduit, time, old-locale, - esqueleto, - persistent-sqlite (>= 2.1.3), + persistent-sqlite (>= 2.1.3), persistent, persistent-template, microlens,