From b9d328b245dc973b232a1c6de6025526f1d03b7e Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Mon, 26 Dec 2011 01:24:07 -0400
Subject: [PATCH] add git-post-fetch hook support

I spent 10 hours today writing code to feed and parse the output of this
hook in C. I had 10 minutes so thought I'd do the same in Haskell,
as a way to get all those pointers, explicit memory management, impure
code, and lack of abstractions out of my head.

Later, if the hook is actually accepted into git, git-annex will be able
to use it to run the git-annex merge, as well as perhaps enable a mode
where pulling from remotes known to git-annex automatically merges
their master branch into the local master.
---
 Git/PostFetch.hs | 56 ++++++++++++++++++++++++++++++++++++++++++++++++
 Git/Sha.hs       |  5 ++++-
 2 files changed, 60 insertions(+), 1 deletion(-)
 create mode 100644 Git/PostFetch.hs

diff --git a/Git/PostFetch.hs b/Git/PostFetch.hs
new file mode 100644
index 0000000000..2079ea2624
--- /dev/null
+++ b/Git/PostFetch.hs
@@ -0,0 +1,56 @@
+{- git post-fetch hook support
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.PostFetch where
+
+import Common
+import Git
+import Git.Types
+import Git.Sha
+
+{- Each line fed to the post-fetch hook should represent a ref that is
+ - being updated. To avoid breaking if the format changes, unparsable
+ - lines are stored as-is. -}
+data FetchedRef = Unparsable String | FetchedRef
+	{ sha :: Sha
+	, merge :: Bool
+	, remote :: Ref
+	, local :: Ref
+	}
+	deriving (Show)
+
+input :: IO [FetchedRef]
+input = map parseLine . lines <$> getContents
+
+output :: [FetchedRef] -> IO ()
+output = mapM_ $ putStrLn . genLine
+
+parseLine :: String -> FetchedRef
+parseLine line = go $ words line
+	where
+		go [s, m, r, l]
+			| not $ isSha s = Unparsable line
+			| m == "merge" = parsed True
+			| m == "not-for-merge" = parsed False
+			| otherwise = Unparsable line
+			where
+				parsed v = FetchedRef
+					{ sha = Ref s
+					, merge = v
+					, remote = Ref r
+					, local = Ref l
+					}
+		go _ = Unparsable line
+
+genLine :: FetchedRef -> String
+genLine (Unparsable l) = l
+genLine r = unwords
+	[ show $ sha r
+	, if merge r then "merge" else "not-for-merge"
+	, show $ remote r
+	, show $ local r
+	]
diff --git a/Git/Sha.hs b/Git/Sha.hs
index 9b3a346505..cdf9853cfa 100644
--- a/Git/Sha.hs
+++ b/Git/Sha.hs
@@ -28,9 +28,12 @@ extractSha s
 		len = length s
 		s' = firstLine s
 		val v
-			| all (`elem` "1234567890ABCDEFabcdef") v = Just $ Ref v
+			| isSha v = Just $ Ref v
 			| otherwise = Nothing
 
+isSha :: String -> Bool
+isSha v = all (`elem` "1234567890ABCDEFabcdef") v && length v == shaSize
+
 {- Size of a git sha. -}
 shaSize :: Int
 shaSize = 40