packages feed

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

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

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
  { cwLocal :: Map Text Text,
    cwNamespaces :: Map Text (Map Text Text),
    cwGlobal :: Map Text Text
  }
  deriving stock (Eq, Show)

-- | Empty initial state with no config values in any scope.
emptyConfigWriterState :: ConfigWriterState
emptyConfigWriterState =
  ConfigWriterState
    { cwLocal = Map.empty,
      cwNamespaces = Map.empty,
      cwGlobal = 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 {cwLocal = Map.insert key val st.cwLocal}
writeToScope (ScopeNamespace ns) key val st =
  let nsMap = Map.findWithDefault Map.empty ns st.cwNamespaces
      updated = Map.insert key val nsMap
   in st {cwNamespaces = Map.insert ns updated st.cwNamespaces}
writeToScope ScopeGlobal key val st = st {cwGlobal = Map.insert key val st.cwGlobal}

deleteFromScope :: ConfigScope -> Text -> ConfigWriterState -> ConfigWriterState
deleteFromScope ScopeLocal key st = st {cwLocal = Map.delete key st.cwLocal}
deleteFromScope (ScopeNamespace ns) key st =
  let nsMap = Map.findWithDefault Map.empty ns st.cwNamespaces
      updated = Map.delete key nsMap
   in st {cwNamespaces = Map.insert ns updated st.cwNamespaces}
deleteFromScope ScopeGlobal key st = st {cwGlobal = Map.delete key st.cwGlobal}

readScope :: ConfigScope -> ConfigWriterState -> Map Text Text
readScope ScopeLocal st = st.cwLocal
readScope (ScopeNamespace ns) st = Map.findWithDefault Map.empty ns st.cwNamespaces
readScope ScopeGlobal st = st.cwGlobal