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:
Joey Hess 2021-01-18 15:07:23 -04:00
parent 2aa4fab62a
commit e7134ca1eb
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 16 additions and 25 deletions

View file

@ -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]

View file

@ -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