Removed Esqueleto as a dependency.
This commit is contained in:
parent
1011d957aa
commit
42bdc9fa2f
10 changed files with 224 additions and 56 deletions
|
@ -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]
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue