avoid partial functions in Git.Url
After the last commit, it was able to throw errors just due to an unparseable url. This avoids needing to worry about that, as long as the call site has already checked that it has a parseable url.
This commit is contained in:
parent
2aa4fab62a
commit
e7134ca1eb
3 changed files with 16 additions and 25 deletions
|
@ -121,16 +121,16 @@ localToUrl :: Repo -> Repo -> Repo
|
|||
localToUrl reference r
|
||||
| not $ repoIsUrl reference = error "internal error; reference repo not url"
|
||||
| repoIsUrl r = r
|
||||
| otherwise = case Url.authority reference of
|
||||
Nothing -> r
|
||||
Just auth ->
|
||||
| otherwise = case (Url.authority reference, Url.scheme reference) of
|
||||
(Just auth, Just s) ->
|
||||
let absurl = concat
|
||||
[ Url.scheme reference
|
||||
[ s
|
||||
, "//"
|
||||
, auth
|
||||
, fromRawFilePath (repoPath r)
|
||||
]
|
||||
in r { location = Url $ fromJust $ parseURI absurl }
|
||||
_ -> r
|
||||
|
||||
{- Calculates a list of a repo's configured remotes, by parsing its config. -}
|
||||
fromRemotes :: Repo -> IO [Repo]
|
||||
|
|
25
Git/Url.hs
25
Git/Url.hs
|
@ -18,13 +18,11 @@ import Network.URI hiding (scheme, authority, path)
|
|||
|
||||
import Common
|
||||
import Git.Types
|
||||
import Git
|
||||
|
||||
{- Scheme of an URL repo. -}
|
||||
scheme :: Repo -> String
|
||||
scheme Repo { location = Url u } = uriScheme u
|
||||
scheme Repo { location = UnparseableUrl u } = unparseableUrl u
|
||||
scheme repo = notUrl repo
|
||||
scheme :: Repo -> Maybe String
|
||||
scheme Repo { location = Url u } = Just (uriScheme u)
|
||||
scheme _ = Nothing
|
||||
|
||||
{- Work around a bug in the real uriRegName
|
||||
- <http://trac.haskell.org/network/ticket/40> -}
|
||||
|
@ -66,18 +64,9 @@ authority = authpart assemble
|
|||
{- Applies a function to extract part of the uriAuthority of an URL repo. -}
|
||||
authpart :: (URIAuth -> a) -> Repo -> Maybe a
|
||||
authpart a Repo { location = Url u } = a <$> uriAuthority u
|
||||
authpart _ Repo { location = UnparseableUrl u } = unparseableUrl u
|
||||
authpart _ repo = notUrl repo
|
||||
authpart _ _ = Nothing
|
||||
|
||||
{- Path part of an URL repo. -}
|
||||
path :: Repo -> FilePath
|
||||
path Repo { location = Url u } = uriPath u
|
||||
path Repo { location = UnparseableUrl u } = unparseableUrl u
|
||||
path repo = notUrl repo
|
||||
|
||||
notUrl :: Repo -> a
|
||||
notUrl repo = error $
|
||||
"acting on local git repo " ++ repoDescribe repo ++ " not supported"
|
||||
|
||||
unparseableUrl :: String -> a
|
||||
unparseableUrl u = error $ "unable to parse repo url " ++ u
|
||||
path :: Repo -> Maybe FilePath
|
||||
path Repo { location = Url u } = Just (uriPath u)
|
||||
path _ = Nothing
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue