module Darcs.Util.URL (
isValidLocalPath, isHttpUrl, isSshUrl, isRelative, isAbsolute,
isSshNopath, SshFilePath, sshRepo, sshUhost, sshFile, sshFilePathOf, splitSshUrl
) where
import Prelude ()
import Darcs.Prelude
import Darcs.Util.Global ( darcsdir )
import Data.List ( isPrefixOf, isInfixOf )
import Data.Char ( isSpace )
import qualified System.FilePath as FP ( isRelative, isAbsolute, isValid )
import System.FilePath ( (</>) )
isRelative :: String -> Bool
isRelative :: String -> Bool
isRelative "" = String -> Bool
forall a. String -> a
bug "Empty filename in isRelative"
isRelative f :: String
f = String -> Bool
FP.isRelative String
f
isAbsolute :: String -> Bool
isAbsolute :: String -> Bool
isAbsolute "" = String -> Bool
forall a. String -> a
bug "isAbsolute called with empty filename"
isAbsolute f :: String
f = String -> Bool
FP.isAbsolute String
f
isValidLocalPath :: String -> Bool
isValidLocalPath :: String -> Bool
isValidLocalPath f :: String
f@(_:_:fou :: String
fou) = ':' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
fou Bool -> Bool -> Bool
&& String -> Bool
FP.isValid String
f
isValidLocalPath f :: String
f = String -> Bool
FP.isValid String
f
isHttpUrl :: String -> Bool
isHttpUrl :: String -> Bool
isHttpUrl u :: String
u =
let u' :: String
u' = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
u in
("http://" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
u') Bool -> Bool -> Bool
|| ("https://" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
u')
isSshUrl :: String -> Bool
isSshUrl :: String -> Bool
isSshUrl s :: String
s = String -> Bool
isu' ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
s)
where
isu' :: String -> Bool
isu' s' :: String
s'
| "ssh://" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s' = Bool
True
| "://" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
s' = Bool
False
| String -> Bool
isValidLocalPath String
s' = Bool
False
| Bool
otherwise = ":" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
s'
isSshNopath :: String -> Bool
isSshNopath :: String -> Bool
isSshNopath s :: String
s = case String -> String
forall a. [a] -> [a]
reverse String
s of
':':x :: String
x@(_:_:_) -> ':' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
x
_ -> Bool
False
splitSshUrl :: String -> SshFilePath
splitSshUrl :: String -> SshFilePath
splitSshUrl s :: String
s | "ssh://" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s =
let s' :: String
s' = Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length "ssh://") (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
s
(dir :: String
dir, file :: String
file) = Char -> String -> (String, String)
cleanrepodir '/' String
s'
in
SshFP :: String -> String -> String -> SshFilePath
SshFP { sshUhost :: String
sshUhost = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '/') String
s'
, sshRepo :: String
sshRepo = String
dir
, sshFile :: String
sshFile = String
file }
splitSshUrl s :: String
s =
let (dir :: String
dir, file :: String
file) = Char -> String -> (String, String)
cleanrepodir ':' String
s in
SshFP :: String -> String -> String -> SshFilePath
SshFP { sshUhost :: String
sshUhost = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ':') String
s
, sshRepo :: String
sshRepo = String
dir
, sshFile :: String
sshFile = String
file }
cleanrepourl :: String -> (String, String)
cleanrepourl :: String -> (String, String)
cleanrepourl zzz :: String
zzz | String
dd String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
zzz = ([], Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
dd) String
zzz)
where dd :: String
dd = String
darcsdirString -> String -> String
forall a. [a] -> [a] -> [a]
++"/"
cleanrepourl (z :: Char
z:zs :: String
zs) =
let (repo' :: String
repo',file :: String
file) = String -> (String, String)
cleanrepourl String
zs in
(Char
z Char -> String -> String
forall a. a -> [a] -> [a]
: String
repo', String
file)
cleanrepourl "" = ([],[])
cleanrepodir :: Char -> String -> (String, String)
cleanrepodir :: Char -> String -> (String, String)
cleanrepodir sep :: Char
sep = String -> (String, String)
cleanrepourl (String -> (String, String))
-> (String -> String) -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop 1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
sep)
data SshFilePath = SshFP { SshFilePath -> String
sshUhost :: String
, SshFilePath -> String
sshRepo :: String
, SshFilePath -> String
sshFile :: String }
sshFilePathOf :: SshFilePath -> String
sshFilePathOf :: SshFilePath -> String
sshFilePathOf (SshFP uhost :: String
uhost dir :: String
dir file :: String
file) = String
uhost String -> String -> String
forall a. [a] -> [a] -> [a]
++ ":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String
dir String -> String -> String
</> String
darcsdir String -> String -> String
</> String
file)