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.
This commit is contained in:
Joey Hess 2011-12-26 01:24:07 -04:00
parent 2101ef20d1
commit b9d328b245
2 changed files with 60 additions and 1 deletions

56
Git/PostFetch.hs Normal file
View file

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

View file

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