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
|
len = length s
|
||||||
s' = firstLine s
|
s' = firstLine s
|
||||||
val v
|
val v
|
||||||
| all (`elem` "1234567890ABCDEFabcdef") v = Just $ Ref v
|
| isSha v = Just $ Ref v
|
||||||
| otherwise = Nothing
|
| otherwise = Nothing
|
||||||
|
|
||||||
|
isSha :: String -> Bool
|
||||||
|
isSha v = all (`elem` "1234567890ABCDEFabcdef") v && length v == shaSize
|
||||||
|
|
||||||
{- Size of a git sha. -}
|
{- Size of a git sha. -}
|
||||||
shaSize :: Int
|
shaSize :: Int
|
||||||
shaSize = 40
|
shaSize = 40
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue