{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

module Merge
  ( MergeOpts(..)
  , mergeOption
  , fmtMerged
  , merge
  ) where

import qualified Data.ByteString.Builder as BB
import Data.String
import Options.Applicative
import Types

data MergeOpts =
  MergeOpts
    { mergeDoMerge :: Bool
    , mergeIgnoreWhitespace :: Bool
    , mergeForceWhitespace :: Bool
    , mergeKeepWhitespace :: Bool
    , mergeCStartStr :: BS
    , mergeMineSepStr :: BS
    , mergeYourSepStr :: BS
    , mergeCEndStr :: BS
    }
  deriving (Show)

mergeOption :: Bool -> Parser MergeOpts
mergeOption forPatch =
  addLBR <$>
  ((,) <$>
   switch
     (short 'a' <>
      long "add-linebreak" <>
      help "Automatically add a line break after conflict markers. Useful with `lines' lexer.") <*>
   mo)
  where
    marker = fromString . replicate 7
    mo =
      MergeOpts <$>
      switch
        (short 'm' <>
         long "merge" <>
         help
           (if forPatch
              then "Instead of printing the rejected thunks, merge using conflict markers as if the INPUT was `MYFILE' and the patch would produced `YOURFILE' from the original."
              else "Output the merged file instead of the patch")) <*>
      switch
        (short 'I' <>
         long "ignore-whitespace" <>
         help
           ("Ignore " ++
            (if forPatch
               then "hunks"
               else "chunks") ++
            " that change only whitespace")) <*>
      switch
        (short 'F' <>
         long "force-whitespace" <>
         help
           ((if forPatch
               then "Force rejecting a hunk"
               else "Force a merge conflict") ++
            " on whitespace mismatch (overrides `ignore-whitespace')")) <*>
      switch
        (short 'K' <>
         long "keep-whitespace" <>
         help
           ("On whitespace mismatch, output the version from " ++
            (if forPatch
               then "the original file"
               else "MYFILE") ++
            " instead of the one from " ++
            (if forPatch
               then "the context in patch"
               else "YOURFILE"))) <*>
      strOption
        (long "merge-start" <>
         value (marker '<') <> help "Marker for the beginning of a conflict") <*>
      strOption
        (long "merge-mine" <>
         value (marker '|') <>
         help
           "Marker that separates `mine' from `original' part of the conflict") <*>
      strOption
        (long "merge-your" <>
         value (marker '=') <>
         help
           "Marker that separates `original' from `your' part of the conflict") <*>
      strOption
        (long "merge-end" <>
         value (marker '>') <> help "Marker for the end of a conflict")
    addLBR (False, x) = x
    addLBR (True, x) =
      x
        { mergeCStartStr = mergeCStartStr x <> "\n"
        , mergeMineSepStr = mergeMineSepStr x <> "\n"
        , mergeYourSepStr = mergeYourSepStr x <> "\n"
        , mergeCEndStr = mergeCEndStr x <> "\n"
        }

{- This kinda relies on reasonable ordering
 - within the conflicts in the Diff -}
fmtMerged :: MergeOpts -> Diff -> BB.Builder
fmtMerged mo = go Keep
  where
    go op []
      | conflictOp op = bb $ mergeCEndStr mo
      | otherwise = mempty
    go prev l@((op, (_, tok)):xs)
      | conflictOp prev && not (conflictOp op) =
        bb (mergeCEndStr mo) <> go Keep l
      | not (conflictOp prev) && conflictOp op =
        bb (mergeCStartStr mo) <> go MineChanged l
      | prev /= op && conflictOp op =
        (case op of
           MineChanged -> bb $ mergeCStartStr mo
           Original -> bb $ mergeMineSepStr mo
           YourChanged -> bb $ mergeYourSepStr mo
           _ -> error "Internal conflict handling failure") <>
        go op l
      | op == Remove = go op xs
      | otherwise = bb tok <> go op xs
    conflictOp o =
      case o of
        Keep -> False
        Add -> False
        Remove -> False
        _ -> True
    bb = BB.byteString

merge :: MergeOpts -> [(Origin, (Op, Tok))] -> Diff
merge mo cs = go
  where
    mys@[diffMine, diffYour] =
      map (\a -> map snd $ filter ((a ==) . fst) cs) [Mine, Your]
    [tokOrigsMine, tokOrigsYour] = map (map snd . filter ((Add /=) . fst)) mys
    [tokMine, tokYour] = map (map snd . filter ((Remove /=) . fst)) mys
    conflict =
      map (MineChanged, ) tokMine ++
      map (Original, ) tokOrigsMine ++ map (YourChanged, ) tokYour
    noTokens = all (not . fst . snd) (diffMine ++ diffYour)
    go
      | tokOrigsMine /= tokOrigsYour =
        error "Internal failure: merge origins differ"
      | mergeIgnoreWhitespace mo && noTokens = map (Keep, ) tokOrigsMine
      | all ((Keep ==) . fst) diffYour = diffMine -- only mine changed
      | all ((Keep ==) . fst) diffMine = diffYour -- only your changed
      | diffMine == diffYour = diffMine -- false conflict
      | not (mergeForceWhitespace mo) && noTokens =
        if mergeKeepWhitespace mo
          then diffMine
          else diffYour -- conflict happened, but not on significant tokens
      | otherwise = conflict -- true conflict