{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Main (main) where

import Control.Monad
import Data.String
import qualified Data.Text as T
import Data.Vector (Vector)
import qualified Data.Vector as V
import Myers.Diff
import Test.Hspec
import Test.Hspec.QuickCheck

-- Just for this test
instance IsString (Vector Char) where
  fromString = V.fromList

main :: IO ()
main = hspec spec

spec :: Spec
spec = do
  describe "getEditScript" $ do
    let exampleSpec :: Vector Char -> Vector Char -> Vector Edit -> Spec
        exampleSpec old new expected =
          it
            ( unwords
                [ "works for",
                  show old,
                  show new,
                  show expected
                ]
            )
            $ do
              let actual = getEditScript old new
              when (actual /= expected) $
                expectationFailure $
                  unlines
                    [ unwords ["actual:", show actual],
                      unwords ["expected:", show expected]
                    ]

    exampleSpec "" "" []
    exampleSpec "a" "a" []
    exampleSpec "a" "b" [Delete 0 1, Insert 1 0 1]
    exampleSpec "ab" "ac" [Delete 1 1, Insert 2 1 1]
    exampleSpec "b" "aba" [Insert 0 0 1, Insert 1 2 1]
    exampleSpec "abc" "acb" [Delete 1 1, Insert 3 2 1]
    exampleSpec "aaa" "aba" [Delete 0 1, Insert 2 1 1]
    exampleSpec "foofoo" "foo" [Delete 1 1, Delete 3 1, Delete 5 1]
    exampleSpec "foo" "foofoo" [Insert 1 1 1, Insert 2 3 1, Insert 3 5 1]

  describe "computeDiffFromEditScript" $ do
    let exampleSpec :: Vector Char -> Vector Char -> Vector Edit -> Vector (Diff Char) -> Spec
        exampleSpec old new editScript expected =
          it
            ( unwords
                [ "works for",
                  show old,
                  show new,
                  show editScript,
                  show expected
                ]
            )
            $ do
              let actual = computeDiffFromEditScript old new editScript
              when (actual /= expected) $
                expectationFailure $
                  unlines
                    [ unwords ["actual:", show actual],
                      unwords ["expected:", show expected]
                    ]

    exampleSpec "" "" [] []
    exampleSpec "a" "a" [] [Both 'a' 'a']
    exampleSpec "a" "b" [Delete 0 1, Insert 1 0 1] [First 'a', Second 'b']
    exampleSpec "ab" "ac" [Delete 1 1, Insert 2 1 1] [Both 'a' 'a', First 'b', Second 'c']
    exampleSpec "b" "aba" [Insert 0 0 1, Insert 1 2 1] [Second 'a', Both 'b' 'b', Second 'a']
    exampleSpec "abc" "acb" [Delete 1 1, Insert 3 2 1] [Both 'a' 'a', First 'b', Both 'c' 'c', Second 'b']
    exampleSpec "aaa" "aba" [Delete 0 1, Insert 2 1 1] [First 'a', Both 'a' 'a', Second 'b', Both 'a' 'a']
    exampleSpec "foofoo" "foo" [Delete 1 1, Delete 3 1, Delete 5 1] [Both 'f' 'f', First 'o', Both 'o' 'o', First 'f', Both 'o' 'o', First 'o']
    exampleSpec "foo" "foofoo" [Insert 1 1 1, Insert 2 3 1, Insert 3 5 1] [Both 'f' 'f', Second 'o', Both 'o' 'o', Second 'f', Both 'o' 'o', Second 'o']

  describe "getVectorDiff" $ do
    let exampleSpec :: Vector Char -> Vector Char -> Vector (Diff Char) -> Spec
        exampleSpec old new expected =
          it
            ( unwords
                [ "works for",
                  show old,
                  show new,
                  show expected
                ]
            )
            $ do
              let actual = getVectorDiff old new
              when (actual /= expected) $
                expectationFailure $
                  unlines
                    [ unwords ["actual:", show actual],
                      unwords ["expected:", show expected]
                    ]
    exampleSpec "" "" []
    exampleSpec "a" "a" [Both 'a' 'a']
    exampleSpec "a" "b" [First 'a', Second 'b']
    exampleSpec "ab" "ac" [Both 'a' 'a', First 'b', Second 'c']
    exampleSpec "aaa" "aba" [First 'a', Both 'a' 'a', Second 'b', Both 'a' 'a']
    exampleSpec "abgdef" "gh" [First 'a', First 'b', Both 'g' 'g', First 'd', First 'e', Second 'h', First 'f']
    exampleSpec "foofoo" "foo" [Both 'f' 'f', First 'o', Both 'o' 'o', First 'f', Both 'o' 'o', First 'o']

    prop "says that any list is entirely different from the empty list (left)" $ \ls ->
      let v = V.fromList (ls :: String)
       in getVectorDiff v "" `shouldBe` V.map First v

    prop "says that any list is entirely different from the empty list (right)" $ \ls ->
      let v = V.fromList (ls :: String)
       in getVectorDiff "" v `shouldBe` V.map Second v

    prop "does not find diffs in identical strings" $ \ls ->
      let v = V.fromList (ls :: String)
       in getVectorDiff v v `shouldBe` V.map (\a -> Both a a) v

    prop "only puts equal characters in 'Both'" $ \(ls1, ls2) ->
      let v1 = V.fromList (ls1 :: String)
          v2 = V.fromList (ls2 :: String)
          diff = getVectorDiff v1 v2
          valid = \case
            First _ -> True
            Second _ -> True
            Both a b -> a == b
       in all valid diff

    let rebuildFirst :: Vector (PolyDiff a b) -> Vector a
        rebuildFirst = V.mapMaybe $ \case
          First a -> Just a
          Second _ -> Nothing
          Both a _ -> Just a
    prop "lets you rebuild the old vector" $ \(ls1, ls2) -> do
      let v1 = V.fromList (ls1 :: String)
          v2 = V.fromList (ls2 :: String)
      rebuildFirst (getVectorDiff v1 v2) `shouldBe` v1

    let rebuildSecond :: Vector (PolyDiff a b) -> Vector b
        rebuildSecond = V.mapMaybe $ \case
          First _ -> Nothing
          Second b -> Just b
          Both _ b -> Just b
    prop "lets you rebuild the new vector" $ \(ls1, ls2) -> do
      let v1 = V.fromList (ls1 :: String)
          v2 = V.fromList (ls2 :: String)
      rebuildSecond (getVectorDiff v1 v2) `shouldBe` v2

    let unrollGroupedDiff :: Vector (PolyDiff (Vector a) (Vector b)) -> Vector (PolyDiff a b)
        unrollGroupedDiff = foldMap unrollPolyDiff

        -- Not performant, only for testing
        unrollPolyDiff :: PolyDiff (Vector a) (Vector b) -> Vector (PolyDiff a b)
        unrollPolyDiff = \case
          First va -> V.map First va
          Second vb -> V.map Second vb
          Both va vb -> V.zipWith Both va vb

    prop "is the same thing as getGroupedVectorDiff, but unrolled (unroll grouped)" $ \(ls1, ls2) ->
      let v1 = V.fromList (ls1 :: String)
          v2 = V.fromList (ls2 :: String)
          grouped = getGroupedVectorDiff v1 v2
          individual = getVectorDiff v1 v2
       in unrollGroupedDiff grouped `shouldBe` individual

  describe "getGroupedVectorDiff" $ do
    prop "says that any list is entirely different from the empty list (left)" $ \ls ->
      let v = V.fromList (ls :: String)
       in getGroupedVectorDiff v "" `shouldBe` (if V.null v then V.empty else V.singleton (First v))

    prop "says that any list is entirely different from the empty list (right)" $ \ls ->
      let v = V.fromList (ls :: String)
       in getGroupedVectorDiff "" v `shouldBe` (if V.null v then V.empty else V.singleton (Second v))

    prop "does not find diffs in identical strings" $ \ls ->
      let v = V.fromList (ls :: String)
       in getGroupedVectorDiff v v `shouldBe` (if V.null v then V.empty else V.singleton (Both v v))

    prop "only puts equal vectors in 'Both'" $ \(ls1, ls2) ->
      let v1 = V.fromList (ls1 :: String)
          v2 = V.fromList (ls2 :: String)
          diff = getGroupedVectorDiff v1 v2
          valid = \case
            First _ -> True
            Second _ -> True
            Both a b -> a == b
       in all valid diff

    let rebuildFirst :: Vector (PolyDiff (Vector a) (Vector b)) -> Vector a
        rebuildFirst =
          V.concat
            . V.toList
            . V.mapMaybe
              ( \case
                  First a -> Just a
                  Second _ -> Nothing
                  Both a _ -> Just a
              )
    prop "lets you rebuild the old vector" $ \(ls1, ls2) -> do
      let v1 = V.fromList (ls1 :: String)
          v2 = V.fromList (ls2 :: String)
      rebuildFirst (getGroupedVectorDiff v1 v2) `shouldBe` v1

    let rebuildSecond :: Vector (PolyDiff (Vector a) (Vector b)) -> Vector b
        rebuildSecond =
          V.concat
            . V.toList
            . V.mapMaybe
              ( \case
                  First _ -> Nothing
                  Second b -> Just b
                  Both _ b -> Just b
              )
    prop "lets you rebuild the new vector" $ \(ls1, ls2) -> do
      let v1 = V.fromList (ls1 :: String)
          v2 = V.fromList (ls2 :: String)
      rebuildSecond (getGroupedVectorDiff v1 v2) `shouldBe` v2

    -- Not performant, only for testing.
    let rollupUngroupedDiff :: Vector (PolyDiff a b) -> Vector (PolyDiff (Vector a) (Vector b))
        rollupUngroupedDiff = V.fromList . go . V.toList
          where
            go = \case
              [] -> []
              (d : ds) -> case d of
                First _ ->
                  let (fs, rest) = goFirsts (d : ds)
                   in First (V.fromList fs) : go rest
                Second _ ->
                  let (ss, rest) = goSeconds (d : ds)
                   in Second (V.fromList ss) : go rest
                Both _ _ ->
                  let (bs, rest) = goBoths (d : ds)
                   in Both (V.fromList (map fst bs)) (V.fromList (map snd bs)) : go rest
            goFirsts = \case
              (First a : ds) ->
                let (fs, rest) = goFirsts ds
                 in (a : fs, rest)
              rest -> ([], rest)
            goSeconds = \case
              (Second a : ds) ->
                let (fs, rest) = goSeconds ds
                 in (a : fs, rest)
              rest -> ([], rest)
            goBoths = \case
              (Both a b : ds) ->
                let (fs, rest) = goBoths ds
                 in ((a, b) : fs, rest)
              rest -> ([], rest)

    let squishGroupedDiff :: Vector (PolyDiff (Vector a) (Vector b)) -> Vector (PolyDiff (Vector a) (Vector b))
        squishGroupedDiff = V.fromList . go . V.toList
          where
            go = \case
              [] -> []
              [pd] -> [pd]
              (First a : First b : rest) -> go (First (a <> b) : rest)
              (Second a : Second b : rest) -> go (Second (a <> b) : rest)
              (Both a b : Both c d : rest) -> go (Both (a <> c) (b <> d) : rest)
              (d : rest) -> d : go rest
    prop "is the same thing as getVectorDiff, but rolled up and squished (rollup individual)" $ \(ls1, ls2) ->
      let v1 = V.fromList (ls1 :: String)
          v2 = V.fromList (ls2 :: String)
          grouped = getGroupedVectorDiff v1 v2
          individual = getVectorDiff v1 v2
       in squishGroupedDiff grouped `shouldBe` rollupUngroupedDiff individual

  describe "getStringDiff" $ do
    it "can output a large diff quickly enough if there is no diff" $
      let s = replicate 10000 'a'
       in length (getStringDiff s s) `shouldBe` 10000

    it "can output a large diff quickly enough if it's only diff" $
      length (getStringDiff (replicate 10000 'a') "b") `shouldBe` 10001

  describe "getTextDiff" $ do
    it "can output a large diff quickly enough if there is no diff" $
      let s = T.pack $ replicate 10000 'a'
       in length (getTextDiff s s) `shouldBe` 1

    it "can output a large diff quickly enough if it's only diff" $
      length (getTextDiff (T.pack (replicate 10000 'a')) "b") `shouldBe` 15