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