diff --git a/Git/PostFetch.hs b/Git/PostFetch.hs index a031164b68..a33b8ea834 100644 --- a/Git/PostFetch.hs +++ b/Git/PostFetch.hs @@ -12,12 +12,7 @@ import Git import Git.Types import Git.Sha -{- Each line fed to the post-fetch hook should represent a ref that is - - being updated. It's important that the hook always outputs every line - - that is fed into it (possibly modified), otherwise incoming refs will - - not be stored. So to avoid breaking if the format changes, unparsable - - lines are stored as-is. -} -data FetchedRef = Unparsable String | FetchedRef +data FetchedRef = FetchedRef { sha :: Sha , merge :: Bool , remote :: Ref @@ -25,41 +20,48 @@ data FetchedRef = Unparsable String | FetchedRef } deriving (Show) +{- Each line fed to the post-fetch hook should represent a ref that is + - being updated. It's important that the hook always outputs every line + - that is fed into it (possibly modified), otherwise incoming refs will + - not be stored. So to avoid breaking if the format changes, unparsable + - lines are stored as-is. -} +type HookLine = Either String FetchedRef + {- Runs the hook, allowing lines to be mutated and even produce more - than one output line, but never be discarded. Unparsable lines are - passed through unchanged. -} runHook :: (FetchedRef -> IO [FetchedRef]) -> IO () -runHook mutate = input >>= mapM callmutate >>= output . concat +runHook mutate = output . concat =<< mapM go =<< input where - callmutate u@(Unparsable _) = return [u] - callmutate f = catchDefaultIO (mutate f) [f] + go u@(Left _) = return [u] + go (Right r) = map Right <$> catchDefaultIO (mutate r) [r] -input :: IO [FetchedRef] +input :: IO [HookLine] input = map parseLine . lines <$> getContents -output :: [FetchedRef] -> IO () +output :: [HookLine] -> IO () output = mapM_ $ putStrLn . genLine -parseLine :: String -> FetchedRef +parseLine :: String -> HookLine parseLine line = go $ words line where go [s, m, r, l] - | not $ isSha s = Unparsable line + | not $ isSha s = Left line | m == "merge" = parsed True | m == "not-for-merge" = parsed False - | otherwise = Unparsable line + | otherwise = Left line where - parsed v = FetchedRef + parsed v = Right $ FetchedRef { sha = Ref s , merge = v , remote = Ref r , local = Ref l } - go _ = Unparsable line + go _ = Left line -genLine :: FetchedRef -> String -genLine (Unparsable l) = l -genLine r = unwords +genLine :: HookLine -> String +genLine (Left l) = l +genLine (Right r) = unwords [ show $ sha r , if merge r then "merge" else "not-for-merge" , show $ remote r