-----------------------------------------------------------------------------
-- |
-- Copyright   :  (C) 2020 Peter Lu
-- License     :  see the file LICENSE
--
-- Maintainer  :  pdlla <chippermonky@gmail.com>
-- Stability   :  experimental
--
-- This is the same as 'Reflex.Dynamic.List' but with a
-- limited interface.
----------------------------------------------------------------------------

{-# LANGUAGE RecordWildCards #-}

module Reflex.Data.Stack
  ( DynamicStack(..)
  , DynamicStackConfig(..)
  , defaultDynamicStackConfig
  , holdDynamicStack
  )
where

import           Relude

import           Reflex
import           Reflex.Potato.Helpers

import           Control.Monad.Fix

import           Data.Wedge


data DynamicStack t a = DynamicStack {
  _dynamicStack_pushed     :: Event t a
  , _dynamicStack_popped   :: Event t a
  , _dynamicStack_contents :: Dynamic t [a]
}

data DynamicStackConfig t a = DynamicStackConfig {
  _dynamicStackConfig_push    :: Event t a
  , _dynamicStackConfig_pop   :: Event t () -- ^ event to pop an elt from the stack
  , _dynamicStackConfig_clear :: Event t () -- ^ event to clear the stack, this does NOT trigger any pop events!!
}

-- I can't seem to instantiate from this without getting a could not deduce Reflex t0 error
-- it can't seem to match the t inside and the t outside? I don't understand
defaultDynamicStackConfig :: (Reflex t) => DynamicStackConfig t a
defaultDynamicStackConfig = DynamicStackConfig
  { _dynamicStackConfig_push  = never
  , _dynamicStackConfig_pop   = never
  , _dynamicStackConfig_clear = never
  }

-- helper type for holdDynamicStack
data DSCmd t a = DSCPush a | DSCPop | DSCClear

-- | create a dynamic list
holdDynamicStack
  :: forall t m a
   . (Reflex t, MonadHold t m, MonadFix m)
  => [a]
  -> DynamicStackConfig t a
  -> m (DynamicStack t a)
holdDynamicStack initial (DynamicStackConfig {..}) = do
  let changeEvent :: Event t (DSCmd t a)
      changeEvent = leftmostwarn
        "Stack"
        [ fmap DSCPush          _dynamicStackConfig_push
        , fmap (const DSCPop)   _dynamicStackConfig_pop
        , fmap (const DSCClear) _dynamicStackConfig_clear
        ]

      -- Wedge values:
      -- Here is element that was just pushed
      -- There is element that was just popped
      -- Nowhere is initial state or just popped an empty stack or after a clear
      foldfn :: (DSCmd t a) -> (Wedge a a, [a]) -> PushM t (Wedge a a, [a])
      foldfn (DSCPush x) (_, xs      ) = return (Here x, x : xs)
      foldfn DSCPop      (_, []      ) = return (Nowhere, [])
      foldfn DSCPop      (_, (x : xs)) = return (There x, xs)
      foldfn DSCClear    (_, _       ) = return (Nowhere, [])

  sdyn :: Dynamic t (Wedge a a, [a]) <- foldDynM foldfn
                                                 (Nowhere, initial)
                                                 changeEvent

  let changedEv :: Event t (Wedge a a)
      changedEv = fmap fst (updated sdyn)

  return $ DynamicStack { _dynamicStack_pushed   = fmapMaybe getHere changedEv
                        , _dynamicStack_popped   = fmapMaybe getThere changedEv
                        , _dynamicStack_contents = fmap snd sdyn
                        }