diff --git a/Annex/ChangedRefs.hs b/Annex/ChangedRefs.hs index 073686fb01..377be3bf73 100644 --- a/Annex/ChangedRefs.hs +++ b/Annex/ChangedRefs.hs @@ -24,11 +24,11 @@ import qualified Git import Git.Sha import qualified Utility.SimpleProtocol as Proto import qualified Utility.FileIO as F +import qualified Utility.OsString as OS import Control.Concurrent import Control.Concurrent.STM import Control.Concurrent.STM.TBMChan -import qualified System.FilePath.ByteString as P newtype ChangedRefs = ChangedRefs [Git.Ref] deriving (Show) @@ -82,7 +82,7 @@ watchChangedRefs = do g <- gitRepo let gittop = Git.localGitDir g - let refdir = gittop P. "refs" + let refdir = gittop literalOsPath "refs" liftIO $ createDirectoryUnder [gittop] refdir let notifyhook = Just $ notifyHook chan @@ -93,18 +93,17 @@ watchChangedRefs = do if canWatch then do - h <- liftIO $ watchDir - (fromRawFilePath refdir) + h <- liftIO $ watchDir refdir (const False) True hooks id return $ Just $ ChangedRefsHandle h chan else return Nothing -notifyHook :: TBMChan Git.Sha -> FilePath -> Maybe FileStatus -> IO () +notifyHook :: TBMChan Git.Sha -> OsPath -> Maybe FileStatus -> IO () notifyHook chan reffile _ - | ".lock" `isSuffixOf` reffile = noop + | literalOsPath ".lock" `OS.isSuffixOf` reffile = noop | otherwise = void $ do sha <- catchDefaultIO Nothing $ - extractSha <$> F.readFile' (toOsPath (toRawFilePath reffile)) + extractSha <$> F.readFile' reffile -- When the channel is full, there is probably no reader -- running, or ref changes have been occurring very fast, -- so it's ok to not write the change to it. diff --git a/Annex/CheckAttr.hs b/Annex/CheckAttr.hs index 6ad8fafce6..8561493cdd 100644 --- a/Annex/CheckAttr.hs +++ b/Annex/CheckAttr.hs @@ -29,14 +29,14 @@ annexAttrs = , "annex.mincopies" ] -checkAttr :: Git.Attr -> RawFilePath -> Annex String +checkAttr :: Git.Attr -> OsPath -> Annex String checkAttr attr file = withCheckAttrHandle $ \h -> do r <- liftIO $ Git.checkAttr h attr file if r == Git.unspecifiedAttr then return "" else return r -checkAttrs :: [Git.Attr] -> RawFilePath -> Annex [String] +checkAttrs :: [Git.Attr] -> OsPath -> Annex [String] checkAttrs attrs file = withCheckAttrHandle $ \h -> liftIO $ Git.checkAttrs h attrs file diff --git a/Key.hs b/Key.hs index c4f7d062e3..611bffcd72 100644 --- a/Key.hs +++ b/Key.hs @@ -86,7 +86,7 @@ instance Arbitrary KeyData where instance Arbitrary AssociatedFile where arbitrary = AssociatedFile - . fmap (toRawFilePath . fromTestableFilePath) + . fmap (toOsPath . fromTestableFilePath) <$> arbitrary instance Arbitrary Key where diff --git a/Messages.hs b/Messages.hs index b989d1dd8b..704d5cfeac 100644 --- a/Messages.hs +++ b/Messages.hs @@ -190,7 +190,7 @@ endResult False = "failed" toplevelMsg :: (Semigroup t, IsString t) => t -> t toplevelMsg s = fromString "git-annex: " <> s -toplevelFileProblem :: Bool -> MessageId -> StringContainingQuotedPath -> String -> RawFilePath -> Maybe Key -> SeekInput -> Annex () +toplevelFileProblem :: Bool -> MessageId -> StringContainingQuotedPath -> String -> OsPath -> Maybe Key -> SeekInput -> Annex () toplevelFileProblem makeway messageid msg action file mkey si = do maybeShowJSON' $ JSON.start action (Just file) mkey si maybeShowJSON' $ JSON.messageid messageid diff --git a/Messages/JSON.hs b/Messages/JSON.hs index 70032d9b9c..81dcc1f2af 100644 --- a/Messages/JSON.hs +++ b/Messages/JSON.hs @@ -50,7 +50,7 @@ import Key import Utility.Metered import Utility.Percentage import Utility.Aeson -import Utility.FileSystemEncoding +import Utility.OsPath import Types.Messages -- A global lock to avoid concurrent threads emitting json at the same time. @@ -76,7 +76,7 @@ type JSONBuilder = Maybe (Object, Bool) -> Maybe (Object, Bool) none :: JSONBuilder none = id -start :: String -> Maybe RawFilePath -> Maybe Key -> SeekInput -> JSONBuilder +start :: String -> Maybe OsPath -> Maybe Key -> SeekInput -> JSONBuilder start command file key si _ = case j of Object o -> Just (o, False) _ -> Nothing @@ -84,7 +84,7 @@ start command file key si _ = case j of j = toJSON' $ JSONActionItem { itemCommand = Just command , itemKey = key - , itemFile = fromRawFilePath <$> file + , itemFile = fromOsPath <$> file , itemUUID = Nothing , itemFields = Nothing :: Maybe Bool , itemSeekInput = si @@ -98,7 +98,7 @@ startActionItem command ai si _ = case j of j = toJSON' $ JSONActionItem { itemCommand = Just command , itemKey = actionItemKey ai - , itemFile = fromRawFilePath <$> actionItemFile ai + , itemFile = fromOsPath <$> actionItemFile ai , itemUUID = actionItemUUID ai , itemFields = Nothing :: Maybe Bool , itemSeekInput = si diff --git a/Messages/Progress.hs b/Messages/Progress.hs index c726149d18..5d5e818d3b 100644 --- a/Messages/Progress.hs +++ b/Messages/Progress.hs @@ -55,7 +55,7 @@ instance MeterSize KeySource where - This allows uploads of keys without size to still have progress - displayed. -} -data KeySizer = KeySizer Key (Annex (Maybe RawFilePath)) +data KeySizer = KeySizer Key (Annex (Maybe OsPath)) instance MeterSize KeySizer where getMeterSize (KeySizer k getsrcfile) = case fromKey keySize k of @@ -171,7 +171,7 @@ metered' st setclear othermeterupdate msize bwlimit showoutput a = go st minratelimit = min consoleratelimit jsonratelimit {- Poll file size to display meter. -} -meteredFile :: RawFilePath -> Maybe MeterUpdate -> Key -> (MeterUpdate -> Annex a) -> Annex a +meteredFile :: OsPath -> Maybe MeterUpdate -> Key -> (MeterUpdate -> Annex a) -> Annex a meteredFile file combinemeterupdate key a = metered combinemeterupdate key Nothing $ \_ p -> watchFileSize file p a diff --git a/Remote/WebDAV/DavLocation.hs b/Remote/WebDAV/DavLocation.hs index e836acd8a9..2dedc894db 100644 --- a/Remote/WebDAV/DavLocation.hs +++ b/Remote/WebDAV/DavLocation.hs @@ -17,9 +17,9 @@ import Utility.Url (URLString) #ifdef mingw32_HOST_OS import Utility.Split #endif -import Utility.FileSystemEncoding +import Utility.OsPath -import System.FilePath.Posix -- for manipulating url paths +import qualified System.FilePath.Posix as UrlPath import Network.Protocol.HTTP.DAV (inDAVLocation, DAVT) import Control.Monad.IO.Class (MonadIO) import Network.URI @@ -30,28 +30,29 @@ type DavLocation = String {- Runs action with a new location relative to the current location. -} inLocation :: (MonadIO m) => DavLocation -> DAVT m a -> DAVT m a -inLocation d = inDAVLocation ( d') +inLocation d = inDAVLocation (UrlPath. d') where d' = escapeURIString isUnescapedInURI d {- The directory where files(s) for a key are stored. -} keyDir :: Key -> DavLocation -keyDir k = addTrailingPathSeparator $ hashdir fromRawFilePath (keyFile k) +keyDir k = UrlPath.addTrailingPathSeparator $ + hashdir UrlPath. fromOsPath (keyFile k) where #ifndef mingw32_HOST_OS - hashdir = fromRawFilePath $ hashDirLower def k + hashdir = fromOsPath $ hashDirLower def k #else - hashdir = replace "\\" "/" (fromRawFilePath $ hashDirLower def k) + hashdir = replace "\\" "/" (fromOsPath $ hashDirLower def k) #endif keyLocation :: Key -> DavLocation -keyLocation k = keyDir k ++ fromRawFilePath (keyFile k) +keyLocation k = keyDir k ++ fromOsPath (keyFile k) {- Paths containing # or ? cannot be represented in an url, so fails on - those. -} exportLocation :: ExportLocation -> Either String DavLocation exportLocation l = - let p = fromRawFilePath $ fromExportLocation l + let p = fromOsPath $ fromExportLocation l in if any (`elem` p) illegalinurl then Left ("Cannot store file containing '#' or '?' on webdav: " ++ p) else Right p @@ -60,7 +61,7 @@ exportLocation l = {- Where we store temporary data for a key as it's being uploaded. -} keyTmpLocation :: Key -> DavLocation -keyTmpLocation = tmpLocation . fromRawFilePath . keyFile +keyTmpLocation = tmpLocation . fromOsPath . keyFile {- Where we store temporary data for a file as it's being exported. - @@ -72,10 +73,11 @@ keyTmpLocation = tmpLocation . fromRawFilePath . keyFile -} exportTmpLocation :: ExportLocation -> Key -> DavLocation exportTmpLocation l k - | length (splitDirectories p) > 1 = takeDirectory p keyTmpLocation k + | length (UrlPath.splitDirectories p) > 1 = + UrlPath.takeDirectory p UrlPath. keyTmpLocation k | otherwise = keyTmpLocation k where - p = fromRawFilePath (fromExportLocation l) + p = fromOsPath (fromExportLocation l) tmpLocation :: FilePath -> DavLocation tmpLocation f = "git-annex-webdav-tmp-" ++ f @@ -86,7 +88,7 @@ locationParent loc | otherwise = Just parent where tops = ["/", "", "."] - parent = takeDirectory loc + parent = UrlPath.takeDirectory loc locationUrl :: URLString -> DavLocation -> URLString -locationUrl baseurl loc = baseurl loc +locationUrl baseurl loc = baseurl UrlPath. loc diff --git a/Types/ActionItem.hs b/Types/ActionItem.hs index 8ba52b1107..53e7822a74 100644 --- a/Types/ActionItem.hs +++ b/Types/ActionItem.hs @@ -18,14 +18,14 @@ import Types.UUID import Types.FileMatcher import Git.FilePath import Git.Quote (StringContainingQuotedPath(..)) -import Utility.FileSystemEncoding +import Utility.OsPath data ActionItem = ActionItemAssociatedFile AssociatedFile Key | ActionItemKey Key | ActionItemBranchFilePath BranchFilePath Key | ActionItemFailedTransfer Transfer TransferInfo - | ActionItemTreeFile RawFilePath + | ActionItemTreeFile OsPath | ActionItemUUID UUID StringContainingQuotedPath -- ^ UUID with a description or name of the repository | ActionItemOther (Maybe StringContainingQuotedPath) @@ -46,10 +46,10 @@ instance MkActionItem (AssociatedFile, Key) where instance MkActionItem (Key, AssociatedFile) where mkActionItem = uncurry $ flip ActionItemAssociatedFile -instance MkActionItem (Key, RawFilePath) where +instance MkActionItem (Key, OsPath) where mkActionItem (key, file) = ActionItemAssociatedFile (AssociatedFile (Just file)) key -instance MkActionItem (RawFilePath, Key) where +instance MkActionItem (OsPath, Key) where mkActionItem (file, key) = mkActionItem (key, file) instance MkActionItem Key where @@ -97,7 +97,7 @@ actionItemKey (ActionItemUUID _ _) = Nothing actionItemKey (ActionItemOther _) = Nothing actionItemKey (OnlyActionOn _ ai) = actionItemKey ai -actionItemFile :: ActionItem -> Maybe RawFilePath +actionItemFile :: ActionItem -> Maybe OsPath actionItemFile (ActionItemAssociatedFile (AssociatedFile af) _) = af actionItemFile (ActionItemTreeFile f) = Just f actionItemFile (ActionItemUUID _ _) = Nothing diff --git a/Types/FileMatcher.hs b/Types/FileMatcher.hs index c52d28d5b2..18225a3981 100644 --- a/Types/FileMatcher.hs +++ b/Types/FileMatcher.hs @@ -14,7 +14,7 @@ import Types.Mime import Types.RepoSize (LiveUpdate) import Utility.Matcher (Matcher, Token, MatchDesc) import Utility.FileSize -import Utility.FileSystemEncoding +import Utility.OsPath import Control.Monad.IO.Class import qualified Data.Map as M @@ -27,10 +27,10 @@ data MatchInfo | MatchingUserInfo UserProvidedInfo data FileInfo = FileInfo - { contentFile :: RawFilePath + { contentFile :: OsPath -- ^ path to a file containing the content, for operations -- that examine it - , matchFile :: RawFilePath + , matchFile :: OsPath -- ^ filepath to match on; may be relative to top of repo or cwd, -- depending on how globs in preferred content expressions -- are intended to be matched @@ -39,7 +39,7 @@ data FileInfo = FileInfo } data ProvidedInfo = ProvidedInfo - { providedFilePath :: Maybe RawFilePath + { providedFilePath :: Maybe OsPath -- ^ filepath to match on, should not be accessed from disk. , providedKey :: Maybe Key , providedFileSize :: Maybe FileSize @@ -48,7 +48,7 @@ data ProvidedInfo = ProvidedInfo , providedLinkType :: Maybe LinkType } -keyMatchInfoWithoutContent :: Key -> RawFilePath -> MatchInfo +keyMatchInfoWithoutContent :: Key -> OsPath -> MatchInfo keyMatchInfoWithoutContent key file = MatchingInfo $ ProvidedInfo { providedFilePath = Just file , providedKey = Just key diff --git a/Types/Key.hs b/Types/Key.hs index 03d5aa4638..69f1c4fe1e 100644 --- a/Types/Key.hs +++ b/Types/Key.hs @@ -28,6 +28,8 @@ module Types.Key ( parseKeyVariety, ) where +import Utility.OsPath + import qualified Data.ByteString as S import qualified Data.ByteString.Short as S (ShortByteString, toShort, fromShort) import qualified Data.ByteString.Char8 as S8 @@ -36,7 +38,6 @@ import Data.ByteString.Builder import Data.ByteString.Builder.Extra import qualified Data.Attoparsec.ByteString as A import qualified Data.Attoparsec.ByteString.Char8 as A8 -import Utility.FileSystemEncoding import Data.List import Data.Char import System.Posix.Types @@ -202,7 +203,7 @@ splitKeyNameExtension' :: S.ByteString -> (S.ByteString, S.ByteString) splitKeyNameExtension' keyname = S8.span (/= '.') keyname {- A filename may be associated with a Key. -} -newtype AssociatedFile = AssociatedFile (Maybe RawFilePath) +newtype AssociatedFile = AssociatedFile (Maybe OsPath) deriving (Show, Eq, Ord) {- There are several different varieties of keys. -} diff --git a/Types/Transfer.hs b/Types/Transfer.hs index 73745436ca..853237e254 100644 --- a/Types/Transfer.hs +++ b/Types/Transfer.hs @@ -19,7 +19,7 @@ import Types.Direction import Utility.PID import Utility.QuickCheck import Utility.Url -import Utility.FileSystemEncoding +import Utility.OsPath import Data.Time.Clock.POSIX import Control.Concurrent @@ -99,7 +99,7 @@ class Transferrable t where descTransfrerrable :: t -> Maybe String instance Transferrable AssociatedFile where - descTransfrerrable (AssociatedFile af) = fromRawFilePath <$> af + descTransfrerrable (AssociatedFile af) = fromOsPath <$> af instance Transferrable URLString where descTransfrerrable = Just