{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module List
  ( main
  )
where

import Prelude hiding (reverse, splitAt)

import Data.Foldable (find)
import Data.Function (on)
import qualified Data.List
import Data.Maybe (isNothing)
import Data.Monoid (Endo(..))
import Data.Proxy
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup((<>)))
#endif

import qualified Data.Sequence as Seq
import qualified Data.Vector as V
import Lens.Micro
import Test.QuickCheck

import Brick.Util (clamp)
import Brick.Widgets.List

instance (Arbitrary n, Arbitrary a) => Arbitrary (List n a) where
    arbitrary = list <$> arbitrary <*> (V.fromList <$> arbitrary) <*> pure 1

-- List move operations that never modify the underlying list
data ListMoveOp a =
    MoveUp
    | MoveDown
    | MoveBy Int
    | MoveTo Int
    | MoveToElement a
    | FindElement a
    deriving (Show)

instance Arbitrary a => Arbitrary (ListMoveOp a) where
    arbitrary =
        oneof [ pure MoveUp
              , pure MoveDown
              , MoveBy <$> arbitrary
              , MoveTo <$> arbitrary
              , MoveToElement <$> arbitrary
              , FindElement <$> arbitrary
              ]

-- List operations.  We don't have "page"-based movement operations
-- because these depend on render context (i.e. effect in EventM)
data ListOp a =
    Insert Int a
    | Remove Int
    | Replace Int [a]
    | Clear
    | Reverse
    | ListMoveOp (ListMoveOp a)
    deriving (Show)

instance Arbitrary a => Arbitrary (ListOp a) where
    arbitrary =
        frequency [ (1, Insert <$> arbitrary <*> arbitrary)
                  , (1, Remove <$> arbitrary)
                  , (1, Replace <$> arbitrary <*> arbitrary)
                  , (1, pure Clear)
                  , (1, pure Reverse)
                  , (6, arbitrary)
                  ]

-- Turn a ListOp into a List endomorphism
op :: Eq a => ListOp a -> List n a -> List n a
op (Insert i a) = listInsert i a
op (Remove i) = listRemove i
op (Replace i xs) =
    -- avoid setting index to Nothing
    listReplace (V.fromList xs) (Just i)
op Clear = listClear
op Reverse = listReverse
op (ListMoveOp mo) = moveOp mo

-- Turn a ListMoveOp into a List endomorphism
moveOp :: (Eq a) => ListMoveOp a -> List n a -> List n a
moveOp MoveUp = listMoveUp
moveOp MoveDown = listMoveDown
moveOp (MoveBy n) = listMoveBy n
moveOp (MoveTo n) = listMoveTo n
moveOp (MoveToElement a) = listMoveToElement a
moveOp (FindElement a) = listFindBy (== a)

applyListOps :: (Foldable t)
             => (op a -> List n a -> List n a)
             -> t (op a)
             -> List n a
             -> List n a
applyListOps f = appEndo . foldMap (Endo . f)

-- | Initial selection is always 0 (or Nothing for empty list)
prop_initialSelection :: [a] -> Bool
prop_initialSelection xs =
    list () (V.fromList xs) 1 ^. listSelectedL ==
        if null xs then Nothing else Just 0

-- list operations keep the selected index in bounds
prop_listOpsMaintainSelectedValid :: (Eq a)
                                  => [ListOp a]
                                  -> List n a
                                  -> Bool
prop_listOpsMaintainSelectedValid ops l =
    let l' = applyListOps op ops l
    in case l' ^. listSelectedL of
        -- either there is no selection and list is empty
        Nothing -> null l'
        -- or the selected index is valid
        Just i -> i >= 0 && i < length l'

-- reversing a list keeps the selected element the same
prop_reverseMaintainsSelectedElement :: (Eq a)
                                     => [ListOp a]
                                     -> List n a
                                     -> Bool
prop_reverseMaintainsSelectedElement ops l =
    -- apply some random list ops to (probably) set a selected element
    let l' = applyListOps op ops l
        l'' = listReverse l'
    in fmap snd (listSelectedElement l') == fmap snd (listSelectedElement l'')

-- reversing maintains size of list
prop_reverseMaintainsSizeOfList :: List n a -> Bool
prop_reverseMaintainsSizeOfList l =
    length l == length (listReverse l)

-- an inserted element may always be found at the given index
-- (when target index is clamped to 0 <= n <= len)
prop_insert :: (Eq a) => Int -> a -> List n a -> Bool
prop_insert i a l =
    let l' = listInsert i a l
        i' = clamp 0 (length l) i
    in listSelectedElement (listMoveTo i' l') == Just (i', a)

-- inserting anywhere always increases size of list by 1
prop_insertSize :: (Eq a) => Int -> a -> List n a -> Bool
prop_insertSize i a l =
    let l' = listInsert i a l
    in length l' == length l + 1

-- inserting an element and moving to it always succeeds and
-- the selected element is the one we inserted.
--
-- The index is not necessarily the index we inserted at, because
-- the element could be present in the original list.  So we don't
-- check that.
--
prop_insertMoveTo :: (Eq a) => [ListOp a] -> List n a -> Int -> a -> Bool
prop_insertMoveTo ops l i a =
    let l' = listInsert i a (applyListOps op ops l)
        sel = listSelectedElement (listMoveToElement a l')
    in fmap snd sel == Just a

-- inserting an element and repeatedly seeking it always
-- reaches the element we inserted, at the index where we
-- inserted it.
--
prop_insertFindBy :: (Eq a) => [ListOp a] -> List n a -> Int -> a -> Bool
prop_insertFindBy ops l i a =
    let l' = applyListOps op ops l
        l'' = set listSelectedL Nothing . listInsert i a $ l'
        seeks = converging ((==) `on` (^. listSelectedL)) (listFindBy (== a)) l''
        i' = clamp 0 (length l') i -- we can't have inserted past len
    in (find ((== Just i') . (^. listSelectedL)) seeks >>= listSelectedElement) == Just (i', a)

-- inserting then deleting always yields a list with the original elems
prop_insertRemove :: (Eq a) => Int -> a -> List n a -> Bool
prop_insertRemove i a l =
    let i' = clamp 0 (length l) i
        l' = listInsert i' a l -- pre-clamped
        l'' = listRemove i' l'
    in l'' ^. listElementsL == l ^. listElementsL

-- deleting in-bounds always reduces size of list by 1
-- deleting out-of-bounds never changes list size
prop_remove :: Int -> List n a -> Bool
prop_remove i l =
    let len = length l
        i' = clamp 0 (len - 1) i
        test
            | len > 0 && i == i' = (== len - 1)  -- i is in bounds
            | otherwise = (== len)               -- i is out of bounds
    in test (length (listRemove i l))

-- deleting an element and re-inserting it at same position
-- gives the original list elements
prop_removeInsert :: (Eq a) => Int -> List n a -> Bool
prop_removeInsert i l =
    let sel = listSelectedElement (listMoveTo i l)
        l' = maybe id (\(i', a) -> listInsert i' a . listRemove i') sel l
    in l' ^. listElementsL == l ^. listElementsL

-- Apply @f@ until @test a (f a) == True@, then return @a@.
converge :: (a -> a -> Bool) -> (a -> a) -> a -> a
converge test f = last . converging test f

-- Apply @f@ until @test a (f a) == True@, returning the start,
-- intermediate and final values as a list.
converging :: (a -> a -> Bool) -> (a -> a) -> a -> [a]
converging test f a
    | test a (f a) = [a]
    | otherwise = a : converging test f (f a)

-- listMoveUp always reaches 0 (or list is empty)
prop_moveUp :: (Eq a) => [ListOp a] -> List n a -> Bool
prop_moveUp ops l =
    let l' = applyListOps op ops l
        l'' = converge ((==) `on` (^. listSelectedL)) listMoveUp l'
        len = length l''
    in maybe (len == 0) (== 0) (l'' ^. listSelectedL)

-- listMoveDown always reaches end of list (or list is empty)
prop_moveDown :: (Eq a) => [ListOp a] -> List n a -> Bool
prop_moveDown ops l =
    let l' = applyListOps op ops l
        l'' = converge ((==) `on` (^. listSelectedL)) listMoveDown l'
        len = length l''
    in maybe (len == 0) (== len - 1) (l'' ^. listSelectedL)

-- move ops never change the list
prop_moveOpsNeverChangeList :: (Eq a) => [ListMoveOp a] -> List n a -> Bool
prop_moveOpsNeverChangeList ops l =
    let l' = applyListOps moveOp ops l
    in l' ^. listElementsL == l ^. listElementsL

-- If the list is empty, empty selection is used.
-- Otherwise, if the specified selected index is not in list bounds,
-- zero is used instead.
prop_replaceSetIndex :: (Eq a)
                     => [ListOp a]
                     -> List n a
                     -> [a]
                     -> Int
                     -> Bool
prop_replaceSetIndex ops l xs i =
    let v = V.fromList xs
        l' = applyListOps op ops l
        l'' = listReplace v (Just i) l'
        i' = clamp 0 (length v - 1) i
        inBounds = i == i'
    in l'' ^. listSelectedL == case (null v, inBounds) of
        (True, _) -> Nothing
        (False, True) -> Just i
        (False, False) -> Just 0

-- Replacing with no index always clears the index
prop_replaceNoIndex :: (Eq a) => [ListOp a] -> List n a -> [a] -> Bool
prop_replaceNoIndex ops l xs =
    let v = V.fromList xs
        l' = applyListOps op ops l
    in isNothing (listReplace v Nothing l' ^. listSelectedL)

-- | Move the list selected index. If the index is `Just x`, adjust by the
-- specified amount; if it is `Nothing` (i.e. there is no selection) and the
-- direction is positive, set to `Just 0` (first element), otherwise set to
-- `Just (length - 1)` (last element). Subject to validation.
prop_moveByWhenNoSelection :: List n a -> Int -> Property
prop_moveByWhenNoSelection l amt =
    let l' = l & listSelectedL .~ Nothing
        len = length l
        expected = if amt > 0 then 0 else len - 1
    in len > 0 ==> listMoveBy amt l' ^. listSelectedL == Just expected

splitAtLength :: (Foldable t, Splittable t) => t a -> Int -> Bool
splitAtLength l i =
    let len = length l
        (h, t) = splitAt i l
    in length h + length t == len && length h == clamp 0 len i

splitAtAppend :: (Splittable t, Semigroup (t a), Eq (t a))
              => t a -> Int -> Bool
splitAtAppend l i = uncurry (<>) (splitAt i l) == l

prop_splitAtLength_Vector :: [a] -> Int -> Bool
prop_splitAtLength_Vector = splitAtLength . V.fromList

prop_splitAtAppend_Vector :: (Eq a) => [a] -> Int -> Bool
prop_splitAtAppend_Vector = splitAtAppend . V.fromList

prop_splitAtLength_Seq :: [a] -> Int -> Bool
prop_splitAtLength_Seq = splitAtLength . Seq.fromList

prop_splitAtAppend_Seq :: (Eq a) => [a] -> Int -> Bool
prop_splitAtAppend_Seq = splitAtAppend . Seq.fromList


reverseSingleton :: forall t a. (Reversible t, Applicative t, Eq (t a))
                 => Proxy t -> a -> Bool
reverseSingleton _ a =
    let l = pure a :: t a
    in reverse l == l

reverseAppend :: (Reversible t, Semigroup (t a), Eq (t a))
              => t a -> t a -> Bool
reverseAppend l1 l2 =
  reverse (l1 <> l2) == reverse l2 <> reverse l1

prop_reverseSingleton_Vector :: (Eq a) => a -> Bool
prop_reverseSingleton_Vector = reverseSingleton (Proxy :: Proxy V.Vector)

prop_reverseAppend_Vector :: (Eq a) => [a] -> [a] -> Bool
prop_reverseAppend_Vector l1 l2 =
    reverseAppend (V.fromList l1) (V.fromList l2)

prop_reverseSingleton_Seq :: (Eq a) => a -> Bool
prop_reverseSingleton_Seq = reverseSingleton (Proxy :: Proxy Seq.Seq)

prop_reverseAppend_Seq :: (Eq a) => [a] -> [a] -> Bool
prop_reverseAppend_Seq l1 l2 =
    reverseAppend (Seq.fromList l1) (Seq.fromList l2)

-- Laziness tests.  Here we create a custom container type
-- that we use to ensure certain operations do not cause the
-- whole container to be evaluated.
--
newtype L a = L [a]
            deriving (Functor, Foldable, Traversable, Semigroup)

instance Splittable L where
    splitAt i (L xs) = over both L (Data.List.splitAt i xs)

-- moveBy positive amount does not evaluate 'length'
prop_moveByPosLazy :: Bool
prop_moveByPosLazy =
    let v = L (1:2:3:4:undefined) :: L Int
        l = list () v 1
        l' = listMoveBy 1 l
    in l' ^. listSelectedL == Just 1

-- listFindBy is lazy
prop_findByLazy :: Bool
prop_findByLazy =
    let v = L (1:2:3:4:undefined) :: L Int
        l = list () v 1 & listSelectedL .~ Nothing
        l' = listFindBy even l
        l'' = listFindBy even l'
    in l' ^. listSelectedL == Just 1 &&
       l'' ^. listSelectedL == Just 3

prop_listFindFirst :: Bool
prop_listFindFirst =
    let v = L [1..5] :: L Int
        l = list () v 1
        result1 = listFindFirst even l
        result2 = listFindFirst (> 10) l
    in result1 == Just (1, 2) &&
       result2 == Nothing

prop_listSelectedElement_lazy :: Bool
prop_listSelectedElement_lazy =
    let v = L (1:2:3:4:undefined) :: L Int
        l = list () v 1 & listSelectedL .~ Just 3
    in listSelectedElement l == Just (3, 4)

prop_listSelectedElementL_lazy :: Bool
prop_listSelectedElementL_lazy =
    let v = L (1:2:3:4:undefined) :: L Int
        l = list () v 1 & listSelectedL .~ Just 3
    in over listSelectedElementL (*2) l ^? listSelectedElementL == Just 8

return []

main :: IO Bool
main = $quickCheckAll