packages feed

seihou-core-0.6.0.0: src/Seihou/Effect/ConfigWriterPure.hs

module Seihou.Effect.ConfigWriterPure
  ( runConfigWriterPure,
    ConfigWriterState (..),
    emptyConfigWriterState,
  )
where

import Data.Generics.Labels ()
import Data.Map.Strict qualified as Map
import Effectful.State.Static.Local (State, get, modify, runState)
import Seihou.Core.Types (ConfigScope (..))
import Seihou.Effect.ConfigWriter (ConfigWriter (..))
import Seihou.Prelude

-- | In-memory state for the pure ConfigWriter interpreter.
data ConfigWriterState = ConfigWriterState
  { local :: !(Map Text Text),
    namespaces :: !(Map Text (Map Text Text)),
    global :: !(Map Text Text)
  }
  deriving stock (Eq, Generic, Show)

-- | Empty initial state with no config values in any scope.
emptyConfigWriterState :: ConfigWriterState
emptyConfigWriterState =
  ConfigWriterState
    { local = Map.empty,
      namespaces = Map.empty,
      global = Map.empty
    }

-- | Pure interpreter for the ConfigWriter effect using in-memory state.
--
-- Returns the result along with the final state, allowing tests to
-- inspect what was written.
runConfigWriterPure :: ConfigWriterState -> Eff (ConfigWriter : es) a -> Eff es (a, ConfigWriterState)
runConfigWriterPure initial = reinterpret (runState initial) handler
  where
    handler :: (State ConfigWriterState :> es') => EffectHandler ConfigWriter es'
    handler _ = \case
      WriteConfigValue scope key val ->
        modify @ConfigWriterState (writeToScope scope key val)
      DeleteConfigValue scope key ->
        modify @ConfigWriterState (deleteFromScope scope key)
      ListConfigValues scope -> do
        st <- get @ConfigWriterState
        pure (Right (readScope scope st))

writeToScope :: ConfigScope -> Text -> Text -> ConfigWriterState -> ConfigWriterState
writeToScope ScopeLocal key val st = st & #local . at key ?~ val
writeToScope (ScopeNamespace ns) key val st =
  let nsMap = Map.findWithDefault Map.empty ns (st ^. #namespaces)
      updated = Map.insert key val nsMap
   in st & #namespaces . at ns ?~ updated
writeToScope ScopeGlobal key val st = st & #global . at key ?~ val

deleteFromScope :: ConfigScope -> Text -> ConfigWriterState -> ConfigWriterState
deleteFromScope ScopeLocal key st = st & #local . at key .~ Nothing
deleteFromScope (ScopeNamespace ns) key st =
  let nsMap = Map.findWithDefault Map.empty ns (st ^. #namespaces)
      updated = Map.delete key nsMap
   in st & #namespaces . at ns ?~ updated
deleteFromScope ScopeGlobal key st = st & #global . at key .~ Nothing

readScope :: ConfigScope -> ConfigWriterState -> Map Text Text
readScope ScopeLocal st = st ^. #local
readScope (ScopeNamespace ns) st = Map.findWithDefault Map.empty ns (st ^. #namespaces)
readScope ScopeGlobal st = st ^. #global