better types

This commit is contained in:
Joey Hess 2011-12-26 01:59:50 -04:00
parent d50c48693f
commit 1b1b1c32b9

View file

@ -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