{-# LANGUAGE DeriveDataTypeable #-}
module Main where

import Prelude hiding (splitAt, drop)
import qualified Data.List as L
import Data.Sequence (Seq(..), (><), singleton, splitAt, drop, fromList, empty)
import Data.Foldable
import qualified Data.Sequence as S
import Data.Generics

type Buffer = Seq Char

insert :: Int -> [a] -> Seq a -> Seq a
insert n x buf = 
    let (before, after) = splitAt n buf 
    in 
      before >< fromList x >< after

-- should return deleted sequence
delete :: Int -> Int -> Seq a -> Seq a
delete pos len buf =
    let (before, after) = splitAt pos buf
    in
      before >< drop len after

data Operation
    = Insert Int String
    | Delete Int String
      deriving (Read, Show, Eq, Typeable, Data)

applyOp :: Buffer -> Operation -> Buffer
applyOp buf (Insert n str) = insert n str buf
applyOp buf (Delete n str) = delete n (length str) buf

overlap :: (Int, Int) -> (Int, Int) -> Bool
overlap (pos1, len1) (pos2, len2) =
    (pos2 + len2 - 1 > pos1) &&
    (pos2 <= pos1 + len1 - 1)

-- detect if the second operation conflicts with the first
{-
Cases:

 1. An operation conflicts with Insert if it alters the text which was
 inserted

 2. An operation conflicts with a Delete if it alters the two
 characters bording the Delete.

 Consider, Insert 2 "x" $ Delete 2 1 (fromList "abc") -> axc.  If we
 undo the delete, show we have, abxc or axbc ? Hence the border.

-}
conflict :: Operation -> Operation -> Bool
-- conflict: The second string is inserted in the middle of the first string
-- note: if pos2 < pos1, it does not matter how long len2 is, because
-- the previously insert text while be shifted over, not overwritten.
conflict (Insert pos1 str1) (Insert pos2 str2) =
    (pos1 < pos2) && (pos2 < pos1 + length str1)
-- conflict: delete overlaps with the insert
conflict (Insert pos1 str1) (Delete pos2 str2) =
    overlap (pos1, length str1) (pos2, length str2)
conflict (Delete pos1 _) (Insert pos2 _) = 
    (pos2 == pos1)
-- conflict: the second delete overlaps with the character before or after the first delete.
conflict (Delete pos1 str1) (Delete pos2 str2) =
    overlap (pos1 - 1, 2) (pos2, length str2)

transpose :: Operation -> Operation -> (Operation, Operation)
transpose (Insert pos1 str1) (Insert pos2 str2)
    | pos2 > pos1 =
        (Insert (pos2 - length str1) str2, Insert pos1 str1)
    | otherwise =
        (Insert pos2 str2, Insert (pos1 + length str2) str1)
transpose (Insert pos1 str1) (Delete pos2 str2)
    | pos2 > pos1 =
        (Delete (pos2 - length str1) str2, Insert pos1 str1)
    | otherwise =
        (Delete pos2 str2, Insert (pos1 - length str2) str1)
transpose (Delete pos1 str1) (Insert pos2 str2)
    | pos2 > pos1 =
        (Insert (pos2 + length str1) str2, Delete pos1 str1)
    | otherwise =
        (Insert pos2 str2, Delete (pos1 + length str2) str1)
transpose (Delete pos1 str1) (Delete pos2 str2)
    | pos2 >= pos1 =
        (Delete (pos2 + length str1) str2, Delete pos1 str1)
    | otherwise =
        (Delete pos2 str2, Delete (pos1 - length str2) str1)

inverse :: Operation -> Operation
inverse (Insert pos str) = Delete pos str
inverse (Delete pos str) = Insert pos str

newtype History = History [Operation]
    deriving (Show, Read)


-- given a complete History, show the current document
renderDocument :: History -> String
renderDocument (History operations) = 
    toList $ L.foldl applyOp empty operations

-- support single undo
-- multiple undo may work sometimes, but result in false conflicts
-- other times. For example, if we have:
--   A B C 
--
-- And B conflicts with A, but neither conflicts with C. Then we can
-- undo B:
--
--  A B C ~B
--
-- Next we might try to undo A, but we can not, because it conflicts
-- with B. However, B has already been undone, so we should be able to
-- undo A as well.
simpleUndo :: Int -> History -> Maybe History
simpleUndo n (History operations) = 
    let remaining = L.drop n operations
    in
      case shift remaining of
        Nothing -> Nothing
        (Just (l, a')) -> Just (History (operations ++ [inverse a']))

-- shift the first element of the list to the end of the list
shift :: [Operation] -> Maybe ([Operation], Operation)
shift (a:b:r)
    | conflict a b = Nothing
    | otherwise =
        let (b', a') = transpose a b
        in
          case (shift $ a' : r) of
            Nothing -> Nothing
            (Just (l,a_inv)) -> Just (b' : l, a_inv)
shift [a] = Just ([a], a)
shift [] = Nothing

-- no conflict
simpleTest :: Maybe History
simpleTest =
    simpleUndo 0 (History [a, b, c])
    where
      a = Insert 0 "abcde"
      b = Insert 0 "dada"
      c = Delete 0 "d"

t1 = fmap renderDocument simpleTest

-- with conflict
simpleTest' :: Maybe History
simpleTest' =
    simpleUndo 0 (History [a, b, c])
    where
      a = Insert 0 "abcde"
      b = Insert 0 "dada"
      c = Delete 5 "a"

t2 = fmap renderDocument simpleTest'

-- Comprehensize Undo

{-

Similar to simple undo, we shift the operation we want to undo to the
end, then take it's inverse. However, when checking for conflicts, we
also check if the conflicting patch is later reversed.

In the paper, this is done by having a pointer to the undo patch which
is mutated when the patch is undone. We would prefer a method which
does not require mutation.

The paper also assumes we can identify patches by pointer
comparison. We do not want to do that either.

One solution to the second problem would be to create an id for each
history item (which could be useful in the UI as well). We would then
have the undoneBy field use the history item number instead of a pointer.

Instead of having a pointer we could maintain a separate assoc list of
actions which been undone.

Could we use a graph instead? 

let's undo c

a -> b -> c -> d -> e
     \ -> d' -> e'

then do f and redo c

a -> b -> c -> d -> e
     \ -> d' -> e' -> f

the graph stuff is not the same. if we undo and redo a patch several
times in a row, that is not recorded in the graph, but is in the list
form.

Hrm, seems like a sequence might be in order. Sequence supports fast
append, plus an update feature.



a -> b -> c -> d -> e
          \ -> d -> e -> ~c

For now, we can just be optimistic that the conflicted action was
later undone and communte the conflicted patch until it meets its
undoing. We can detect the undoing by inverted the patch and checking
for equality since, A ~A = id

-}