mirror of
https://code.sup39.dev/repos/Wqawg
synced 2024-12-27 16:14:51 +09:00
DB: Migration: When switching repos dir to new layout, remove old sharer dirs
This commit is contained in:
parent
6b0783a10b
commit
482e2e806e
1 changed files with 19 additions and 3 deletions
|
@ -62,6 +62,7 @@ import Web.PathPieces (toPathPiece)
|
||||||
|
|
||||||
import qualified Data.CaseInsensitive as CI
|
import qualified Data.CaseInsensitive as CI
|
||||||
import qualified Data.HashMap.Strict as M
|
import qualified Data.HashMap.Strict as M
|
||||||
|
import qualified Data.List.Ordered as LO
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Lazy as TL
|
import qualified Data.Text.Lazy as TL
|
||||||
import qualified Data.Text.Lazy.Builder as TLB
|
import qualified Data.Text.Lazy.Builder as TLB
|
||||||
|
@ -2225,20 +2226,35 @@ changes hLocal ctx =
|
||||||
-- 396
|
-- 396
|
||||||
, unchecked $ lift $ do
|
, unchecked $ lift $ do
|
||||||
rs <- selectList [] [Asc Repo396Id]
|
rs <- selectList [] [Asc Repo396Id]
|
||||||
for_ rs $ \ (Entity rid r) -> do
|
oldSharerDirs <- fmap (LO.nubSort . catMaybes) $ for rs $ \ (Entity rid r) -> do
|
||||||
root <- asksSite $ appRepoDir . appSettings
|
root <- asksSite $ appRepoDir . appSettings
|
||||||
parent <- sharer396Ident <$> getJust (repo396Sharer r)
|
parent <- sharer396Ident <$> getJust (repo396Sharer r)
|
||||||
dir <- actor396Name <$> getJust (repo396Actor r)
|
dir <- actor396Name <$> getJust (repo396Actor r)
|
||||||
let old =
|
let oldSharer =
|
||||||
root
|
root
|
||||||
</> (T.unpack $ CI.foldedCase $ unShrIdent parent)
|
</> (T.unpack $ CI.foldedCase $ unShrIdent parent)
|
||||||
|
old =
|
||||||
|
oldSharer
|
||||||
</> (T.unpack $ CI.foldCase dir)
|
</> (T.unpack $ CI.foldCase dir)
|
||||||
new =
|
new =
|
||||||
root
|
root
|
||||||
</> (T.unpack $ keyHashidText $
|
</> (T.unpack $ keyHashidText $
|
||||||
encodeKeyHashidPure ctx rid)
|
encodeKeyHashidPure ctx rid)
|
||||||
--E.toSqlKey $ E.fromSqlKey rid)
|
--E.toSqlKey $ E.fromSqlKey rid)
|
||||||
liftIO $ renameDirectory old new
|
liftIO $ do
|
||||||
|
oldExists <- doesDirectoryExist old
|
||||||
|
newExists <- doesDirectoryExist new
|
||||||
|
case (oldExists, newExists) of
|
||||||
|
(True, False) -> do
|
||||||
|
renameDirectory old new
|
||||||
|
return $ Just oldSharer
|
||||||
|
(True, True) -> error "Both old and new dirs exist"
|
||||||
|
(False, False) -> error "Repo dir missing"
|
||||||
|
(False, True) -> do
|
||||||
|
oldSharerExists <- doesDirectoryExist oldSharer
|
||||||
|
when oldSharerExists $ removeDirectory oldSharer
|
||||||
|
pure Nothing
|
||||||
|
liftIO $ for_ oldSharerDirs removeDirectory
|
||||||
-- 397
|
-- 397
|
||||||
, removeField "Repo" "sharer"
|
, removeField "Repo" "sharer"
|
||||||
-- 398
|
-- 398
|
||||||
|
|
Loading…
Reference in a new issue