From 7e592e1d6ed5e0b25b37215da7558c6324688d6f Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@debian.org>
Date: Fri, 22 Nov 2013 11:16:03 -0400
Subject: git-repair (1.20131122) unstable; urgency=low

  * Added test mode, which can be used to randomly corrupt test
    repositories, in reproducible ways, which allows easy
    corruption-driven-development.
  * Improve repair code in the case where the index file is corrupt,
    and this hides other problems.
  * Write a dummy .git/HEAD if the file is missing or corrupt, as
    git otherwise will not treat the repository as a git repo.
  * Improve fsck code to find badly corrupted objects that crash git fsck
    before it can complain about them.
  * Fixed crashes on bad file encodings.
  * Can now run 10000 tests (git-repair --test -n 10000 --force)
    with 0 failures.

# imported from the archive
---
 Git/Url.hs | 71 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 71 insertions(+)
 create mode 100644 Git/Url.hs

(limited to 'Git/Url.hs')

diff --git a/Git/Url.hs b/Git/Url.hs
new file mode 100644
index 0000000..d383a6a
--- /dev/null
+++ b/Git/Url.hs
@@ -0,0 +1,71 @@
+{- git repository urls
+ -
+ - Copyright 2010, 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.Url (
+	scheme,
+	host,
+	port,
+	hostuser,
+	authority,
+) where
+
+import Network.URI hiding (scheme, authority)
+
+import Common
+import Git.Types
+import Git
+
+{- Scheme of an URL repo. -}
+scheme :: Repo -> String
+scheme Repo { location = Url u } = uriScheme u
+scheme repo = notUrl repo
+
+{- Work around a bug in the real uriRegName
+ - <http://trac.haskell.org/network/ticket/40> -}
+uriRegName' :: URIAuth -> String
+uriRegName' a = fixup $ uriRegName a
+  where
+	fixup x@('[':rest)
+		| rest !! len == ']' = take len rest
+		| otherwise = x
+	  where
+		len  = length rest - 1
+	fixup x = x
+
+{- Hostname of an URL repo. -}
+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 -> Nothing
+		Just ":" -> Nothing
+		Just (':':p) -> readish p
+		Just _ -> Nothing
+
+{- Hostname of an URL repo, including any username (ie, "user@host") -}
+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 -> 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 -> Maybe a
+authpart a Repo { location = Url u } = a <$> uriAuthority u
+authpart _ repo = notUrl repo
+
+notUrl :: Repo -> a
+notUrl repo = error $
+	"acting on local git repo " ++ repoDescribe repo ++ " not supported"
-- 
cgit v1.2.3