{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module Glazier.React.Widgets.Collection.Dynamic
( DynamicCollection(..)
, HKDynamicCollection
, _filterCriteria
, _sortCriteria
, _visibleList
, _rawCollection
, dynamicCollectionWindow
, updateVisibleList
, deleteDynamicCollectionItem
, insertDynamicCollectionItem
, module Glazier.React.Widgets.Collection
) where
import Control.Lens
import Control.Lens.Misc
import qualified Control.Monad.ListM as LM
import Control.Monad.Reader
import Data.Foldable
import qualified Data.Map.Strict as M
import qualified GHC.Generics as G
import Glazier.React
import Glazier.React.Widgets.Collection
data DynamicCollection ftr srt k a f = DynamicCollection
{ filterCriteria :: ftr
, sortCriteria :: srt
, visibleList :: [HKD f a]
, rawCollection :: M.Map k (HKD f a)
} deriving (G.Generic)
type HKDynamicCollection ftr srt k a f = DynamicCollection ftr srt k (a f) f
makeLenses_ ''DynamicCollection
updateVisibleList ::
(ftr -> s -> ReadIORef Bool)
-> (srt -> s -> s -> ReadIORef Ordering)
-> ModelState (DynamicCollection ftr srt k s Subject) ()
updateVisibleList ff fs = do
zs@(DynamicCollection ftr srt _ xs) <- use id
let xs' = toList xs
ftr' x = do
x' <- doReadIORef $ sceneRef x
ff ftr (model x')
srt' x y = do
x' <- doReadIORef $ sceneRef x
y' <- doReadIORef $ sceneRef y
fs srt (model x') (model y')
ys <- lift $ LM.filterMP ftr' xs' >>= LM.sortByM srt'
id .= zs { visibleList = ys }
dynamicCollectionWindow :: ReactId -> Window (DynamicCollection ftr srt k s Subject) ()
dynamicCollectionWindow ri = magnifiedScene _visibleList $ collectionWindow ri
deleteDynamicCollectionItem :: (MonadReactor p allS cmd m, Ord k)
=> k
-> ModelState (DynamicCollection ftr srt k s Subject) (m ())
deleteDynamicCollectionItem k =
zoom _rawCollection (deleteCollectionItem k)
insertDynamicCollectionItem :: (MonadReactor p allS cmd m, Ord k)
=> k
-> Subject s
-> ModelState (DynamicCollection ftr srt k s Subject) (m ())
insertDynamicCollectionItem k sbj =
zoom _rawCollection (insertCollectionItem k sbj)