refactor
This commit is contained in:
parent
1b1b1c32b9
commit
cacdf58e9c
1 changed files with 16 additions and 7 deletions
|
@ -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
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue