map: Work when there are gcrypt remotes.

1 files changed, 12 insertions, 11 deletions

diff --git a/Git/Url.hs b/Git/Url.hs
index 7befc4669..d383a6aca 100644
--- a/Git/Url.hs
+++ b/Git/Url.hs
@@ -37,32 +37,33 @@ uriRegName' a = fixup $ uriRegName a
 	fixup x = x
 
 {- Hostname of an URL repo. -}
-host :: Repo -> String
+host :: Repo -> Maybe String
 host = authpart uriRegName'
 
 {- Port of an URL repo, if it has a nonstandard one. -}
 port :: Repo -> Maybe Integer
 port r = 
 	case authpart uriPort r of
-		":" -> Nothing
-		(':':p) -> readish p
-		_ -> Nothing
+		Nothing -> Nothing
+		Just ":" -> Nothing
+		Just (':':p) -> readish p
+		Just _ -> Nothing
 
 {- Hostname of an URL repo, including any username (ie, "user@host") -}
-hostuser :: Repo -> String
-hostuser r = authpart uriUserInfo r ++ authpart uriRegName' r
+hostuser :: Repo -> Maybe String
+hostuser r = (++)
+	<$> authpart uriUserInfo r
+	<*> authpart uriRegName' r
 
 {- The full authority portion an URL repo. (ie, "user@host:port") -}
-authority :: Repo -> String
+authority :: Repo -> Maybe String
 authority = authpart assemble
   where
 	assemble a = uriUserInfo a ++ uriRegName' a ++ uriPort a
 
 {- Applies a function to extract part of the uriAuthority of an URL repo. -}
-authpart :: (URIAuth -> a) -> Repo -> a
-authpart a Repo { location = Url u } = a auth
-  where
-	auth = fromMaybe (error $ "bad url " ++ show u) (uriAuthority u)
+authpart :: (URIAuth -> a) -> Repo -> Maybe a
+authpart a Repo { location = Url u } = a <$> uriAuthority u
 authpart _ repo = notUrl repo
 
 notUrl :: Repo -> a