more OsPath conversion
Sponsored-by: mycroft
This commit is contained in:
parent
917c43f31f
commit
22c2451e26
11 changed files with 46 additions and 44 deletions
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
2
Key.hs
2
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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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. -}
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue