ModelState.hs

{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
--
-- @since 1.0.0
module Language.Spectacle.Model.ModelState
  ( -- * ModelState
    ModelState (ModelState),
    getModelState,

    -- ** Query
    member,
    enabledActionsAt,

    -- ** Lenses
    indexNode,
    queuedActionsAt,
  )
where

import Data.Coerce (coerce)
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import Lens.Micro (Lens', lens, (^.))

import Data.Fingerprint (Fingerprint (Fingerprint))
import Data.Type.Rec (HasDict)
import Language.Spectacle.Model.ModelNode (ModelNode, actionsOf, isEnabled, queuedOf)

-- ---------------------------------------------------------------------------------------------------------------------

newtype ModelState ctx = ModelState
  {getModelState :: IntMap (ModelNode ctx)}
  deriving (Semigroup, Monoid) via IntMap (ModelNode ctx)

-- | @since 1.0.0
deriving instance HasDict Show ctx => Show (ModelState ctx)

indexNode :: Fingerprint -> Lens' (ModelState ctx) (ModelNode ctx)
indexNode ~(Fingerprint hash) =
  let getter (ModelState nodes) = nodes IntMap.! hash
      setter (ModelState nodes) ns = ModelState (IntMap.insert hash ns nodes)
   in lens getter setter

queuedActionsAt :: Fingerprint -> Lens' (ModelState ctx) (Set String)
queuedActionsAt hash = indexNode hash . queuedOf

enabledActionsAt :: Fingerprint -> ModelState ctx -> [String]
enabledActionsAt hash st =
  let node = st ^. indexNode hash
      actions = node ^. actionsOf
   in filter (\action -> node ^. isEnabled action) actions

member :: Fingerprint -> ModelState ctx -> Bool
member hash = IntMap.member (coerce hash) . getModelState