Removed Esqueleto as a dependency.

This commit is contained in:
Sean Parsons 2018-11-04 20:46:39 +00:00
parent 1011d957aa
commit 42bdc9fa2f
10 changed files with 224 additions and 56 deletions

2
.gitignore vendored
View file

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

View file

@ -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)

View file

@ -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

View file

@ -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]

4
default.nix Normal file
View file

@ -0,0 +1,4 @@
{ compiler ? "ghc844" }:
(import ./release.nix {inherit compiler;}).git-annex

View file

@ -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,

64
nix/git-annex.nix Normal file
View file

@ -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;
}

7
nixpkgs.json Normal file
View file

@ -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
}

80
release.nix Normal file
View file

@ -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> { };
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;
}

36
shell.nix Normal file
View file

@ -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
];
})