--  Copyright (C) 2002-2005,2007 David Roundy
--
--  This program is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2, or (at your option)
--  any later version.
--
--  This program is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with this program; see the file COPYING.  If not, write to
--  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
--  Boston, MA 02110-1301, USA.

module Darcs.Test.Patch.Examples.Set1
       ( knownCommutes, knownCantCommutes, knownMerges
       , knownMergeEquivs, knownCanons, mergePairs2
       , validPatches, commutePairs, mergePairs
       , primitiveTestPatches, testPatches, testPatchesNamed
       , primitiveCommutePairs ) where

import Prelude ()
import Darcs.Prelude
import System.IO.Unsafe ( unsafePerformIO )
import qualified Data.ByteString.Char8 as BC ( pack )
import qualified Data.ByteString as B ( empty )
import Darcs.Patch
     ( commute, invert, merge
     , Named, namepatch
     , readPatch, fromPrim
     , adddir, addfile, hunk, binary, rmdir, rmfile, tokreplace )
import Darcs.Patch.Prim ( PrimOf, FromPrim )
import qualified Darcs.Patch.V1 as V1 ( RepoPatchV1 )
import qualified Darcs.Patch.V1.Prim as V1 ( Prim(..) )
import Darcs.Test.Patch.Properties.Check( checkAPatch )
import Darcs.Patch.Witnesses.Ordered
import Darcs.Patch.Witnesses.Sealed ( unsafeUnseal )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP, unsafeCoercePEnd )

type Patch = V1.RepoPatchV1 V1.Prim

-- The unit tester function is really just a glorified map for functions that
-- return lists, in which the lists get concatenated (where map would end up
-- with a list of lists).

quickmerge :: (FL Patch :\/: FL Patch) wX wY -> FL Patch wY wZ
quickmerge (p1:\/:p2) = case merge (p1:\/:p2) of
                        _ :/\: p1' -> unsafeCoercePEnd p1'

-- ----------------------------------------------------------------------
-- * Show/Read tests
-- ----------------------------------------------------------------------

-- | This test involves calling 'show' to print a string describing a patch,
--   and then using readPatch to read it back in, and making sure the patch we
--   read in is the same as the original.  Useful for making sure that I don't
--   have any stupid IO bugs.

-- ----------------------------------------------------------------------
-- * Canonization tests
-- ----------------------------------------------------------------------

knownCanons :: [(FL Patch wX wY,FL Patch wX wY)]
knownCanons =
    [(quickhunk 1 "abcde" "ab" :>: NilFL, quickhunk 3 "cde"   "" :>: NilFL),
     (quickhunk 1 "abcde" "bd" :>: NilFL,
      quickhunk 1 "a" "" :>:
      quickhunk 2 "c" "" :>:
      quickhunk 3 "e" "" :>: NilFL),
     (quickhunk 4 "a" "b" :>:
      quickhunk 1 "c" "d" :>: NilFL,
      quickhunk 1 "c" "d" :>:
      quickhunk 4 "a" "b" :>: NilFL),
     (quickhunk 1 "a" "" :>:
      quickhunk 1 "" "b" :>: NilFL,
      quickhunk 1 "a" "b" :>: NilFL),
     (quickhunk 1 "ab" "c" :>:
      quickhunk 1 "cd" "e" :>: NilFL,
      quickhunk 1 "abd" "e" :>: NilFL),
     (quickhunk 1 "abcde" "cde" :>: NilFL, quickhunk 1 "ab" "" :>: NilFL),
     (quickhunk 1 "abcde" "acde" :>: NilFL, quickhunk 2 "b" "" :>: NilFL)]

quickhunk :: (FromPrim p, PrimOf p ~ V1.Prim) => Int -> String -> String -> p wX wY
quickhunk l o n = fromPrim $ hunk "test" l (map (\c -> BC.pack [c]) o)
                                             (map (\c -> BC.pack [c]) n)

-- ----------------------------------------------------------------------
-- * Merge/unmgerge tests
-- ----------------------------------------------------------------------

-- | It should always be true that if two patches can be unmerged, then merging
--   the resulting patches should give them back again.
mergePairs :: [(FL Patch :\/: FL Patch) wX wY]
mergePairs =
  take 400 [(p1:\/:p2)|
            i <- [0..(length testPatches)-1],
            p1<-[testPatches!!i],
            p2<-drop i testPatches,
            checkAPatch (invert p2 :>: p1 :>: NilFL)]

-- ----------------------------------------------------------------------
-- * Commute/recommute tests
-- ----------------------------------------------------------------------

-- | Here we test to see if commuting patch A and patch B and then commuting
-- the result gives us patch A and patch B again.  The set of patches (A,B)
-- is chosen from the set of all pairs of test patches by selecting those which
-- commute with one another.
commutePairs :: [(FL Patch :> FL Patch) wX wY]
commutePairs =
  take 200 [(p1:>p2)|
            p1<-testPatches,
            p2<-filter (\p->checkAPatch (p1:>:p:>:NilFL)) testPatches,
            commute (p1:>p2) /= Nothing]

primitiveCommutePairs :: [(FL Patch :> FL Patch) wX wY]
primitiveCommutePairs =
  [(p2:>p1)|
   p1<-primitiveTestPatches,
   p2<-primitiveTestPatches,
   commute (p2:>p1) /= Nothing,
   checkAPatch (p2:>:p1:>:NilFL)]

-- ----------------------------------------------------------------------
-- * Commute tests
-- ----------------------------------------------------------------------

-- | Here we provide a set of known interesting commutes.
knownCommutes :: [((FL Patch :> FL Patch) wX wY,(FL Patch :> FL Patch) wX wY)]
knownCommutes = [
                  (testhunk 2 [] ["B"]:>
                   testhunk 1 [] ["A"],
                   testhunk 1 [] ["A"]:>
                   testhunk 3 [] ["B"]),
                  (testhunk 2
                   ["hello world all that is old is good old_"]
                   ["I don't like old things"]:>
                   fromPrim (tokreplace "test" "A-Za-z_" "old" "new"),
                   fromPrim (tokreplace "test" "A-Za-z_" "old" "new"):>
                   testhunk 2
                   ["hello world all that is new is good old_"]
                   ["I don't like new things"]),
                  (testhunk 2 ["C"] ["D"]:>
                   testhunk 1 ["A"] ["B"],
                   testhunk 1 ["A"] ["B"]:>
                   testhunk 2 ["C"] ["D"]),
                  ((quickmerge (fromPrim (addfile "hello"):\/:fromPrim (addfile "hello"))):>
                   fromPrim (rmfile "NwNSO"),
                   fromPrim (rmfile "NwNSO"):>
                   (quickmerge (fromPrim (addfile "hello"):\/:fromPrim (addfile "hello")))),

                  (testhunk 1 [] ["a"]:>
                   quickmerge (testhunk 3 ["o"] ["n"]:\/:
                               testhunk 3 ["o"] ["v"]),
                   quickmerge (testhunk 2 ["o"] ["n"]:\/:
                               testhunk 2 ["o"] ["v"]):>
                   testhunk 1 [] ["a"]),

                  (testhunk 3 ["B"] []:>
                   testhunk 1 ["A"] [],
                   testhunk 1 ["A"] []:>
                   testhunk 2 ["B"] []),

                  (testhunk 2 ["B"] ["C"]:>
                   testhunk 1 ["A"] ["B"],
                   testhunk 1 ["A"] ["B"]:>
                   testhunk 2 ["B"] ["C"]),

                  (testhunk 3 ["B"] ["C"]:>
                   testhunk 1 ["A"] ["B"],
                   testhunk 1 ["A"] ["B"]:>
                   testhunk 3 ["B"] ["C"]),

                  (testhunk 2 ["B"] ["C","D"]:>
                   testhunk 1 ["A"] ["B","C"],
                   testhunk 1 ["A"] ["B","C"]:>
                   testhunk 3 ["B"] ["C","D"])]
  where testhunk l o n = fromPrim $ hunk "test" l (map BC.pack o) (map BC.pack n)

knownCantCommutes :: [(FL Patch :> FL Patch) wX wY]
knownCantCommutes = [
                      (testhunk 1 [] ["A"]:>
                       testhunk 2 ["o"] ["n"]),
                      (testhunk 1 ["o"] ["n"]:>
                       testhunk 1 [] ["A"]),
                      (testhunk 1 [] ["a"]:>
                       quickmerge (testhunk 2 ["o"] ["n"]:\/:
                                   testhunk 2 ["o"] ["v"])),
                      (fromPrim (addfile "test"):>
                       fromPrim (hunk "test" 1 ([BC.pack "a"]) ([BC.pack "b"])))]
  where testhunk l o n = fromPrim $ hunk "test" l (map BC.pack o) (map BC.pack n)

-- ----------------------------------------------------------------------
-- * Merge tests
-- ----------------------------------------------------------------------

-- | Here we provide a set of known interesting merges.
knownMerges :: [((FL Patch:\/:FL Patch) wX wY,FL Patch wY wZ)]
knownMerges = [
                (testhunk 2 [BC.pack "c"] [BC.pack "d",BC.pack "e"]:\/:
                 testhunk 1 [BC.pack "x"] [BC.pack "a",BC.pack "b"],
                 testhunk 3 [BC.pack "c"] [BC.pack "d",BC.pack "e"]),
                (testhunk 1 [BC.pack "x"] [BC.pack "a",BC.pack "b"]:\/:
                 testhunk 2 [BC.pack "c"] [BC.pack "d",BC.pack "e"],
                 testhunk 1 [BC.pack "x"] [BC.pack "a",BC.pack "b"]),
                (testhunk 3 [BC.pack "A"] []:\/:
                 testhunk 1 [BC.pack "B"] [],
                 testhunk 2 [BC.pack "A"] []),
                (fromPrim (rmdir "./test/world"):\/:
                 fromPrim (hunk "./world" 3 [BC.pack "A"] []),
                 fromPrim (rmdir "./test/world")),

                ((quickhunk 1 "a" "bc" :>:
                  quickhunk 6 "d" "ef" :>: NilFL):\/:
                 (quickhunk 3 "a" "bc" :>:
                  quickhunk 8 "d" "ef" :>: NilFL),
                 (quickhunk 1 "a" "bc" :>:
                  quickhunk 7 "d" "ef" :>: NilFL)),

                (testhunk 1 [BC.pack "A"] [BC.pack "B"]:\/:
                 testhunk 2 [BC.pack "B"] [BC.pack "C"],
                 testhunk 1 [BC.pack "A"] [BC.pack "B"]),

                (testhunk 2 [BC.pack "A"] [BC.pack "B",BC.pack "C"]:\/:
                 testhunk 1 [BC.pack "B"] [BC.pack "C",BC.pack "D"],
                 testhunk 3 [BC.pack "A"] [BC.pack "B",BC.pack "C"])]
  where testhunk l o n = fromPrim $ hunk "test" l o n

knownMergeEquivs :: [((FL Patch :\/: FL Patch) wX wY, FL Patch wY wZ)]
knownMergeEquivs = [

                     -- The following tests are going to be failed by the
                     -- Conflictor code as a cleanup.

                     --(addfile "test":\/:
                     -- adddir "test",
                     -- joinPatches (adddir "test" :>:
                     --              addfile "test-conflict" :>: NilFL)),
                     --(move "silly" "test":\/:
                     -- adddir "test",
                     -- joinPatches (adddir "test" :>:
                     --              move "silly" "test-conflict" :>: NilFL)),
                     --(addfile "test":\/:
                     -- move "old" "test",
                     -- joinPatches (addfile "test" :>:
                     --              move "old" "test-conflict" :>: NilFL)),
                     --(move "a" "test":\/:
                     -- move "old" "test",
                     -- joinPatches (move "a" "test" :>:
                     --              move "old" "test-conflict" :>: NilFL)),
                     (fromPrim (hunk "test" 1 [] [BC.pack "A"]) :\/:
                       fromPrim (hunk "test" 1 [] [BC.pack "B"]),
                       fromPrim (hunk "test" 1 [] [BC.pack "A", BC.pack "B"])),
                     (fromPrim (hunk "test" 1 [] [BC.pack "a"]):\/:
                      fromPrim (hunk "test" 1 [BC.pack "b"] []),
                      unsafeCoerceP NilFL),
                      --hunk "test" 1 [] [BC.pack "v v v v v v v",
                      --                  BC.pack "*************",
                      --                  BC.pack "a",
                      --                  BC.pack "b",
                      --                  BC.pack "^ ^ ^ ^ ^ ^ ^"]),
                     (quickhunk 4 "a"  "" :\/:
                      quickhunk 3 "a"  "",
                      quickhunk 3 "aa" ""),
                     ((quickhunk 1 "a" "bc" :>:
                       quickhunk 6 "d" "ef" :>: NilFL) :\/:
                       (quickhunk 3 "a" "bc" :>:
                        quickhunk 8 "d" "ef" :>: NilFL),
                      quickhunk 3 "a" "bc" :>:
                      quickhunk 8 "d" "ef" :>:
                      quickhunk 1 "a" "bc" :>:
                      quickhunk 7 "d" "ef" :>: NilFL),
                     (quickmerge (quickhunk 2 "" "bd":\/:quickhunk 2 "" "a") :\/:
                              quickmerge (quickhunk 2 "" "c":\/:quickhunk 2 "" "a"),
                              quickhunk 2 "" "abdc")
                     ]


-- | It also is useful to verify that it doesn't matter which order we specify
--   the patches when we merge.
mergePairs2 :: [(FL Patch wX wY, FL Patch wX wZ)]
mergePairs2 = [(p1, p2) |
               p1<-primitiveTestPatches,
               p2<-primitiveTestPatches,
               checkAPatch (invert p1:>:p2:>:NilFL)
              ]

-- ----------------------------------------------------------------------
-- Patch test data
-- This is where we define the set of patches which we run our tests on.  This
-- should be kept up to date with as many interesting permutations of patch
-- types as possible.
-- ----------------------------------------------------------------------

testPatches :: [FL Patch wX wY]
testPatchesNamed :: [Named Patch wX wY]
testPatchesAddfile :: [FL Patch wX wY]
testPatchesRmfile :: [FL Patch wX wY]
testPatchesHunk :: [FL Patch wX wY]
primitiveTestPatches :: [FL Patch wX wY]
testPatchesBinary :: [FL Patch wX wY]
testPatchesCompositeNocom :: [FL Patch wX wY]
testPatchesComposite :: [FL Patch wX wY]
testPatchesTwoCompositeHunks :: [FL Patch wX wY]
testPatchesCompositeHunks :: [FL Patch wX wY]
testPatchesCompositeFourHunks :: [FL Patch wX wY]
testPatchesMerged :: [FL Patch wX wY]
validPatches :: [FL Patch wX wY]

testPatchesNamed = [unsafePerformIO $
                      namepatch "date is" "patch name" "David Roundy" []
                                (fromPrim $ addfile "test"),
                      unsafePerformIO $
                      namepatch "Sat Oct 19 08:31:13 EDT 2002"
                                "This is another patch" "David Roundy"
                                ["This log file has","two lines in it"]
                                (fromPrim $ rmfile "test")]
testPatchesAddfile = map fromPrim
                       [addfile "test",adddir "test",addfile "test/test"]
testPatchesRmfile = map invert testPatchesAddfile
testPatchesHunk  =
    [fromPrim (hunk file line old new) |
     file <- ["test"],
     line <- [1,2],
     old <- map (map BC.pack) partials,
     new <- map (map BC.pack) partials,
     old /= new
    ]
    where partials  = [["A"],["B"],[],["B","B2"]]

primitiveTestPatches = testPatchesAddfile ++
                         testPatchesRmfile ++
                         testPatchesHunk ++
                         [unsafeUnseal.fromJust.readPatch $
                          BC.pack "move ./test/test ./hello",
                          unsafeUnseal.fromJust.readPatch $
                          BC.pack "move ./test ./hello"] ++
                         testPatchesBinary

testPatchesBinary =
    [fromPrim $ binary "./hello"
     (BC.pack $ "agadshhdhdsa75745457574asdgg" ++
      "a326424677373735753246463gadshhdhdsaasdgg" ++
      "a326424677373735753246463gadshhdhdsaasdgg" ++
      "a326424677373735753246463gadshhdhdsaasdgg")
     (BC.pack $ "adafjttkykrehhtrththrthrthre" ++
      "a326424677373735753246463gadshhdhdsaasdgg" ++
      "a326424677373735753246463gadshhdhdsaasdgg" ++
      "a326424677373735753246463gadshhdhdsaagg"),
     fromPrim $ binary "./hello"
     B.empty
     (BC.pack "adafjttkykrere")]

testPatchesCompositeNocom =
    take 50 [p1+>+p2|
             p1<-primitiveTestPatches,
             p2<-filter (\p->checkAPatch (p1:>:p:>:NilFL)) primitiveTestPatches,
             commute (p1:>p2) == Nothing]

testPatchesComposite =
    take 100 [p1+>+p2|
              p1<-primitiveTestPatches,
              p2<-filter (\p->checkAPatch (p1:>:p:>:NilFL)) primitiveTestPatches,
              commute (p1:>p2) /= Nothing,
              commute (p1:>p2) /= Just (unsafeCoerceP p2:>unsafeCoerceP p1)]

testPatchesTwoCompositeHunks =
    take 100 [p1+>+p2|
              p1<-testPatchesHunk,
              p2<-filter (\p->checkAPatch (p1:>:p:>:NilFL)) testPatchesHunk]

testPatchesCompositeHunks =
    take 100 [p1+>+p2+>+p3|
              p1<-testPatchesHunk,
              p2<-filter (\p->checkAPatch (p1:>:p:>:NilFL)) testPatchesHunk,
              p3<-filter (\p->checkAPatch (p1:>:p2:>:p:>:NilFL)) testPatchesHunk]

testPatchesCompositeFourHunks =
    take 100 [p1+>+p2+>+p3+>+p4|
              p1<-testPatchesHunk,
              p2<-filter (\p->checkAPatch (p1:>:p:>:NilFL)) testPatchesHunk,
              p3<-filter (\p->checkAPatch (p1:>:p2:>:p:>:NilFL)) testPatchesHunk,
              p4<-filter (\p->checkAPatch (p1:>:p2:>:p3:>:p:>:NilFL)) testPatchesHunk]

testPatchesMerged =
  take 200
    [p2+>+quickmerge (p1:\/:p2) |
     p1<-take 10 (drop 15 testPatchesCompositeHunks)++primitiveTestPatches
         ++take 10 (drop 15 testPatchesTwoCompositeHunks)
         ++ take 2 (drop 4 testPatchesCompositeFourHunks),
     p2<-take 10 testPatchesCompositeHunks++primitiveTestPatches
         ++take 10 testPatchesTwoCompositeHunks
         ++take 2 testPatchesCompositeFourHunks,
     checkAPatch (invert p1 :>: p2 :>: NilFL),
     commute (p2:>p1) /= Just (p1:>p2)
    ]

testPatches =  primitiveTestPatches ++
                testPatchesComposite ++
                testPatchesCompositeNocom ++
                testPatchesMerged

-- ----------------------------------------------------------------------
-- * Check patch test
-- ----------------------------------------------------------------------

validPatches = [(quickhunk 4 "a" "b" :>:
                 quickhunk 1 "c" "d" :>: NilFL),
                (quickhunk 1 "a" "bc" :>:
                 quickhunk 1 "b" "d" :>: NilFL),
                (quickhunk 1 "a" "b" :>:
                 quickhunk 1 "b" "d" :>: NilFL)]++testPatches
