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:
parent
2101ef20d1
commit
b9d328b245
2 changed files with 60 additions and 1 deletions
56
Git/PostFetch.hs
Normal file
56
Git/PostFetch.hs
Normal 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
|
||||
]
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue