get many more commands building again
authorJoey Hess <joeyh@joeyh.name>
Thu, 5 Dec 2019 15:40:10 +0000 (11:40 -0400)
committerJoey Hess <joeyh@joeyh.name>
Thu, 5 Dec 2019 15:40:10 +0000 (11:40 -0400)
about half are building now

19 files changed:
CmdLine/GitAnnex.hs
Command/EnableRemote.hs
Command/ExamineKey.hs
Command/Find.hs
Command/Fix.hs
Command/FromKey.hs
Command/InitRemote.hs
Command/Lock.hs
Command/LookupKey.hs
Command/MetaData.hs
Command/Multicast.hs
Command/PreCommit.hs
Command/ReKey.hs
Command/Smudge.hs
Command/TransferKeys.hs
Command/Unlock.hs
Command/Unused.hs
Command/View.hs
Git/Repair.hs

index fd1953faf25f7a04ef51ea6b815e7e05b7e5fff3..daef02d85f1245b216d32341f7aeb762dd6db62f 100644 (file)
@@ -20,15 +20,12 @@ import Types.Benchmark
 
 import qualified Command.Help
 import qualified Command.Add
-{-
 import qualified Command.Unannex
--}
 import qualified Command.Drop
 import qualified Command.Move
 import qualified Command.Copy
 import qualified Command.Get
 import qualified Command.Fsck
-{-
 import qualified Command.LookupKey
 import qualified Command.CalcKey
 import qualified Command.ContentLocation
@@ -51,9 +48,7 @@ import qualified Command.VAdd
 import qualified Command.VFilter
 import qualified Command.VPop
 import qualified Command.VCycle
--}
 import qualified Command.Reinject
-{-
 import qualified Command.Fix
 import qualified Command.Init
 import qualified Command.Describe
@@ -70,6 +65,7 @@ import qualified Command.AddUnused
 import qualified Command.Unlock
 import qualified Command.Lock
 import qualified Command.PreCommit
+{-
 import qualified Command.PostReceive
 -}
 import qualified Command.Find
@@ -120,7 +116,9 @@ import qualified Command.Forget
 import qualified Command.P2P
 import qualified Command.Proxy
 import qualified Command.DiffDriver
+-}
 import qualified Command.Smudge
+{-
 import qualified Command.Undo
 import qualified Command.Version
 import qualified Command.RemoteDaemon
@@ -146,11 +144,9 @@ cmds testoptparser testrunner mkbenchmarkgenerator =
        , Command.Move.cmd
        , Command.Copy.cmd
        , Command.Fsck.cmd
-{-
        , Command.Unlock.cmd
        , Command.Unlock.editcmd
        , Command.Lock.cmd
--}
        , Command.Sync.cmd
 {-
        , Command.Mirror.cmd
@@ -160,7 +156,6 @@ cmds testoptparser testrunner mkbenchmarkgenerator =
 -}
        , Command.Import.cmd
        , Command.Export.cmd
-{-     
        , Command.Init.cmd
        , Command.Describe.cmd
        , Command.InitRemote.cmd
@@ -168,13 +163,14 @@ cmds testoptparser testrunner mkbenchmarkgenerator =
        , Command.RenameRemote.cmd
        , Command.EnableTor.cmd
        , Command.Multicast.cmd
--}
        , Command.Reinject.cmd
-{-
        , Command.Unannex.cmd
+{-
        , Command.Uninit.cmd
        , Command.Reinit.cmd
+-}
        , Command.PreCommit.cmd
+{-
        , Command.PostReceive.cmd
        , Command.NumCopies.cmd
        , Command.Trust.cmd
@@ -189,6 +185,7 @@ cmds testoptparser testrunner mkbenchmarkgenerator =
        , Command.Ungroup.cmd
        , Command.Config.cmd
        , Command.Vicfg.cmd
+-}
        , Command.LookupKey.cmd
        , Command.CalcKey.cmd
        , Command.ContentLocation.cmd
@@ -217,7 +214,6 @@ cmds testoptparser testrunner mkbenchmarkgenerator =
        , Command.Unused.cmd
        , Command.DropUnused.cmd
        , Command.AddUnused.cmd
--}
        , Command.Find.cmd
 {-
        , Command.FindRef.cmd
@@ -240,7 +236,9 @@ cmds testoptparser testrunner mkbenchmarkgenerator =
        , Command.P2P.cmd
        , Command.Proxy.cmd
        , Command.DiffDriver.cmd
+-}
        , Command.Smudge.cmd
+{-
        , Command.Undo.cmd
        , Command.Version.cmd
        , Command.RemoteDaemon.cmd
index 8cf86ea5ed051e89c4d4eefc7f1bf0a9659beb5c..f43ab68f8b269ebd9c6eba5e8d184706e2bbf5e3 100644 (file)
@@ -5,6 +5,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Command.EnableRemote where
 
 import Command
index 9cb8defb9ce08c372d1d070e72037313e2a1cd93..040fd15f321e9ee442323de7597abd82c36f9cb1 100644 (file)
@@ -22,5 +22,5 @@ cmd = noCommit $ noMessages $ dontCheck repoExists $
 run :: Maybe Utility.Format.Format -> String -> Annex Bool
 run format p = do
        let k = fromMaybe (giveup "bad key") $ deserializeKey p
-       showFormatted format (serializeKey k) (keyVars k)
+       showFormatted format (serializeKey' k) (keyVars k)
        return True
index 06dcd86fd734fc4c29d878ca8192ab154fe596c9..9ed9583c6bad7b6e9c178c6969c69662dede2549 100644 (file)
@@ -9,6 +9,7 @@ module Command.Find where
 
 import Data.Default
 import qualified Data.Map as M
+import qualified Data.ByteString as S
 import qualified Data.ByteString.Char8 as S8
 
 import Command
@@ -76,7 +77,7 @@ startKeys o (key, ActionItemBranchFilePath (BranchFilePath _ topf) _) =
        start o (toRawFilePath (getTopFilePath topf)) key
 startKeys _ _ = stop
 
-showFormatted :: Maybe Utility.Format.Format -> RawFilePath -> [(String, String)] -> Annex ()
+showFormatted :: Maybe Utility.Format.Format -> S.ByteString -> [(String, String)] -> Annex ()
 showFormatted format unformatted vars =
        unlessM (showFullJSON $ JSONChunk vars) $
                case format of
index c3f818b01b7a87d7535c9e99f8741effe7d7794c..537a66f6d374c550cd6afcaabd53110995147064 100644 (file)
@@ -37,13 +37,14 @@ seek ps = unlessM crippledFileSystem $ do
 
 data FixWhat = FixSymlinks | FixAll
 
-start :: FixWhat -> FilePath -> Key -> CommandStart
+start :: FixWhat -> RawFilePath -> Key -> CommandStart
 start fixwhat file key = do
-       currlink <- liftIO $ catchMaybeIO $ readSymbolicLink file
-       wantlink <- calcRepo $ gitAnnexLink file key
+       currlink <- liftIO $ catchMaybeIO $ readSymbolicLink $ fromRawFilePath file
+       wantlink <- calcRepo $ gitAnnexLink (fromRawFilePath file) key
        case currlink of
                Just l
-                       | l /= wantlink -> fixby $ fixSymlink file wantlink
+                       | l /= wantlink -> fixby $
+                               fixSymlink (fromRawFilePath file) wantlink
                        | otherwise -> stop
                Nothing -> case fixwhat of
                        FixAll -> fixthin
@@ -52,15 +53,15 @@ start fixwhat file key = do
        fixby = starting "fix" (mkActionItem (key, file))
        fixthin = do
                obj <- calcRepo $ gitAnnexLocation key
-               stopUnless (isUnmodified key file <&&> isUnmodified key obj) $ do
+               stopUnless (isUnmodified key (fromRawFilePath file) <&&> isUnmodified key obj) $ do
                        thin <- annexThin <$> Annex.getGitConfig
-                       fs <- liftIO $ catchMaybeIO $ getFileStatus file
+                       fs <- liftIO $ catchMaybeIO $ getFileStatus (fromRawFilePath file)
                        os <- liftIO $ catchMaybeIO $ getFileStatus obj
                        case (linkCount <$> fs, linkCount <$> os, thin) of
                                (Just 1, Just 1, True) ->
-                                       fixby $ makeHardLink file key
+                                       fixby $ makeHardLink (fromRawFilePath file) key
                                (Just n, Just n', False) | n > 1 && n == n' ->
-                                       fixby $ breakHardLink file key obj
+                                       fixby $ breakHardLink (fromRawFilePath file) key obj
                                _ -> stop
 
 breakHardLink :: FilePath -> Key -> FilePath -> CommandPerform
index 45b37f94d993e9c1a154b194500e80186959a023..f3e7487272c1d81354a5c64bd25de9c645adbc6b 100644 (file)
@@ -51,7 +51,7 @@ seekBatch fmt = batchInput fmt parse commandAction
                in if not (null keyname) && not (null file)
                        then Right $ go file (keyOpt keyname)
                        else Left "Expected pairs of key and filename"
-       go file key = starting "fromkey" (mkActionItem (key, file)) $
+       go file key = starting "fromkey" (mkActionItem (key, toRawFilePath file)) $
                perform key file
 
 start :: Bool -> (String, FilePath) -> CommandStart
@@ -61,7 +61,7 @@ start force (keyname, file) = do
                inbackend <- inAnnex key
                unless inbackend $ giveup $
                        "key ("++ keyname ++") is not present in backend (use --force to override this sanity check)"
-       starting "fromkey" (mkActionItem (key, file)) $
+       starting "fromkey" (mkActionItem (key, toRawFilePath file)) $
                perform key file
 
 -- From user input to a Key.
@@ -80,7 +80,7 @@ keyOpt s = case parseURI s of
                Nothing -> giveup $ "bad key/url " ++ s
 
 perform :: Key -> FilePath -> CommandPerform
-perform key file = lookupFileNotHidden file >>= \case
+perform key file = lookupFileNotHidden (toRawFilePath file) >>= \case
        Nothing -> ifM (liftIO $ doesFileExist file)
                ( hasothercontent
                , do
index 00ba46dc90827d6041823ce1d64770f49f979205..09aee869dcae061c7ba943c5ab71ded210485bef 100644 (file)
@@ -5,6 +5,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Command.InitRemote where
 
 import qualified Data.Map as M
index 2f2eab21b4a7150bfb6560c91c9ddac811251fc5..cb104225f6fad9def4d8e991c80c9dd22b4f0637 100644 (file)
@@ -32,7 +32,7 @@ seek ps = do
        l <- workTreeItems ps
        withFilesInGit (commandAction . (whenAnnexed startNew)) l
 
-startNew :: FilePath -> Key -> CommandStart
+startNew :: RawFilePath -> Key -> CommandStart
 startNew file key = ifM (isJust <$> isAnnexLink file)
        ( stop
        , starting "lock" (mkActionItem (key, file)) $
@@ -43,7 +43,7 @@ startNew file key = ifM (isJust <$> isAnnexLink file)
                | key' == key = cont
                | otherwise = errorModified
        go Nothing = 
-               ifM (isUnmodified key file) 
+               ifM (isUnmodified key (fromRawFilePath file))
                        ( cont
                        , ifM (Annex.getState Annex.force)
                                ( cont
@@ -52,11 +52,11 @@ startNew file key = ifM (isJust <$> isAnnexLink file)
                        )
        cont = performNew file key
 
-performNew :: FilePath -> Key -> CommandPerform
+performNew :: RawFilePath -> Key -> CommandPerform
 performNew file key = do
        lockdown =<< calcRepo (gitAnnexLocation key)
-       addLink file key
-               =<< withTSDelta (liftIO . genInodeCache file)
+       addLink (fromRawFilePath file) key
+               =<< withTSDelta (liftIO . genInodeCache (fromRawFilePath file))
        next $ cleanupNew file key
   where
        lockdown obj = do
@@ -70,7 +70,7 @@ performNew file key = do
        -- It's ok if the file is hard linked to obj, but if some other
        -- associated file is, we need to break that link to lock down obj.
        breakhardlink obj = whenM (catchBoolIO $ (> 1) . linkCount <$> liftIO (getFileStatus obj)) $ do
-               mfc <- withTSDelta (liftIO . genInodeCache file)
+               mfc <- withTSDelta (liftIO . genInodeCache (fromRawFilePath file))
                unlessM (sameInodeCache obj (maybeToList mfc)) $ do
                        modifyContent obj $ replaceFile obj $ \tmp -> do
                                unlessM (checkedCopyFile key obj tmp Nothing) $
@@ -92,21 +92,21 @@ performNew file key = do
 
        lostcontent = logStatus key InfoMissing
 
-cleanupNew :: FilePath -> Key -> CommandCleanup
+cleanupNew :: RawFilePath -> Key -> CommandCleanup
 cleanupNew file key = do
-       Database.Keys.removeAssociatedFile key =<< inRepo (toTopFilePath file)
+       Database.Keys.removeAssociatedFile key =<< inRepo (toTopFilePath (fromRawFilePath file))
        return True
 
-startOld :: FilePath -> CommandStart
+startOld :: RawFilePath -> CommandStart
 startOld file = do
        unlessM (Annex.getState Annex.force)
                errorModified
        starting "lock" (ActionItemWorkTreeFile file) $
                performOld file
 
-performOld :: FilePath -> CommandPerform
+performOld :: RawFilePath -> CommandPerform
 performOld file = do
-       Annex.Queue.addCommand "checkout" [Param "--"] [file]
+       Annex.Queue.addCommand "checkout" [Param "--"] [fromRawFilePath file]
        next $ return True
 
 errorModified :: a
index 11fa0c9461aa44556d6e5762ff039a6596d35f3a..1525046f2d1e13cebed19f6a6618d50d60970b53 100644 (file)
@@ -29,11 +29,12 @@ run _ file = seekSingleGitFile file >>= \case
 
 -- To support absolute filenames, pass through git ls-files.
 -- But, this plumbing command does not recurse through directories.
-seekSingleGitFile :: FilePath -> Annex (Maybe FilePath)
+seekSingleGitFile :: FilePath -> Annex (Maybe RawFilePath)
 seekSingleGitFile file = do
-       (l, cleanup) <- inRepo (Git.LsFiles.inRepo [file])
+       (l, cleanup) <- inRepo (Git.LsFiles.inRepo [toRawFilePath file])
        r <- case l of
-               (f:[]) | takeFileName f == takeFileName file -> return (Just f)
+               (f:[]) | takeFileName (fromRawFilePath f) == takeFileName file ->
+                       return (Just f)
                _ -> return Nothing
        void $ liftIO cleanup
        return r
index d1c7e50607a87cd2adfd3aaad8ab851b57553e73..e0b86e53023211c64b0e0e2ff2730421d3323942 100644 (file)
@@ -92,7 +92,7 @@ seek o = case batchOption o of
                        )
                _ -> giveup "--batch is currently only supported in --json mode"
 
-start :: VectorClock -> MetaDataOptions -> FilePath -> Key -> CommandStart
+start :: VectorClock -> MetaDataOptions -> RawFilePath -> Key -> CommandStart
 start c o file k = startKeys c o (k, mkActionItem (k, afile))
   where
        afile = AssociatedFile (Just file)
@@ -147,7 +147,7 @@ instance FromJSON MetaDataFields where
 fieldsField :: T.Text
 fieldsField = T.pack "fields"
 
-parseJSONInput :: String -> Either String (Either FilePath Key, MetaData)
+parseJSONInput :: String -> Either String (Either RawFilePath Key, MetaData)
 parseJSONInput i = do
        v <- eitherDecode (BU.fromString i)
        let m = case itemAdded v of
@@ -155,16 +155,16 @@ parseJSONInput i = do
                Just (MetaDataFields m') -> m'
        case (itemKey v, itemFile v) of
                (Just k, _) -> Right (Right k, m)
-               (Nothing, Just f) -> Right (Left f, m)
+               (Nothing, Just f) -> Right (Left (toRawFilePath f), m)
                (Nothing, Nothing) -> Left "JSON input is missing either file or key"
 
-startBatch :: (Either FilePath Key, MetaData) -> CommandStart
+startBatch :: (Either RawFilePath Key, MetaData) -> CommandStart
 startBatch (i, (MetaData m)) = case i of
        Left f -> do
                mk <- lookupFile f
                case mk of
                        Just k -> go k (mkActionItem (k, AssociatedFile (Just f)))
-                       Nothing -> giveup $ "not an annexed file: " ++ f
+                       Nothing -> giveup $ "not an annexed file: " ++ fromRawFilePath f
        Right k -> go k (mkActionItem k)
   where
        go k ai = starting "metadata" ai $ do
index 6c6d2c418b50c64e881b20a510fcc92c4d8c8068..97966984a19eb61844151671fe18c477fe66b583 100644 (file)
@@ -137,7 +137,7 @@ send ups fs = do
                                mk <- lookupFile f
                                case mk of
                                        Nothing -> noop
-                                       Just k -> withObjectLoc k (addlist f)
+                                       Just k -> withObjectLoc k (addlist (fromRawFilePath f))
                        liftIO $ hClose h
                        
                        serverkey <- uftpKey
index 8c366ec14bbd965334be28cecc03a56112063f01..ad39953e3c2607291b25edbad3b43b9b4c018aca 100644 (file)
@@ -53,11 +53,11 @@ seek ps = lockPreCommitHook $ do
                        (removeViewMetaData v)
 
 addViewMetaData :: View -> ViewedFile -> Key -> CommandStart
-addViewMetaData v f k = starting "metadata" (mkActionItem (k, f)) $
+addViewMetaData v f k = starting "metadata" (mkActionItem (k, toRawFilePath f)) $
        next $ changeMetaData k $ fromView v f
 
 removeViewMetaData :: View -> ViewedFile -> Key -> CommandStart
-removeViewMetaData v f k = starting "metadata" (mkActionItem (k, f)) $
+removeViewMetaData v f k = starting "metadata" (mkActionItem (k, toRawFilePath f)) $
        next $ changeMetaData k $ unsetMetaData $ fromView v f
 
 changeMetaData :: Key -> MetaData -> CommandCleanup
index 6670298ae546be7c7d6e5b1d96ffa7311549a73a..b9eac592322568ea7606853c0b5145b8717269b1 100644 (file)
@@ -38,13 +38,13 @@ optParser desc = ReKeyOptions
 
 -- Split on the last space, since a FilePath can contain whitespace,
 -- but a Key very rarely does.
-batchParser :: String -> Either String (FilePath, Key)
+batchParser :: String -> Either String (RawFilePath, Key)
 batchParser s = case separate (== ' ') (reverse s) of
        (rk, rf)
                | null rk || null rf -> Left "Expected: \"file key\""
                | otherwise -> case deserializeKey (reverse rk) of
                        Nothing -> Left "bad key"
-                       Just k -> Right (reverse rf, k)
+                       Just k -> Right (toRawFilePath (reverse rf), k)
 
 seek :: ReKeyOptions -> CommandSeek
 seek o = case batchOption o of
@@ -52,9 +52,9 @@ seek o = case batchOption o of
        NoBatch -> withPairs (commandAction . start . parsekey) (reKeyThese o)
   where
        parsekey (file, skey) =
-               (file, fromMaybe (giveup "bad key") (deserializeKey skey))
+               (toRawFilePath file, fromMaybe (giveup "bad key") (deserializeKey skey))
 
-start :: (FilePath, Key) -> CommandStart
+start :: (RawFilePath, Key) -> CommandStart
 start (file, newkey) = ifAnnexed file go stop
   where
        go oldkey
@@ -62,19 +62,19 @@ start (file, newkey) = ifAnnexed file go stop
                | otherwise = starting "rekey" (ActionItemWorkTreeFile file) $
                        perform file oldkey newkey
 
-perform :: FilePath -> Key -> Key -> CommandPerform
+perform :: RawFilePath -> Key -> Key -> CommandPerform
 perform file oldkey newkey = do
        ifM (inAnnex oldkey) 
                ( unlessM (linkKey file oldkey newkey) $
                        giveup "failed creating link from old to new key"
                , unlessM (Annex.getState Annex.force) $
-                       giveup $ file ++ " is not available (use --force to override)"
+                       giveup $ fromRawFilePath file ++ " is not available (use --force to override)"
                )
        next $ cleanup file oldkey newkey
 
 {- Make a hard link to the old key content (when supported),
  - to avoid wasting disk space. -}
-linkKey :: FilePath -> Key -> Key -> Annex Bool
+linkKey :: RawFilePath -> Key -> Key -> Annex Bool
 linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file)
        {- If the object file is already hardlinked to elsewhere, a hard
         - link won't be made by getViaTmpFromDisk, but a copy instead.
@@ -89,40 +89,40 @@ linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file)
                 - it's hard linked to the old key, that link must be broken. -}
                oldobj <- calcRepo (gitAnnexLocation oldkey)
                v <- tryNonAsync $ do
-                       st <- liftIO $ getFileStatus file
+                       st <- liftIO $ getFileStatus (fromRawFilePath file)
                        when (linkCount st > 1) $ do
                                freezeContent oldobj
-                               replaceFile file $ \tmp -> do
+                               replaceFile (fromRawFilePath file) $ \tmp -> do
                                        unlessM (checkedCopyFile oldkey oldobj tmp Nothing) $
                                                error "can't lock old key"
                                        thawContent tmp
-               ic <- withTSDelta (liftIO . genInodeCache file)
+               ic <- withTSDelta (liftIO . genInodeCache (fromRawFilePath file))
                case v of
                        Left e -> do
                                warning (show e)
                                return False
                        Right () -> do
-                               r <- linkToAnnex newkey file ic
+                               r <- linkToAnnex newkey (fromRawFilePath file) ic
                                return $ case r of
                                        LinkAnnexFailed -> False
                                        LinkAnnexOk -> True
                                        LinkAnnexNoop -> True
        )
 
-cleanup :: FilePath -> Key -> Key -> CommandCleanup
+cleanup :: RawFilePath -> Key -> Key -> CommandCleanup
 cleanup file oldkey newkey = do
        ifM (isJust <$> isAnnexLink file)
                ( do
                        -- Update symlink to use the new key.
-                       liftIO $ removeFile file
-                       addLink file newkey Nothing
+                       liftIO $ removeFile (fromRawFilePath file)
+                       addLink (fromRawFilePath file) newkey Nothing
                , do
-                       mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file
+                       mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus (fromRawFilePath file)
                        liftIO $ whenM (isJust <$> isPointerFile file) $
                                writePointerFile file newkey mode
                        stagePointerFile file mode =<< hashPointerFile newkey
                        Database.Keys.removeAssociatedFile oldkey 
-                               =<< inRepo (toTopFilePath file)
+                               =<< inRepo (toTopFilePath (fromRawFilePath file))
                )
        whenM (inAnnex newkey) $
                logStatus newkey InfoPresent
index 7191461bd23aae4a8affc0e9538c91cc47bd4163..30e2f2d1682460cd12c135f25359b7f266bd1877 100644 (file)
@@ -86,9 +86,9 @@ clean file = do
                ( liftIO $ L.hPut stdout b
                , case parseLinkTargetOrPointerLazy b of
                        Just k -> do
-                               getMoveRaceRecovery k file
+                               getMoveRaceRecovery k (toRawFilePath file)
                                liftIO $ L.hPut stdout b
-                       Nothing -> go b =<< catKeyFile file
+                       Nothing -> go b =<< catKeyFile (toRawFilePath file)
                )
        stop
   where
@@ -187,10 +187,10 @@ emitPointer = S.putStr . formatPointer
 -- This also handles the case where a copy of a pointer file is made,
 -- then git-annex gets the content, and later git add is run on
 -- the pointer copy. It will then be populated with the content.
-getMoveRaceRecovery :: Key -> FilePath -> Annex ()
+getMoveRaceRecovery :: Key -> RawFilePath -> Annex ()
 getMoveRaceRecovery k file = void $ tryNonAsync $
        whenM (inAnnex k) $ do
-               obj <- calcRepo (gitAnnexLocation k)
+               obj <- toRawFilePath <$> calcRepo (gitAnnexLocation k)
                -- Cannot restage because git add is running and has
                -- the index locked.
                populatePointerFile (Restage False) k obj file >>= \case
@@ -204,11 +204,11 @@ update = do
 
 updateSmudged :: Restage -> Annex ()
 updateSmudged restage = streamSmudged $ \k topf -> do
-       f <- fromRepo $ fromTopFilePath topf
+       f <- toRawFilePath <$> fromRepo (fromTopFilePath topf)
        whenM (inAnnex k) $ do
-               obj <- calcRepo (gitAnnexLocation k)
+               obj <- toRawFilePath <$> calcRepo (gitAnnexLocation k)
                unlessM (isJust <$> populatePointerFile restage k obj f) $
                        liftIO (isPointerFile f) >>= \case
                                Just k' | k' == k -> toplevelWarning False $
-                                       "unable to populate worktree file " ++ f
+                                       "unable to populate worktree file " ++ fromRawFilePath f
                                _ -> noop
index 2d3cbaef492c29f9ade1ac1b3fa47b294bef51a1..9fa233fb90cf1a56d203a7586be1bfb1993aa04d 100644 (file)
@@ -116,10 +116,10 @@ instance TCSerialized Direction where
        deserialize _ = Nothing
 
 instance TCSerialized AssociatedFile where
-       serialize (AssociatedFile (Just f)) = f
+       serialize (AssociatedFile (Just f)) = fromRawFilePath f
        serialize (AssociatedFile Nothing) = ""
        deserialize "" = Just (AssociatedFile Nothing)
-       deserialize f = Just (AssociatedFile (Just f))
+       deserialize f = Just (AssociatedFile (Just (toRawFilePath f)))
 
 instance TCSerialized RemoteName where
        serialize n = n
index 2fc605c6de11e6deb73f2f949f704d8e41cc05be..31f8a26cf51dff26cd86519119f56663409d4afb 100644 (file)
@@ -31,17 +31,18 @@ seek ps = withFilesInGit (commandAction . whenAnnexed start) =<< workTreeItems p
 {- Before v6, the unlock subcommand replaces the symlink with a copy of
  - the file's content. In v6 and above, it converts the file from a symlink
  - to a pointer. -}
-start :: FilePath -> Key -> CommandStart
+start :: RawFilePath -> Key -> CommandStart
 start file key = ifM (isJust <$> isAnnexLink file)
        ( starting "unlock" (mkActionItem (key, AssociatedFile (Just file))) $
                perform file key
        , stop
        )
 
-perform :: FilePath -> Key -> CommandPerform
+perform :: RawFilePath -> Key -> CommandPerform
 perform dest key = do
-       destmode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus dest
-       replaceFile dest $ \tmp ->
+       destmode <- liftIO $ catchMaybeIO $ fileMode
+               <$> getFileStatus (fromRawFilePath dest)
+       replaceFile (fromRawFilePath dest) $ \tmp ->
                ifM (inAnnex key)
                        ( do
                                r <- linkFromAnnex key tmp destmode
@@ -49,12 +50,12 @@ perform dest key = do
                                        LinkAnnexOk -> return ()
                                        LinkAnnexNoop -> return ()
                                        LinkAnnexFailed -> error "unlock failed"
-                       , liftIO $ writePointerFile tmp key destmode
+                       , liftIO $ writePointerFile (toRawFilePath tmp) key destmode
                        )
        next $ cleanup dest key destmode
 
-cleanup ::  FilePath -> Key -> Maybe FileMode -> CommandCleanup
+cleanup ::  RawFilePath -> Key -> Maybe FileMode -> CommandCleanup
 cleanup dest key destmode = do
        stagePointerFile dest destmode =<< hashPointerFile key
-       Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath dest)
+       Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath (fromRawFilePath dest))
        return True
index 95f953395dcfb31b61588634036d96a14e4e9603..345111ec819c5a143ca2b9ab9344784fa16e807a 100644 (file)
@@ -192,10 +192,10 @@ withKeysReferencedM a = withKeysReferenced' Nothing () calla
        calla k _ _ = a k
 
 {- Folds an action over keys and files referenced in a particular directory. -}
-withKeysFilesReferencedIn :: FilePath -> v -> (Key -> FilePath -> v -> Annex v) -> Annex v
+withKeysFilesReferencedIn :: FilePath -> v -> (Key -> RawFilePath -> v -> Annex v) -> Annex v
 withKeysFilesReferencedIn = withKeysReferenced' . Just
 
-withKeysReferenced' :: Maybe FilePath -> v -> (Key -> FilePath -> v -> Annex v) -> Annex v
+withKeysReferenced' :: Maybe FilePath -> v -> (Key -> RawFilePath -> v -> Annex v) -> Annex v
 withKeysReferenced' mdir initial a = do
        (files, clean) <- getfiles
        r <- go initial files
@@ -207,9 +207,9 @@ withKeysReferenced' mdir initial a = do
                        ( return ([], return True)
                        , do
                                top <- fromRepo Git.repoPath
-                               inRepo $ LsFiles.allFiles [top]
+                               inRepo $ LsFiles.allFiles [toRawFilePath top]
                        )
-               Just dir -> inRepo $ LsFiles.inRepo [dir]
+               Just dir -> inRepo $ LsFiles.inRepo [toRawFilePath dir]
        go v [] = return v
        go v (f:fs) = do
                mk <- lookupFile f
@@ -221,7 +221,8 @@ withKeysReferenced' mdir initial a = do
 
 withKeysReferencedDiffGitRefs :: RefSpec -> (Key -> Annex ()) -> Annex ()
 withKeysReferencedDiffGitRefs refspec a = do
-       rs <- relevantrefs <$> inRepo (Git.Command.pipeReadStrict [Param "show-ref"])
+       rs <- relevantrefs . decodeBS'
+               <$> inRepo (Git.Command.pipeReadStrict [Param "show-ref"])
        shaHead <- maybe (return Nothing) (inRepo . Git.Ref.sha)
                =<< inRepo Git.Branch.currentUnsafe
        let haveHead = any (\(shaRef, _) -> Just shaRef == shaHead) rs
index 88b9a4866d3c4325ce73f6ffce9d0607f1855402..58e7a8c8b0dd0f1c9f2964f6b9488d38bc77c325 100644 (file)
@@ -101,7 +101,8 @@ checkoutViewBranch view mkbranch = do
                 - removed.) -}
                top <- liftIO . absPath =<< fromRepo Git.repoPath
                (l, cleanup) <- inRepo $
-                       LsFiles.notInRepoIncludingEmptyDirectories False [top]
+                       LsFiles.notInRepoIncludingEmptyDirectories False
+                               [toRawFilePath top]
                forM_ l (removeemptydir top)
                liftIO $ void cleanup
                unlessM (liftIO $ doesDirectoryExist here) $ do
@@ -109,7 +110,7 @@ checkoutViewBranch view mkbranch = do
        return ok
   where
        removeemptydir top d = do
-               p <- inRepo $ toTopFilePath d
+               p <- inRepo $ toTopFilePath $ fromRawFilePath d
                liftIO $ tryIO $ removeDirectory (top </> getTopFilePath p)
        cwdmissing top = unlines
                [ "This view does not include the subdirectory you are currently in."
index 734c884f60bb32431f5803e6f10db78cae3a1b80..6031f4dd73c8ba55c4f2d7c0f1e48e6558a4b354 100644 (file)
@@ -284,7 +284,7 @@ findUncorruptedCommit missing goodcommits branch r = do
                                , Param "--format=%H"
                                , Param (fromRef branch)
                                ] r
-                       let branchshas = catMaybes $ map (extractSha . decodeBS) ls
+                       let branchshas = catMaybes $ map (extractSha . decodeBL) ls
                        reflogshas <- RefLog.get branch r
                        -- XXX Could try a bit harder here, and look
                        -- for uncorrupted old commits in branches in the
@@ -313,7 +313,7 @@ verifyCommit missing goodcommits commit r
                        , Param "--format=%H %T"
                        , Param (fromRef commit)
                        ] r
-               let committrees = map (parse . decodeBS) ls
+               let committrees = map (parse . decodeBL) ls
                if any isNothing committrees || null committrees
                        then do
                                void cleanup
@@ -342,7 +342,7 @@ verifyTree missing treesha r
        | S.member treesha missing = return False
        | otherwise = do
                (ls, cleanup) <- pipeNullSplit (LsTree.lsTreeParams LsTree.LsTreeRecursive treesha []) r
-               let objshas = map (LsTree.sha . LsTree.parseLsTree) ls
+               let objshas = mapMaybe (LsTree.sha <$$> eitherToMaybe . LsTree.parseLsTree) ls
                if any (`S.member` missing) objshas
                        then do
                                void cleanup
@@ -366,7 +366,7 @@ checkIndex r = do
  - itself is not corrupt. -}
 checkIndexFast :: Repo -> IO Bool
 checkIndexFast r = do
-       (indexcontents, cleanup) <- LsFiles.stagedDetails [repoPath r] r
+       (indexcontents, cleanup) <- LsFiles.stagedDetails [toRawFilePath (repoPath r)] r
        length indexcontents `seq` cleanup
 
 missingIndex :: Repo -> IO Bool
@@ -375,7 +375,7 @@ missingIndex r = not <$> doesFileExist (localGitDir r </> "index")
 {- Finds missing and ok files staged in the index. -}
 partitionIndex :: Repo -> IO ([LsFiles.StagedDetails], [LsFiles.StagedDetails], IO Bool)
 partitionIndex r = do
-       (indexcontents, cleanup) <- LsFiles.stagedDetails [repoPath r] r
+       (indexcontents, cleanup) <- LsFiles.stagedDetails [toRawFilePath (repoPath r)] r
        l <- forM indexcontents $ \i -> case i of
                (_file, Just sha, Just _mode) -> (,) <$> isMissing sha r <*> pure i
                _ -> pure (False, i)
@@ -394,12 +394,12 @@ rewriteIndex r
                        UpdateIndex.streamUpdateIndex r
                                =<< (catMaybes <$> mapM reinject good)
                void cleanup
-               return $ map fst3 bad
+               return $ map (fromRawFilePath . fst3) bad
   where
        reinject (file, Just sha, Just mode) = case toTreeItemType mode of
                Nothing -> return Nothing
                Just treeitemtype -> Just <$>
-                       UpdateIndex.stageFile sha treeitemtype file r
+                       UpdateIndex.stageFile sha treeitemtype (fromRawFilePath file) r
        reinject _ = return Nothing
 
 newtype GoodCommits = GoodCommits (S.Set Sha)