From 42bdc9fa2f2fefa3b86d8c0303fa6ce436396b8d Mon Sep 17 00:00:00 2001 From: Sean Parsons Date: Sun, 4 Nov 2018 20:46:39 +0000 Subject: [PATCH] Removed Esqueleto as a dependency. --- .gitignore | 2 ++ Database/Export.hs | 39 +++++++-------------- Database/Fsck.hs | 8 ++--- Database/Keys/SQL.hs | 35 +++++++------------ default.nix | 4 +++ git-annex.cabal | 5 ++- nix/git-annex.nix | 64 +++++++++++++++++++++++++++++++++++ nixpkgs.json | 7 ++++ release.nix | 80 ++++++++++++++++++++++++++++++++++++++++++++ shell.nix | 36 ++++++++++++++++++++ 10 files changed, 224 insertions(+), 56 deletions(-) create mode 100644 default.nix create mode 100644 nix/git-annex.nix create mode 100644 nixpkgs.json create mode 100644 release.nix create mode 100644 shell.nix 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/Database/Export.hs b/Database/Export.hs index ed92a38bac..c45099d321 100644 --- a/Database/Export.hs +++ b/Database/Export.hs @@ -48,8 +48,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 @@ -107,17 +107,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 () @@ -137,13 +134,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) @@ -151,19 +145,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 @@ -171,10 +161,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 @@ -186,9 +174,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..de2631390a 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/default.nix b/default.nix new file mode 100644 index 0000000000..861d720f7e --- /dev/null +++ b/default.nix @@ -0,0 +1,4 @@ +{ compiler ? "ghc844" }: + +(import ./release.nix {inherit compiler;}).git-annex + diff --git a/git-annex.cabal b/git-annex.cabal index d312093e5c..708b114afc 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -297,7 +297,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), @@ -335,8 +335,7 @@ Executable git-annex conduit, time, old-locale, - esqueleto, - persistent-sqlite (>= 2.1.3), + persistent-sqlite (>= 2.1.3), persistent, persistent-template, microlens, diff --git a/nix/git-annex.nix b/nix/git-annex.nix new file mode 100644 index 0000000000..1cecb075c0 --- /dev/null +++ b/nix/git-annex.nix @@ -0,0 +1,64 @@ +{ mkDerivation, aeson, async, attoparsec, base, bloomfilter, bup +, byteable, bytestring, Cabal, case-insensitive, concurrent-output +, conduit, connection, containers, crypto-api, cryptonite, curl +, data-default, DAV, dbus, directory, disk-free-space, dlist +, edit-distance, exceptions, fdo-notify, feed, filepath, free, git +, gnupg, hinotify, hslogger, http-client, http-client-tls +, http-conduit, http-types, IfElse, lsof, magic, memory, microlens +, monad-control, monad-logger, mountpoints, mtl, network +, network-info, network-multicast, network-uri, old-locale, openssh +, optparse-applicative, perl, persistent, persistent-sqlite +, persistent-template, process, QuickCheck, random, regex-tdfa +, resourcet, rsync, SafeSemaphore, sandi, securemem, socks, split +, stdenv, stm, stm-chans, tagsoup, tasty, tasty-hunit +, tasty-quickcheck, tasty-rerun, text, time, torrent, transformers +, unix, unix-compat, unordered-containers, utf8-string, uuid +, vector, wget, which +}: +mkDerivation { + pname = "git-annex"; + version = "7.20181031"; + src = ./..; + configureFlags = [ + "-fassistant" "-fcryptonite" "-fdbus" "-fdesktopnotify" "-fdns" + "-ffeed" "-finotify" "-fpairing" "-fproduction" "-fquvi" "-f-s3" + "-ftahoe" "-ftdfa" "-ftestsuite" "-ftorrentparser" "-f-webapp" + "-f-webapp-secure" "-fwebdav" "-fxmpp" + ]; + isLibrary = false; + isExecutable = true; + setupHaskellDepends = [ + base bytestring Cabal data-default directory exceptions filepath + hslogger IfElse process split transformers unix-compat utf8-string + ]; + executableHaskellDepends = [ + aeson async attoparsec base bloomfilter byteable bytestring + case-insensitive concurrent-output conduit connection containers + crypto-api cryptonite data-default DAV dbus directory + disk-free-space dlist edit-distance exceptions fdo-notify feed + filepath free hinotify hslogger http-client http-client-tls + http-conduit http-types IfElse magic memory microlens monad-control + monad-logger mountpoints mtl network network-info network-multicast + network-uri old-locale optparse-applicative persistent + persistent-sqlite persistent-template process QuickCheck random + regex-tdfa resourcet SafeSemaphore sandi securemem socks split stm + stm-chans tagsoup tasty tasty-hunit tasty-quickcheck tasty-rerun + text time torrent transformers unix unix-compat + unordered-containers utf8-string uuid vector + ]; + executableSystemDepends = [ + bup curl git gnupg lsof openssh perl rsync wget which + ]; + preConfigure = "export HOME=$TEMPDIR; patchShebangs ."; + installPhase = "make PREFIX=$out BUILDER=: install"; + checkPhase = '' + ln -sf dist/build/git-annex/git-annex git-annex + ln -sf git-annex git-annex-shell + export PATH+=":$PWD" + git-annex test + ''; + enableSharedExecutables = false; + homepage = "http://git-annex.branchable.com/"; + description = "manage files with git, without checking their contents into git"; + license = stdenv.lib.licenses.gpl3; +} diff --git a/nixpkgs.json b/nixpkgs.json new file mode 100644 index 0000000000..9620d2da7c --- /dev/null +++ b/nixpkgs.json @@ -0,0 +1,7 @@ +{ + "url": "https://github.com/NixOS/nixpkgs.git", + "rev": "848f2f3d0dbc79fbe21c6b52a9e5628e02ed3bcf", + "date": "2018-11-03T14:38:39+01:00", + "sha256": "0wsifg08jx794mmvhx833x3wf0hq0hpgh8wlkkxx9s2yn2j0d233", + "fetchSubmodules": true +} diff --git a/release.nix b/release.nix new file mode 100644 index 0000000000..ef35af84cb --- /dev/null +++ b/release.nix @@ -0,0 +1,80 @@ +{ compiler ? "ghc844" }: + +let + # Disable tests for these packages + dontCheckPackages = [ + ]; + + # Jailbreak these packages + doJailbreakPackages = [ + ]; + + # Disable haddocks for these packages + dontHaddockPackages = [ + ]; + + generatedOverrides = haskellPackagesNew: haskellPackagesOld: + let + toPackage = file: _: { + name = builtins.replaceStrings [ ".nix" ] [ "" ] file; + value = haskellPackagesNew.callPackage (./. + "/nix/${file}") { }; + }; + in + pkgs.lib.mapAttrs' toPackage (builtins.readDir ./nix); + + makeOverrides = + function: names: haskellPackagesNew: haskellPackagesOld: + let + toPackage = name: { + inherit name; + value = function haskellPackagesOld.${name}; + }; + in + builtins.listToAttrs (map toPackage names); + + composeExtensionsList = + pkgs.lib.fold pkgs.lib.composeExtensions (_: _: {}); + + # More exotic overrides go here + manualOverrides = haskellPackagesNew: haskellPackagesOld: { + git-annex = haskellPackagesNew.callPackage ./nix/git-annex.nix { + inherit (pkgs) bup curl git gnupg lsof openssh perl rsync wget which; + }; + }; + + config = { + allowUnfree = true; + packageOverrides = pkgs: rec { + haskell = pkgs.haskell // { + packages = pkgs.haskell.packages // { + "${compiler}" = pkgs.haskell.packages."${compiler}".override { + overrides = composeExtensionsList [ + generatedOverrides + (makeOverrides pkgs.haskell.lib.dontCheck dontCheckPackages ) + (makeOverrides pkgs.haskell.lib.doJailbreak doJailbreakPackages) + (makeOverrides pkgs.haskell.lib.dontHaddock dontHaddockPackages) + manualOverrides + ]; + }; + }; + }; + }; + }; + + bootstrap = import { }; + nixpkgs = builtins.fromJSON (builtins.readFile ./nixpkgs.json); + nixpkgssrc = bootstrap.fetchFromGitHub { + owner = "NixOS"; + repo = "nixpkgs"; + inherit (nixpkgs) rev sha256; + }; + pkgs = import nixpkgssrc { inherit config; }; + + haskell-packages = pkgs.haskell.packages.${compiler}; + +in + { git-annex = haskell-packages.git-annex; + haskell-packages = haskell-packages; + cabal = pkgs.haskellPackages.cabal-install; + pkgs = pkgs; + } diff --git a/shell.nix b/shell.nix new file mode 100644 index 0000000000..d4b235fa19 --- /dev/null +++ b/shell.nix @@ -0,0 +1,36 @@ +{ compiler ? "ghc844" }: + +let + release = (import ./release.nix {inherit compiler;}); + pkgs = release.pkgs; + scripts = [ + (pkgs.writeScriptBin "rebuild-nix" '' + #!/usr/bin/env bash + cd $(${pkgs.git}/bin/git rev-parse --show-toplevel)/nix + ${pkgs.haskellPackages.cabal2nix}/bin/cabal2nix .. > git-annex.nix + '') + (pkgs.writeScriptBin "ghcid-watch" '' + #!/usr/bin/env bash + ${pkgs.haskellPackages.ghcid}/bin/ghcid --command 'cabal new-repl all' + '') + ]; + shell = release.haskell-packages.shellFor { packages = p: [p.git-annex p.magic]; }; +in pkgs.stdenv.lib.overrideDerivation shell (oldAttrs: rec { + LD_LIBRARY_PATH = (oldAttrs.LD_LIBRARY_PATH or []) ++ [ + "${pkgs.file}/lib/" + ]; + nativeBuildInputs = (oldAttrs.nativeBuildInputs or []) ++ [ + (pkgs.stdenv.mkDerivation { + name = "scripts"; + phases = "installPhase"; + installPhase = '' + mkdir -p $out/bin + '' + (builtins.concatStringsSep "" (builtins.map (script: '' + for f in $(ls -d ${script}/bin/*); do ln -s $f $out/bin; done + '') scripts)); + }) + release.cabal + pkgs.watchexec + pkgs.haskellPackages.cabal2nix + ]; +})