{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
-- Copyright (C) 2009 Ganesh Sittampalam
--
-- Permission is hereby granted, free of charge, to any person
-- obtaining a copy of this software and associated documentation
-- files (the "Software"), to deal in the Software without
-- restriction, including without limitation the rights to use, copy,
-- modify, merge, publish, distribute, sublicense, and/or sell copies
-- of the Software, and to permit persons to whom the Software is
-- furnished to do so, subject to the following conditions:
--
-- The above copyright notice and this permission notice shall be
-- included in all copies or substantial portions of the Software.
--
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-- NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
-- BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
-- ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
-- CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-- SOFTWARE.

module Darcs.Patch.Split
    ( Splitter(..)
    , rawSplitter
    , noSplitter
    , primSplitter
    , reversePrimSplitter
    ) where

import Darcs.Prelude

import Data.List ( intersperse )

import Darcs.Patch.Witnesses.Ordered
import Darcs.Patch.Witnesses.Sealed

import Darcs.Patch.Apply ( ApplyState )
import Darcs.Patch.FileHunk ( FileHunk(..), IsHunk(..) )
import Darcs.Patch.Read ( ReadPatch(..) )
import Darcs.Patch.Show ( showPatch, ShowPatch(..) )
import Darcs.Patch.Invert( Invert(..), invertFL )
import Darcs.Patch.Prim ( PrimPatch, canonizeFL, primFromHunk )
import Darcs.Util.Parser ( parse )
import Darcs.Patch.Read ()
import Darcs.Patch.Show ( ShowPatchFor(ForDisplay) )
import Darcs.Patch.Viewing ()

import Darcs.Util.Printer ( renderPS )
import qualified Darcs.Util.Diff as D ( DiffAlgorithm )

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC


-- |A splitter is something that can take a patch and (possibly) render it
-- as text in some format of its own choosing.
-- This text can then be presented to the user for editing, and the result
-- given to the splitter for parsing.
-- If the parse succeeds, the result is a list of patches that could replace
-- the original patch in any context.
-- Typically this list will contain the changed version of the patch, along
-- with fixup pieces to ensure that the overall effect of the list is the same
-- as the original patch.
-- The individual elements of the list can then be offered separately to the
-- user, allowing them to accept some and reject others.
--
-- There's no immediate application for a splitter for anything other than
-- Prim (you shouldn't go editing named patches, you'll break them!)
-- However you might want to compose splitters for FilePatchType to make
-- splitters for Prim etc, and the generality doesn't cost anything.
data Splitter p = Splitter
    { forall (p :: * -> * -> *).
Splitter p
-> forall wX wY.
   p wX wY -> Maybe (ByteString, ByteString -> Maybe (FL p wX wY))
applySplitter :: forall wX wY. p wX wY
                    -> Maybe (B.ByteString, B.ByteString -> Maybe (FL p wX wY))
      -- canonization is needed to undo the effects of splitting
      -- Typically, the list returned by applySplitter will not
      -- be in the simplest possible form (since the user will have
      -- deliberately added extra stuff). Once the user has selected
      -- the pieces they want, we need to make sure that we eliminate
      -- any remaining redundancy in the selected pieces, otherwise
      -- we might record (or whatever) a rather strange looking patch.
      -- This hook allows the splitter to provide an appropriate
      -- function for doing this.
    , forall (p :: * -> * -> *).
Splitter p -> forall wX wY. FL p wX wY -> FL p wX wY
canonizeSplit :: forall wX wY. FL p wX wY -> FL p wX wY
    }

{- Some facts that probably ought to be true about splitters: should make some QC
properties

applySplitter p = Just (bs, f) ==> f bs == Just (p :>: NilFL)

applySplitter p = Just (bs, f) ; f bs' = Just ps ==> canonizeSplit ps = p :>: NilFL

-}

-- Does not canonize as there is no generic operation to do this.
withEditedHead :: Invert p => p wX wY -> p wX wZ -> FL p wX wY
withEditedHead :: forall (p :: * -> * -> *) wX wY wZ.
Invert p =>
p wX wY -> p wX wZ -> FL p wX wY
withEditedHead p wX wY
p p wX wZ
res = p wX wZ
res p wX wZ -> FL p wZ wY -> FL p wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: p wX wZ -> p wZ wX
forall wX wY. p wX wY -> p wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert p wX wZ
res p wZ wX -> FL p wX wY -> FL p wZ wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: p wX wY
p p wX wY -> FL p wY wY -> FL p wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL p wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL

-- |This generic splitter just lets the user edit the printed representation of the
-- patch. Should not be used expect for testing and experimentation.
rawSplitter :: (ShowPatch p, ReadPatch p, Invert p) => Splitter p
rawSplitter :: forall (p :: * -> * -> *).
(ShowPatch p, ReadPatch p, Invert p) =>
Splitter p
rawSplitter = Splitter
    { applySplitter :: forall wX wY.
p wX wY -> Maybe (ByteString, ByteString -> Maybe (FL p wX wY))
applySplitter = \p wX wY
p ->
        (ByteString, ByteString -> Maybe (FL p wX wY))
-> Maybe (ByteString, ByteString -> Maybe (FL p wX wY))
forall a. a -> Maybe a
Just (Doc -> ByteString
renderPS (Doc -> ByteString) -> (p wX wY -> Doc) -> p wX wY -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowPatchFor -> p wX wY -> Doc
forall wX wY. ShowPatchFor -> p wX wY -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForDisplay (p wX wY -> ByteString) -> p wX wY -> ByteString
forall a b. (a -> b) -> a -> b
$ p wX wY
p
             ,\ByteString
str -> case Parser (Sealed (p wX))
-> ByteString -> Either String (Sealed (p wX), ByteString)
forall a. Parser a -> ByteString -> Either String (a, ByteString)
parse Parser (Sealed (p wX))
forall wX. Parser (Sealed (p wX))
forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch' ByteString
str of
                        Right (Sealed p wX wX
res, ByteString
_) -> FL p wX wY -> Maybe (FL p wX wY)
forall a. a -> Maybe a
Just (p wX wY -> p wX wX -> FL p wX wY
forall (p :: * -> * -> *) wX wY wZ.
Invert p =>
p wX wY -> p wX wZ -> FL p wX wY
withEditedHead p wX wY
p p wX wX
res)
                        Left String
_                -> Maybe (FL p wX wY)
forall a. Maybe a
Nothing)
    , canonizeSplit :: forall wX wY. FL p wX wY -> FL p wX wY
canonizeSplit = FL p wX wY -> FL p wX wY
forall a. a -> a
forall wX wY. FL p wX wY -> FL p wX wY
id
    }

-- |Never splits. In other code we normally pass around Maybe Splitter instead
-- of using this as the default, because it saves clients that don't care about
-- splitting from having to import this module just to get noSplitter.
noSplitter :: Splitter p
noSplitter :: forall (p :: * -> * -> *). Splitter p
noSplitter = Splitter { applySplitter :: forall wX wY.
p wX wY -> Maybe (ByteString, ByteString -> Maybe (FL p wX wY))
applySplitter = Maybe (ByteString, ByteString -> Maybe (FL p wX wY))
-> p wX wY -> Maybe (ByteString, ByteString -> Maybe (FL p wX wY))
forall a b. a -> b -> a
const Maybe (ByteString, ByteString -> Maybe (FL p wX wY))
forall a. Maybe a
Nothing, canonizeSplit :: forall wX wY. FL p wX wY -> FL p wX wY
canonizeSplit = FL p wX wY -> FL p wX wY
forall a. a -> a
forall wX wY. FL p wX wY -> FL p wX wY
id }


doPrimSplit :: PrimPatch prim => D.DiffAlgorithm -> prim wX wY
            -> Maybe (B.ByteString, B.ByteString -> Maybe (FL prim wX wY))
doPrimSplit :: forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
DiffAlgorithm
-> prim wX wY
-> Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
doPrimSplit DiffAlgorithm
da = DiffAlgorithm
-> Bool
-> [ByteString]
-> prim wX wY
-> Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
forall (prim :: * -> * -> *) (p :: * -> * -> *) wX wY.
(PrimPatch prim, IsHunk p, ApplyState p ~ ApplyState prim) =>
DiffAlgorithm
-> Bool
-> [ByteString]
-> p wX wY
-> Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
doPrimSplit_ DiffAlgorithm
da Bool
True [ByteString]
explanation
  where
    explanation :: [ByteString]
explanation =
      (String -> ByteString) -> [String] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map String -> ByteString
BC.pack
        [ String
"Interactive hunk edit:"
        , String
" - Edit the section marked 'AFTER'"
        , String
" - Arbitrary editing is supported"
        , String
" - This will only affect the patch, not your working tree"
        , String
" - Hints:"
        , String
"   - To split added text, delete the part you want to postpone"
        , String
"   - To split removed text, copy back the part you want to retain"
        , String
""
        ]

doPrimSplit_ :: forall prim p wX wY. (PrimPatch prim, IsHunk p, ApplyState p ~ ApplyState prim)
             => D.DiffAlgorithm
             -> Bool
             -> [B.ByteString]
             -> p wX wY
             -> Maybe (B.ByteString, B.ByteString -> Maybe (FL prim wX wY))
doPrimSplit_ :: forall (prim :: * -> * -> *) (p :: * -> * -> *) wX wY.
(PrimPatch prim, IsHunk p, ApplyState p ~ ApplyState prim) =>
DiffAlgorithm
-> Bool
-> [ByteString]
-> p wX wY
-> Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
doPrimSplit_ DiffAlgorithm
da Bool
edit_before_part [ByteString]
helptext (p wX wY -> Maybe (FileHunk (ObjectIdOfPatch p) wX wY)
forall wX wY. p wX wY -> Maybe (FileHunk (ObjectIdOfPatch p) wX wY)
forall (p :: * -> * -> *) wX wY.
IsHunk p =>
p wX wY -> Maybe (FileHunk (ObjectIdOfPatch p) wX wY)
isHunk -> Just (FileHunk ObjectIdOfPatch p
fn Int
n [ByteString]
before [ByteString]
after))
 = (ByteString, ByteString -> Maybe (FL prim wX wY))
-> Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
forall a. a -> Maybe a
Just ([ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
intersperse (String -> ByteString
BC.pack String
"\n") ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ [[ByteString]] -> [ByteString]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
           [ [ByteString]
helptext
           , [String -> ByteString
mkSep String
" BEFORE (reference) =========================="]
           , [ByteString]
before
           , [String -> ByteString
mkSep String
"=== AFTER (edit) ============================="]
           , [ByteString]
after
           , [String -> ByteString
mkSep String
"=== (edit above) ============================="]
           ],
         \ByteString
bs -> do let ls :: [ByteString]
ls = Char -> ByteString -> [ByteString]
BC.split Char
'\n' ByteString
bs
                   ([ByteString]
_, [ByteString]
ls2) <- [ByteString] -> Maybe ([ByteString], [ByteString])
breakSep [ByteString]
ls        -- before
                   ([ByteString]
before', [ByteString]
ls3) <- [ByteString] -> Maybe ([ByteString], [ByteString])
breakSep [ByteString]
ls2 -- after 1
                   ([ByteString]
after', [ByteString]
_) <- [ByteString] -> Maybe ([ByteString], [ByteString])
breakSep [ByteString]
ls3    -- after
                   FL prim wX wY -> Maybe (FL prim wX wY)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (FL prim wX wY -> Maybe (FL prim wX wY))
-> FL prim wX wY -> Maybe (FL prim wX wY)
forall a b. (a -> b) -> a -> b
$
                     if Bool
edit_before_part
                     then [ByteString] -> [ByteString] -> FL prim wX Any
forall wA wB. [ByteString] -> [ByteString] -> FL prim wA wB
hunk [ByteString]
before [ByteString]
before' FL prim wX Any -> FL prim Any wY -> FL prim wX wY
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ [ByteString] -> [ByteString] -> FL prim Any Any
forall wA wB. [ByteString] -> [ByteString] -> FL prim wA wB
hunk [ByteString]
before' [ByteString]
after' FL prim Any Any -> FL prim Any wY -> FL prim Any wY
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ [ByteString] -> [ByteString] -> FL prim Any wY
forall wA wB. [ByteString] -> [ByteString] -> FL prim wA wB
hunk [ByteString]
after' [ByteString]
after
                     else [ByteString] -> [ByteString] -> FL prim wX Any
forall wA wB. [ByteString] -> [ByteString] -> FL prim wA wB
hunk [ByteString]
before [ByteString]
after' FL prim wX Any -> FL prim Any wY -> FL prim wX wY
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ [ByteString] -> [ByteString] -> FL prim Any wY
forall wA wB. [ByteString] -> [ByteString] -> FL prim wA wB
hunk [ByteString]
after' [ByteString]
after)
    where sep :: ByteString
sep = String -> ByteString
BC.pack String
"=========================="
          hunk :: [B.ByteString] -> [B.ByteString] -> FL prim wA wB
          hunk :: forall wA wB. [ByteString] -> [ByteString] -> FL prim wA wB
hunk [ByteString]
b [ByteString]
a = DiffAlgorithm -> FL prim wA wB -> FL prim wA wB
forall (prim :: * -> * -> *) wX wY.
(IsHunk prim, PrimCoalesce prim, PrimConstruct prim) =>
DiffAlgorithm -> FL prim wX wY -> FL prim wX wY
canonizeFL DiffAlgorithm
da (FileHunk (ObjectIdOfPatch prim) wA wB -> prim wA wB
forall wX wY. FileHunk (ObjectIdOfPatch prim) wX wY -> prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
FileHunk (ObjectIdOfPatch prim) wX wY -> prim wX wY
primFromHunk (ObjectIdOfPatch prim
-> Int
-> [ByteString]
-> [ByteString]
-> FileHunk (ObjectIdOfPatch prim) wA wB
forall oid wX wY.
oid -> Int -> [ByteString] -> [ByteString] -> FileHunk oid wX wY
FileHunk ObjectIdOfPatch prim
ObjectIdOfPatch p
fn Int
n [ByteString]
b [ByteString]
a) prim wA wB -> FL prim wB wB -> FL prim wA wB
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL prim wB wB
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
          mkSep :: String -> ByteString
mkSep String
s = ByteString -> ByteString -> ByteString
BC.append ByteString
sep (String -> ByteString
BC.pack String
s)
          breakSep :: [ByteString] -> Maybe ([ByteString], [ByteString])
breakSep [ByteString]
xs = case (ByteString -> Bool)
-> [ByteString] -> ([ByteString], [ByteString])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (ByteString
sep ByteString -> ByteString -> Bool
`BC.isPrefixOf`) [ByteString]
xs of
                           ([ByteString]
_, []) -> Maybe ([ByteString], [ByteString])
forall a. Maybe a
Nothing
                           ([ByteString]
ys, ByteString
_:[ByteString]
zs) -> ([ByteString], [ByteString]) -> Maybe ([ByteString], [ByteString])
forall a. a -> Maybe a
Just ([ByteString]
ys, [ByteString]
zs)
doPrimSplit_ DiffAlgorithm
_ Bool
_ [ByteString]
_ p wX wY
_ = Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
forall a. Maybe a
Nothing

-- |Split a primitive hunk patch up by allowing the user to edit both the
-- before and after lines, then insert fixup patches to clean up the mess.
primSplitter :: PrimPatch p => D.DiffAlgorithm -> Splitter p
primSplitter :: forall (p :: * -> * -> *).
PrimPatch p =>
DiffAlgorithm -> Splitter p
primSplitter DiffAlgorithm
da = Splitter { applySplitter :: forall wX wY.
p wX wY -> Maybe (ByteString, ByteString -> Maybe (FL p wX wY))
applySplitter = DiffAlgorithm
-> p wX wY -> Maybe (ByteString, ByteString -> Maybe (FL p wX wY))
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
DiffAlgorithm
-> prim wX wY
-> Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
doPrimSplit DiffAlgorithm
da
                           , canonizeSplit :: forall wX wY. FL p wX wY -> FL p wX wY
canonizeSplit = DiffAlgorithm -> FL p wX wY -> FL p wX wY
forall (prim :: * -> * -> *) wX wY.
(IsHunk prim, PrimCoalesce prim, PrimConstruct prim) =>
DiffAlgorithm -> FL prim wX wY -> FL prim wX wY
canonizeFL DiffAlgorithm
da }

doReversePrimSplit :: PrimPatch prim => D.DiffAlgorithm -> prim wX wY
                   -> Maybe (B.ByteString, B.ByteString -> Maybe (FL prim wX wY))
doReversePrimSplit :: forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
DiffAlgorithm
-> prim wX wY
-> Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
doReversePrimSplit DiffAlgorithm
da prim wX wY
prim = do
  (ByteString
text, ByteString -> Maybe (FL prim wY wX)
parser) <- DiffAlgorithm
-> Bool
-> [ByteString]
-> prim wY wX
-> Maybe (ByteString, ByteString -> Maybe (FL prim wY wX))
forall (prim :: * -> * -> *) (p :: * -> * -> *) wX wY.
(PrimPatch prim, IsHunk p, ApplyState p ~ ApplyState prim) =>
DiffAlgorithm
-> Bool
-> [ByteString]
-> p wX wY
-> Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
doPrimSplit_ DiffAlgorithm
da Bool
False [ByteString]
reverseExplanation (prim wX wY -> prim wY wX
forall wX wY. prim wX wY -> prim wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert prim wX wY
prim)
  let parser' :: ByteString -> Maybe (FL prim wX wY)
parser' ByteString
p = do
        FL prim wY wX
patch <- ByteString -> Maybe (FL prim wY wX)
parser  ByteString
p
        FL prim wX wY -> Maybe (FL prim wX wY)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (FL prim wX wY -> Maybe (FL prim wX wY))
-> (RL prim wX wY -> FL prim wX wY)
-> RL prim wX wY
-> Maybe (FL prim wX wY)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RL prim wX wY -> FL prim wX wY
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL (RL prim wX wY -> Maybe (FL prim wX wY))
-> RL prim wX wY -> Maybe (FL prim wX wY)
forall a b. (a -> b) -> a -> b
$ FL prim wY wX -> RL prim wX wY
forall (p :: * -> * -> *) wX wY.
Invert p =>
FL p wX wY -> RL p wY wX
invertFL FL prim wY wX
patch
  (ByteString, ByteString -> Maybe (FL prim wX wY))
-> Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
text, ByteString -> Maybe (FL prim wX wY)
parser')
  where
    reverseExplanation :: [ByteString]
reverseExplanation =
      (String -> ByteString) -> [String] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map String -> ByteString
BC.pack
        [ String
"Interactive hunk edit:"
        , String
" - Edit the section marked 'AFTER' (representing the state to which you'll revert)"
        , String
" - Arbitrary editing is supported"
        , String
" - Your working tree will be returned to the 'AFTER' state"
        , String
" - Do not touch the 'BEFORE' section"
        , String
" - Hints:"
        , String
"   - To revert only a part of a text addition, delete the part you want to get rid of"
        , String
"   - To revert only a part of a removal, copy back the part you want to retain"
        , String
""
        ]

reversePrimSplitter :: PrimPatch prim => D.DiffAlgorithm -> Splitter prim
reversePrimSplitter :: forall (p :: * -> * -> *).
PrimPatch p =>
DiffAlgorithm -> Splitter p
reversePrimSplitter DiffAlgorithm
da = Splitter { applySplitter :: forall wX wY.
prim wX wY
-> Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
applySplitter = DiffAlgorithm
-> prim wX wY
-> Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
DiffAlgorithm
-> prim wX wY
-> Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
doReversePrimSplit DiffAlgorithm
da
                                  , canonizeSplit :: forall wX wY. FL prim wX wY -> FL prim wX wY
canonizeSplit = DiffAlgorithm -> FL prim wX wY -> FL prim wX wY
forall (prim :: * -> * -> *) wX wY.
(IsHunk prim, PrimCoalesce prim, PrimConstruct prim) =>
DiffAlgorithm -> FL prim wX wY -> FL prim wX wY
canonizeFL DiffAlgorithm
da }