Shows differences between base-to-a and base-to-b in git merge conflicts

diffme

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

{-# 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 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
        writeFile "/tmp/ours" a
        writeFile "/tmp/base" b
        writeFile "/tmp/theirs" c

        runProcess_ (proc "icdiff" ["-U1", "/tmp/base", "/tmp/ours"])
        runProcess_ (proc "icdiff" ["-U1", "/tmp/base", "/tmp/theirs"])

      Right _chunk -> do
        putChunkLn $ chunk ("---------------------------------------------------------------------------" :: String) & faint