Removed Esqueleto as a dependency.
This commit is contained in:
parent
1011d957aa
commit
42bdc9fa2f
10 changed files with 224 additions and 56 deletions
2
.gitignore
vendored
2
.gitignore
vendored
|
@ -22,6 +22,8 @@ html
|
|||
*.tix
|
||||
.hpc
|
||||
dist
|
||||
dist-newstyle
|
||||
result
|
||||
# Sandboxed builds
|
||||
cabal-dev
|
||||
.cabal-sandbox
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
4
default.nix
Normal file
|
@ -0,0 +1,4 @@
|
|||
{ compiler ? "ghc844" }:
|
||||
|
||||
(import ./release.nix {inherit compiler;}).git-annex
|
||||
|
|
@ -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
64
nix/git-annex.nix
Normal 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
7
nixpkgs.json
Normal 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
80
release.nix
Normal 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
36
shell.nix
Normal 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
|
||||
];
|
||||
})
|
Loading…
Reference in a new issue