This commit is contained in:
Joey Hess 2011-12-26 03:02:57 -04:00
parent 1b1b1c32b9
commit cacdf58e9c

View file

@ -5,11 +5,10 @@
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
module Git.PostFetch (runHook, FetchedRef(..)) where module Git.PostFetch (runHook, runHookUnsafe, FetchedRef(..)) where
import Common import Common
import Git import Git
import Git.Types
import Git.Sha import Git.Sha
data FetchedRef = FetchedRef data FetchedRef = FetchedRef
@ -27,15 +26,25 @@ data FetchedRef = FetchedRef
- lines are stored as-is. -} - lines are stored as-is. -}
type HookLine = Either String FetchedRef type HookLine = Either String FetchedRef
{- Runs the hook, allowing lines to be mutated and even produce more {- Runs the hook, allowing lines to be mutated, but never be discarded.
- than one output line, but never be discarded. Unparsable lines are - Unparsable lines are passed through unchanged. -}
- passed through unchanged. -} runHook :: (FetchedRef -> IO FetchedRef) -> IO ()
runHook :: (FetchedRef -> IO [FetchedRef]) -> IO () runHook mutate = runHook' go id
runHook mutate = output . concat =<< mapM go =<< input where
go u@(Left _) = return u
go (Right r) = Right <$> catchDefaultIO (mutate r) r
{- Runs the hook, allowing lines to be mutated, discarded, or produce
- multiple output lines. Unparsable lines are passed through unchanged. -}
runHookUnsafe :: (FetchedRef -> IO [FetchedRef]) -> IO ()
runHookUnsafe mutate = runHook' go concat
where where
go u@(Left _) = return [u] go u@(Left _) = return [u]
go (Right r) = map Right <$> catchDefaultIO (mutate r) [r] go (Right r) = map Right <$> catchDefaultIO (mutate r) [r]
runHook' :: (HookLine -> IO b) -> ([b] -> [HookLine]) -> IO ()
runHook' mutate reduce = output . reduce =<< mapM mutate =<< input
input :: IO [HookLine] input :: IO [HookLine]
input = map parseLine . lines <$> getContents input = map parseLine . lines <$> getContents