Shows changes from both sides in a file with 3-way merge conflicts

3waydiff.hs

#!/usr/bin/env stack
{-
   stack
   --resolver lts-10.4
   --install-ghc
   script
   --package temporary
   --package megaparsec
   --package rainbow
   --package typed-process
   --package bytestring
-}

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}

import System.Environment
import Text.Megaparsec
import Text.Megaparsec.Char
import Data.Void
import Rainbow
import System.Process.Typed
import qualified Data.ByteString.Lazy as BS
import Control.Monad
import System.IO.Temp
import GHC.IO.Handle

type Parser = Parsec Void String

data Conflict = Conflict String String String

data ConflictedFile = ConflictedFile [Either Conflict String]

conflictedFile :: Parser ConflictedFile
conflictedFile = ConflictedFile <$> many (Left <$> conflict <|> Right <$> chunk)
  where
  chunk = unlines <$> some (notFollowedBy (string "<<<<<<<") *> line)
  line = manyTill anyChar eol
  conflict :: Parser Conflict
  conflict = do
    aName <- string "<<<<<<<" *> line
    aContent <- unlines <$> many (notFollowedBy (string "|||||||") *> line)
    bName <- string "|||||||" *> line
    bContent <- unlines <$> many (notFollowedBy (string "=======") *> line)
    string "=======" *> line
    cContent <- unlines <$> many (notFollowedBy (string ">>>>>>>") *> line)
    cName <- string ">>>>>>>" *> line
    return $ Conflict aContent bContent cContent

main :: IO ()
main =  do
  [f] <- getArgs
  c <- readFile f
  case parseMaybe conflictedFile c of
    Nothing -> print "DOH failed to parse as a conflicted file"
    Just (ConflictedFile entries) -> forM_ entries $ \case
      Left (Conflict a b c) -> do
        let
          withWrittenTempFiles xs = go xs []
          go [] vs cb = cb vs
          go (x : xs) vs cb = do
            withSystemTempFile "" $ \path handle -> do
              hPutStr handle x
              hClose handle
              go xs (vs ++ [path]) cb
        withWrittenTempFiles [a, b, c] $ \[fa, fb, fc] -> do
          runProcess_ (proc "icdiff" ["-U1", fb, fa])
          runProcess_ (proc "icdiff" ["-U1", fb, fc])
      Right chunk -> do
        putStrLn ""
        putStrLn ""
        putStrLn ""