-----------------------------------------------------------------------------
-- |
-- Copyright   :  (C) 2020 Peter Lu
-- License     :  see the file LICENSE
--
-- Maintainer  :  pdlla <chippermonky@gmail.com>
-- Stability   :  experimental
--
-- A dynamic seq which are a set of input and output events that wrap an
-- internal 'Dynamic (Seq a)'.
----------------------------------------------------------------------------
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo     #-}

module Reflex.Data.Sequence
  ( DynamicSeq(..)
  , DynamicSeqConfig(..)
  , defaultDynamicSeqConfig
  , dynamicSeq_attachEndPos
  , holdDynamicSeq
  )
where

import           Relude                hiding (empty, splitAt)

import           Reflex
import           Reflex.Potato.Helpers

import           Control.Monad.Fix

import           Data.Sequence         as Seq
import           Data.Wedge


data DynamicSeq t a = DynamicSeq {
  -- | index and sub sequence that was just added
  _dynamicSeq_inserted   :: Event t (Int, Seq a)
  -- | original index of removed sub sequence and removed subsequence
  , _dynamicSeq_removed  :: Event t (Int, Seq a)
  -- TODO
  -- though you can probably do this by adding + removing with runWithReplace
  --, _dynamicSeq_moved     :: Event t (Int, a)
  -- | internal state of contents
  , _dynamicSeq_contents :: Dynamic t (Seq a)
}

-- | The interface only supports adding and removing several consecutive
-- elements. Use with 'singleton x' to add single elements.
data DynamicSeqConfig t a = DynamicSeqConfig {
  -- | index and sub sequence to add
  _dynamicSeqConfig_insert   :: Event t (Int, Seq a)
  -- | index and number of elements to remove
  , _dynamicSeqConfig_remove :: Event t (Int, Int)
  -- | same as removing all elts
  , _dynamicSeqConfig_clear  :: Event t ()

  -- TODO
  --, _dynamicSeqConfig_move    :: Event t (Int,Int)
}

defaultDynamicSeqConfig :: (Reflex t) => DynamicSeqConfig t a
defaultDynamicSeqConfig = DynamicSeqConfig { _dynamicSeqConfig_insert = never
                                           , _dynamicSeqConfig_remove = never
                                           , _dynamicSeqConfig_clear  = never
                                           }


-- | use for inserting at end of seq
dynamicSeq_attachEndPos
  :: (Reflex t) => DynamicSeq t a -> Event t b -> Event t (Int, b)
dynamicSeq_attachEndPos DynamicSeq {..} =
  attach (Seq.length <$> current _dynamicSeq_contents)


type DSState a = (Wedge (Int, Seq a) (Int, Seq a), Seq a)
data DSCmd t a = DSCAdd (Int, Seq a) | DSCRemove (Int, Int) | DSCClear

-- | create a dynamic list
holdDynamicSeq
  :: forall t m a
   . (Reflex t, MonadHold t m, MonadFix m)
  => Seq a
  -> DynamicSeqConfig t a
  -> m (DynamicSeq t a)
holdDynamicSeq initial DynamicSeqConfig {..} = mdo
  let changeEvent :: Event t (DSCmd t a)
      changeEvent = leftmostwarn
        "WARNING: multiple Seq events firing at once"
        [ fmap DSCAdd           _dynamicSeqConfig_insert
        , fmap DSCRemove        _dynamicSeqConfig_remove
        , fmap (const DSCClear) _dynamicSeqConfig_clear
        ]

      -- Wedge values:
      -- Here is elements that was just added fromSeq
      -- There is elements that was just removed from Seq
      -- Nowhere is everything else
      foldfn :: (DSCmd t a) -> DSState a -> PushM t (DSState a)
      foldfn (DSCAdd (i, ys)) (_, xs) = return (Here (i, ys), newSeq)       where
        (l, r) = splitAt i xs
        newSeq = l >< ys >< r
      foldfn (DSCRemove (i, n)) (_, xs) = return (There (i, removed), newSeq)       where
        (keepl  , rs   ) = splitAt i xs
        (removed, keepr) = splitAt n rs
        newSeq           = keepl >< keepr
      foldfn DSCClear (_, xs) = return (There (0, xs), empty)

  asdyn :: Dynamic t (DSState a) <- foldDynM foldfn
                                             (Nowhere, initial)
                                             changeEvent

  return $ DynamicSeq
    { _dynamicSeq_inserted = fmapMaybe (getHere . fst) $ updated asdyn
    , _dynamicSeq_removed  = fmapMaybe (getThere . fst) $ updated asdyn
    , _dynamicSeq_contents = snd <$> asdyn
    }