building again after merge
Nice, several conversions fell out.
This commit is contained in:
parent
d5628a16b8
commit
535b153381
4 changed files with 9 additions and 16 deletions
|
@ -130,7 +130,7 @@ addExportedLocation :: ExportHandle -> Key -> ExportLocation -> IO ()
|
||||||
addExportedLocation h k el = queueDb h $ do
|
addExportedLocation h k el = queueDb h $ do
|
||||||
void $ insertUnique $ Exported k ef
|
void $ insertUnique $ Exported k ef
|
||||||
let edirs = map
|
let edirs = map
|
||||||
(\ed -> ExportedDirectory (toSFilePath (fromRawFilePath (fromExportDirectory ed))) ef)
|
(\ed -> ExportedDirectory (SFilePath (fromExportDirectory ed)) ef)
|
||||||
(exportDirectories el)
|
(exportDirectories el)
|
||||||
putMany edirs
|
putMany edirs
|
||||||
where
|
where
|
||||||
|
|
|
@ -86,7 +86,7 @@ addAssociatedFile k f = queueDb $ do
|
||||||
deleteWhere [AssociatedFile ==. af, AssociatedKey !=. k]
|
deleteWhere [AssociatedFile ==. af, AssociatedKey !=. k]
|
||||||
void $ insertUnique $ Associated k af
|
void $ insertUnique $ Associated k af
|
||||||
where
|
where
|
||||||
af = toSFilePath (fromRawFilePath (getTopFilePath f))
|
af = SFilePath (getTopFilePath f)
|
||||||
|
|
||||||
-- Does not remove any old association for a file, but less expensive
|
-- Does not remove any old association for a file, but less expensive
|
||||||
-- than addAssociatedFile. Calling dropAllAssociatedFiles first and then
|
-- than addAssociatedFile. Calling dropAllAssociatedFiles first and then
|
||||||
|
@ -94,7 +94,7 @@ addAssociatedFile k f = queueDb $ do
|
||||||
addAssociatedFileFast :: Key -> TopFilePath -> WriteHandle -> IO ()
|
addAssociatedFileFast :: Key -> TopFilePath -> WriteHandle -> IO ()
|
||||||
addAssociatedFileFast k f = queueDb $ void $ insertUnique $ Associated k af
|
addAssociatedFileFast k f = queueDb $ void $ insertUnique $ Associated k af
|
||||||
where
|
where
|
||||||
af = toSFilePath (fromRawFilePath (getTopFilePath f))
|
af = SFilePath (getTopFilePath f)
|
||||||
|
|
||||||
dropAllAssociatedFiles :: WriteHandle -> IO ()
|
dropAllAssociatedFiles :: WriteHandle -> IO ()
|
||||||
dropAllAssociatedFiles = queueDb $
|
dropAllAssociatedFiles = queueDb $
|
||||||
|
@ -105,7 +105,7 @@ dropAllAssociatedFiles = queueDb $
|
||||||
getAssociatedFiles :: Key -> ReadHandle -> IO [TopFilePath]
|
getAssociatedFiles :: Key -> ReadHandle -> IO [TopFilePath]
|
||||||
getAssociatedFiles k = readDb $ do
|
getAssociatedFiles k = readDb $ do
|
||||||
l <- selectList [AssociatedKey ==. k] []
|
l <- selectList [AssociatedKey ==. k] []
|
||||||
return $ map (asTopFilePath . toRawFilePath . associatedFile . entityVal) l
|
return $ map (asTopFilePath . (\(SFilePath f) -> f) . associatedFile . entityVal) l
|
||||||
|
|
||||||
{- Gets any keys that are on record as having a particular associated file.
|
{- 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.) -}
|
- (Should be one or none but the database doesn't enforce that.) -}
|
||||||
|
@ -114,13 +114,13 @@ getAssociatedKey f = readDb $ do
|
||||||
l <- selectList [AssociatedFile ==. af] []
|
l <- selectList [AssociatedFile ==. af] []
|
||||||
return $ map (associatedKey . entityVal) l
|
return $ map (associatedKey . entityVal) l
|
||||||
where
|
where
|
||||||
af = toSFilePath (fromRawFilePath (getTopFilePath f))
|
af = SFilePath (getTopFilePath f)
|
||||||
|
|
||||||
removeAssociatedFile :: Key -> TopFilePath -> WriteHandle -> IO ()
|
removeAssociatedFile :: Key -> TopFilePath -> WriteHandle -> IO ()
|
||||||
removeAssociatedFile k f = queueDb $
|
removeAssociatedFile k f = queueDb $
|
||||||
deleteWhere [AssociatedKey ==. k, AssociatedFile ==. af]
|
deleteWhere [AssociatedKey ==. k, AssociatedFile ==. af]
|
||||||
where
|
where
|
||||||
af = toSFilePath (fromRawFilePath (getTopFilePath f))
|
af = SFilePath (getTopFilePath f)
|
||||||
|
|
||||||
addInodeCaches :: Key -> [InodeCache] -> WriteHandle -> IO ()
|
addInodeCaches :: Key -> [InodeCache] -> WriteHandle -> IO ()
|
||||||
addInodeCaches k is = queueDb $
|
addInodeCaches k is = queueDb $
|
||||||
|
|
|
@ -28,7 +28,6 @@ import Foreign.C.Types
|
||||||
import Key
|
import Key
|
||||||
import Utility.InodeCache
|
import Utility.InodeCache
|
||||||
import Utility.FileSize
|
import Utility.FileSize
|
||||||
import Utility.FileSystemEncoding
|
|
||||||
import Git.Types
|
import Git.Types
|
||||||
import Types.UUID
|
import Types.UUID
|
||||||
import Types.Import
|
import Types.Import
|
||||||
|
@ -79,16 +78,10 @@ instance PersistField ContentIdentifier where
|
||||||
instance PersistFieldSql ContentIdentifier where
|
instance PersistFieldSql ContentIdentifier where
|
||||||
sqlType _ = SqlBlob
|
sqlType _ = SqlBlob
|
||||||
|
|
||||||
-- A serialized FilePath. Stored as a ByteString to avoid encoding problems.
|
-- A serialized RawFilePath.
|
||||||
newtype SFilePath = SFilePath S.ByteString
|
newtype SFilePath = SFilePath S.ByteString
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
toSFilePath :: FilePath -> SFilePath
|
|
||||||
toSFilePath = SFilePath . encodeBS
|
|
||||||
|
|
||||||
fromSFilePath :: SFilePath -> FilePath
|
|
||||||
fromSFilePath (SFilePath b) = decodeBS b
|
|
||||||
|
|
||||||
instance PersistField SFilePath where
|
instance PersistField SFilePath where
|
||||||
toPersistValue (SFilePath b) = toPersistValue b
|
toPersistValue (SFilePath b) = toPersistValue b
|
||||||
fromPersistValue v = SFilePath <$> fromPersistValue v
|
fromPersistValue v = SFilePath <$> fromPersistValue v
|
||||||
|
|
|
@ -95,14 +95,14 @@ removeOldDb getdb = do
|
||||||
populateKeysDb :: Annex ()
|
populateKeysDb :: Annex ()
|
||||||
populateKeysDb = do
|
populateKeysDb = do
|
||||||
top <- fromRepo Git.repoPath
|
top <- fromRepo Git.repoPath
|
||||||
(l, cleanup) <- inRepo $ LsFiles.inodeCaches [toRawFilePath top]
|
(l, cleanup) <- inRepo $ LsFiles.inodeCaches [top]
|
||||||
forM_ l $ \case
|
forM_ l $ \case
|
||||||
(_f, Nothing) -> giveup "Unable to parse git ls-files --debug output while upgrading git-annex sqlite databases."
|
(_f, Nothing) -> giveup "Unable to parse git ls-files --debug output while upgrading git-annex sqlite databases."
|
||||||
(f, Just ic) -> unlessM (liftIO $ isSymbolicLink <$> getSymbolicLinkStatus f) $ do
|
(f, Just ic) -> unlessM (liftIO $ isSymbolicLink <$> getSymbolicLinkStatus f) $ do
|
||||||
catKeyFile (toRawFilePath f) >>= \case
|
catKeyFile (toRawFilePath f) >>= \case
|
||||||
Nothing -> noop
|
Nothing -> noop
|
||||||
Just k -> do
|
Just k -> do
|
||||||
topf <- inRepo $ toTopFilePath f
|
topf <- inRepo $ toTopFilePath $ toRawFilePath f
|
||||||
Database.Keys.runWriter $ \h -> liftIO $ do
|
Database.Keys.runWriter $ \h -> liftIO $ do
|
||||||
Database.Keys.SQL.addAssociatedFileFast k topf h
|
Database.Keys.SQL.addAssociatedFileFast k topf h
|
||||||
Database.Keys.SQL.addInodeCaches k [ic] h
|
Database.Keys.SQL.addInodeCaches k [ic] h
|
||||||
|
|
Loading…
Reference in a new issue