better types

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
+data FetchedRef = FetchedRef
- - 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
 	{ 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]
+		go u@(Left _) = return [u]
-		callmutate f = catchDefaultIO (mutate f) [f]
+		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 :: HookLine -> String
-genLine (Unparsable l) = l
+genLine (Left l) = l
-genLine r = unwords
+genLine (Right r) = unwords
 	[ show $ sha r
 	, if merge r then "merge" else "not-for-merge"
 	, show $ remote r