{-# LANGUAGE CPP #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecursiveDo #-}
#ifdef USE_REFLEX_OPTIMIZER
{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
#endif

module Reflex.Widget.Basic where

import Control.Monad.Fix (MonadFix)
import Data.Map (Map)

import Reflex.Class
import Reflex.Adjustable.Class
import Data.Patch.MapWithMove


-- | Build sortable content in such a way that re-sorting it can cause minimal
-- disruption to an existing context.
--
-- Naively re-sorting a list of images would destroy every image and add them back
-- in the new order. This framework is able to avoid that by preserving the
-- identity of each image and simply moving it to the new location.
--
-- Example:
--
-- > let sortByFst = buttonA $> comparing fst
-- >     sortBySnd = buttonB $> comparing snd
-- >     sortEvent = leftmost [sortByFst, sortBySnd]
-- > sortableList
-- >   (\k v -> text $ "\n" ++ show k ++ " " ++ v)  -- show each element on a new line
-- >   (Map.fromList $ zip [0..] [(3, "a"), (2, "b"), (1, "c")])
-- >   sortEvent
sortableList :: forall t m k v a. (MonadHold t m, MonadFix m, Adjustable t m, Ord k)
             => (k -> v -> m a) -- ^ Function to render the content for each key/value pair
             -> Map k v -- ^ The sortable list with an initial ordering determined by the @Map@ keys in ascending order
             -> Event t (v -> v -> Ordering) -- ^ An event carrying a sort function for the list
             -> m (Map k a)
sortableList :: (k -> v -> m a)
-> Map k v -> Event t (v -> v -> Ordering) -> m (Map k a)
sortableList f :: k -> v -> m a
f m0 :: Map k v
m0 reSortFunc :: Event t (v -> v -> Ordering)
reSortFunc = do
  rec let reSortPatch :: Event t (PatchMapWithMove k v)
reSortPatch = (Map k v -> (v -> v -> Ordering) -> PatchMapWithMove k v)
-> Behavior t (Map k v)
-> Event t (v -> v -> Ordering)
-> Event t (PatchMapWithMove k v)
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> c) -> Behavior t a -> Event t b -> Event t c
attachWith (((v -> v -> Ordering) -> Map k v -> PatchMapWithMove k v)
-> Map k v -> (v -> v -> Ordering) -> PatchMapWithMove k v
forall a b c. (a -> b -> c) -> b -> a -> c
flip (v -> v -> Ordering) -> Map k v -> PatchMapWithMove k v
forall k v.
Ord k =>
(v -> v -> Ordering) -> Map k v -> PatchMapWithMove k v
patchThatSortsMapWith) (Incremental t (PatchMapWithMove k v)
-> Behavior t (PatchTarget (PatchMapWithMove k v))
forall k (t :: k) p.
(Reflex t, Patch p) =>
Incremental t p -> Behavior t (PatchTarget p)
currentIncremental Incremental t (PatchMapWithMove k v)
m) Event t (v -> v -> Ordering)
reSortFunc
      Incremental t (PatchMapWithMove k v)
m <- PatchTarget (PatchMapWithMove k v)
-> Event t (PatchMapWithMove k v)
-> m (Incremental t (PatchMapWithMove k v))
forall k (t :: k) (m :: * -> *) p.
(MonadHold t m, Patch p) =>
PatchTarget p -> Event t p -> m (Incremental t p)
holdIncremental Map k v
PatchTarget (PatchMapWithMove k v)
m0 Event t (PatchMapWithMove k v)
reSortPatch
  (results :: Map k a
results, _) <- (k -> v -> m a)
-> Map k v
-> Event t (PatchMapWithMove k v)
-> m (Map k a, Event t (PatchMapWithMove k a))
forall t (m :: * -> *) k v v'.
(Adjustable t m, Ord k) =>
(k -> v -> m v')
-> Map k v
-> Event t (PatchMapWithMove k v)
-> m (Map k v', Event t (PatchMapWithMove k v'))
mapMapWithAdjustWithMove k -> v -> m a
f Map k v
m0 Event t (PatchMapWithMove k v)
reSortPatch
  Map k a -> m (Map k a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map k a
results