diff --git a/app/game/Swarm/App.hs b/app/game/Swarm/App.hs index 333ea35ff..562234ac0 100644 --- a/app/game/Swarm/App.hs +++ b/app/game/Swarm/App.hs @@ -102,7 +102,7 @@ appMain opts = do modifyIORef appStateRef $ logColorMode vty -- Run the app. - void $ + sFinal <- readIORef appStateRef >>= customMain vty @@ -110,6 +110,9 @@ appMain opts = do (Just chan) (app $ handleEventAndUpdateWeb appStateRef) + -- Finish writing logs before exiting + waitForLogger (sFinal ^. runtimeState . logger) + -- | A demo program to run the web service directly, without the terminal application. -- This is useful to live update the code using @ghcid -W --test "Swarm.App.demoWeb"@. demoWeb :: IO () diff --git a/src/swarm-engine/Swarm/Effect.hs b/src/swarm-engine/Swarm/Effect.hs index d35c54de9..b0a691ae3 100644 --- a/src/swarm-engine/Swarm/Effect.hs +++ b/src/swarm-engine/Swarm/Effect.hs @@ -2,8 +2,10 @@ -- SPDX-License-Identifier: BSD-3-Clause -- Description: Effect system module Swarm.Effect ( - module X, + module Time, + module Log, ) where -import Swarm.Effect.Time as X +import Swarm.Effect.Log as Log (Log (..), LogIOC (..), runLogEnvIOC, runLogIOC) +import Swarm.Effect.Time as Time diff --git a/src/swarm-engine/Swarm/Effect/Log.hs b/src/swarm-engine/Swarm/Effect/Log.hs new file mode 100644 index 000000000..c5a6f8c2d --- /dev/null +++ b/src/swarm-engine/Swarm/Effect/Log.hs @@ -0,0 +1,143 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralisedNewtypeDeriving #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +-- | +-- SPDX-License-Identifier: BSD-3-Clause +-- Description: Log effects +module Swarm.Effect.Log ( + Log (..), + + -- ** Log functions + logMessage, + localData, + localDomain, + localMaxLogLevel, + getLoggerEnv, + logAttention, + logInfo, + logTrace, + logAttention_, + logInfo_, + logTrace_, + + -- ** Log Carrier + LogIOC (..), + runLogIOC, + runLogEnvIOC, + + -- * Re-exports + module Log, +) where + +import Control.Algebra +import Control.Carrier.Reader +import Control.Monad.Trans (MonadIO (liftIO)) +import Data.Aeson.Types +import Data.Kind (Type) +import Data.Text (Text) +import Data.Time.Clock +import Log as Log (object, (.=)) +import Log.Data as Log +import Log.Logger as Log +import Log.Monad + +-- | Effect for logging +data Log (m :: Type -> Type) k where + LogMessageOp :: LogLevel -> Text -> Value -> Log m () + LocalData :: [Pair] -> m a -> Log m a + LocalDomain :: Text -> m a -> Log m a + LocalMaxLogLevel :: LogLevel -> m a -> Log m a + GetLoggerEnv :: Log m LoggerEnv + +newtype LogIOC m a = LogIOC (ReaderC LoggerEnv m a) + deriving newtype (Applicative, Functor, Monad, MonadIO) + +{- +runReader :: r -> ReaderC r m a -> m a +runReader r (ReaderC runReaderC) = runReaderC r +-} + +runLogIOC :: + Text -> + Logger -> + LogLevel -> + LogIOC m a -> + m a +runLogIOC component logger maxLogLevel = + runLogEnvIOC $ + LoggerEnv + { leLogger = logger + , leComponent = component + , leDomain = [] + , leData = [] + , leMaxLogLevel = maxLogLevel + } + +runLogEnvIOC :: LoggerEnv -> LogIOC m a -> m a +runLogEnvIOC env (LogIOC (ReaderC runLogIO)) = runLogIO env + +{- +instance Algebra sig m => Algebra (Reader r :+: sig) (ReaderC r m) where + alg Handler ctx n (ReaderC r m) +hdl sig ctx () +ctx = ReaderC $ \ r -> case sig of + L Ask -> pure (r <$ ctx) + L (Local f m) -> runReader (f r) (hdl (m <$ ctx)) + R other -> alg (runReader r . hdl) other ctx +-} + +instance (MonadIO m, Algebra sig m) => Algebra (Log :+: sig) (LogIOC m) where + alg hdl sig ctx = LogIOC . ReaderC $ \env -> case sig of + L (LogMessageOp lvl msg data_) -> + (<$ ctx) + <$> liftIO + (getCurrentTime >>= \time -> logMessageIO env time lvl msg data_) + L (LocalData data_ m) -> runLogEnvIOC (env {leData = leData env <> data_}) (hdl (m <$ ctx)) + L (LocalDomain domain m) -> runLogEnvIOC (env {leDomain = leDomain env <> [domain]}) (hdl (m <$ ctx)) + L (LocalMaxLogLevel lvl m) -> runLogEnvIOC (env {leMaxLogLevel = lvl}) (hdl (m <$ ctx)) + L GetLoggerEnv -> pure (env <$ ctx) + R other -> alg (runLogEnvIOC env . hdl) other ctx + +-- Redefine MonadLog with concrete type, to avoid type errors and incoherrent instances + +logMessage :: (Has Log sig m, Monad m) => LogLevel -> Text -> Value -> m () +logMessage level message data_ = send $ LogMessageOp level message data_ + +localData :: (Has Log sig m, Monad m) => [Pair] -> m a -> m a +localData data_ action = send $ LocalData data_ action + +localDomain :: (Has Log sig m, Monad m) => Text -> m a -> m a +localDomain domain action = send $ LocalDomain domain action + +localMaxLogLevel :: (Has Log sig m, Monad m) => LogLevel -> m a -> m a +localMaxLogLevel level action = send $ LocalMaxLogLevel level action + +getLoggerEnv :: (Has Log sig m, Monad m) => m LoggerEnv +getLoggerEnv = send GetLoggerEnv + +-- Log message helpers + +logAttention :: (Has Log sig m, Monad m, ToJSON a) => Text -> a -> m () +logAttention msg a = logMessage LogAttention msg (toJSON a) + +logInfo :: (Has Log sig m, Monad m, ToJSON a) => Text -> a -> m () +logInfo msg a = logMessage LogInfo msg (toJSON a) + +logTrace :: (Has Log sig m, Monad m, ToJSON a) => Text -> a -> m () +logTrace msg a = logMessage LogTrace msg (toJSON a) + +-- Log message helpers - without value + +logAttention_ :: (Has Log sig m, Monad m) => Text -> m () +logAttention_ = (`logAttention` emptyObject) + +logInfo_ :: (Has Log sig m, Monad m) => Text -> m () +logInfo_ = (`logInfo` emptyObject) + +logTrace_ :: (Has Log sig m, Monad m) => Text -> m () +logTrace_ = (`logTrace` emptyObject) diff --git a/src/swarm-engine/Swarm/Game/State.hs b/src/swarm-engine/Swarm/Game/State.hs index 17f26cd5a..a722f0efc 100644 --- a/src/swarm-engine/Swarm/Game/State.hs +++ b/src/swarm-engine/Swarm/Game/State.hs @@ -33,6 +33,7 @@ module Swarm.Game.State ( robotInfo, pathCaching, gameMetrics, + gameLogEnv, -- ** GameState initialization initGameState, @@ -106,6 +107,7 @@ import Data.Text.Lazy qualified as TL import Data.Text.Lazy.Encoding qualified as TL import Data.Tuple (swap) import GHC.Generics (Generic) +import Log (LogLevel (..), Logger, LoggerEnv (LoggerEnv)) import Swarm.Failure (SystemFailure (..)) import Swarm.Game.CESK (Store, emptyStore, store, suspendedEnv) import Swarm.Game.Entity @@ -214,6 +216,7 @@ data GameState = GameState , _messageInfo :: Messages , _completionStatsSaved :: Bool , _gameMetrics :: Maybe GameMetrics + , _gameLogEnv :: LoggerEnv } makeLensesNoSigs ''GameState @@ -328,6 +331,9 @@ completionStatsSaved :: Lens' GameState Bool -- | Metrics tracked for the Swarm Engine. See 'RuntimeState' metrics store. gameMetrics :: Lens' GameState (Maybe GameMetrics) +-- | The logging setup for the Swarm Engine. See 'RuntimeState' logger. +gameLogEnv :: Lens' GameState LoggerEnv + ------------------------------------------------------------ -- Utilities ------------------------------------------------------------ @@ -512,8 +518,8 @@ type LaunchParams a = ParameterizableLaunchParams CodeToRun a type ValidatedLaunchParams = LaunchParams Identity -- | Create an initial, fresh game state record when starting a new scenario. -initGameState :: GameStateConfig -> GameState -initGameState gsc = +initGameState :: GameStateConfig -> Logger -> GameState +initGameState gsc logger = GameState { _creativeMode = False , _temporal = @@ -533,6 +539,7 @@ initGameState gsc = , _messageInfo = initMessages , _completionStatsSaved = False , _gameMetrics = Nothing + , _gameLogEnv = LoggerEnv logger "Engine" [] [] LogTrace } -- | Provide an entity accessor via the MTL transformer State API. diff --git a/src/swarm-engine/Swarm/Game/State/Initialize.hs b/src/swarm-engine/Swarm/Game/State/Initialize.hs index c5583a965..107469da6 100644 --- a/src/swarm-engine/Swarm/Game/State/Initialize.hs +++ b/src/swarm-engine/Swarm/Game/State/Initialize.hs @@ -24,6 +24,7 @@ import Data.Maybe (isNothing) import Data.Set qualified as S import Data.Text (Text) import Data.Tuple.Extra (dupe) +import Log (Logger) import Swarm.Game.CESK (finalValue, initMachine) import Swarm.Game.Device (getCapabilitySet, getMap) import Swarm.Game.Entity @@ -68,7 +69,7 @@ scenarioToGameState si@(ScenarioWith scenario _) (LaunchParams (Identity userSee theSeed <- arbitrateSeed userSeed $ scenario ^. scenarioLandscape now <- Clock.getTime Clock.Monotonic gMetric <- maybe (initGameMetrics $ rs ^. metrics) pure prevMetric - return $ pureScenarioToGameState si theSeed now toRun (Just gMetric) (rs ^. stdGameConfigInputs) + return $ pureScenarioToGameState si theSeed now toRun (Just gMetric) (rs ^. logger) (rs ^. stdGameConfigInputs) pureScenarioToGameState :: ScenarioWith (Maybe ScenarioPath) -> @@ -76,9 +77,10 @@ pureScenarioToGameState :: Clock.TimeSpec -> Maybe CodeToRun -> Maybe GameMetrics -> + Logger -> GameStateConfig -> GameState -pureScenarioToGameState (ScenarioWith scenario fp) theSeed now toRun gMetric gsc = +pureScenarioToGameState (ScenarioWith scenario fp) theSeed now toRun gMetric gLogger gsc = preliminaryGameState & discovery . structureRecognition .~ recognition where @@ -94,7 +96,7 @@ pureScenarioToGameState (ScenarioWith scenario fp) theSeed now toRun gMetric gsc . adaptGameState $ initializeRecognition mtlEntityAt (sLandscape ^. scenarioStructures) - gs = initGameState gsc + gs = initGameState gsc gLogger preliminaryGameState = gs & currentScenarioPath .~ fp diff --git a/src/swarm-engine/Swarm/Game/State/Runtime.hs b/src/swarm-engine/Swarm/Game/State/Runtime.hs index ee615fbba..aab11aac6 100644 --- a/src/swarm-engine/Swarm/Game/State/Runtime.hs +++ b/src/swarm-engine/Swarm/Game/State/Runtime.hs @@ -19,10 +19,12 @@ module Swarm.Game.State.Runtime ( appData, stdGameConfigInputs, metrics, + logger, -- ** Utility initScenarioInputs, initGameStateConfig, + waitForLogger, ) where @@ -33,6 +35,9 @@ import Control.Lens import Data.Map (Map) import Data.Sequence (Seq) import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.IO qualified as T +import Log import Swarm.Failure (SystemFailure) import Swarm.Game.Land import Swarm.Game.Recipe (loadRecipes) @@ -40,8 +45,10 @@ import Swarm.Game.Scenario (GameStateInputs (..), ScenarioInputs (..)) import Swarm.Game.State.Substate import Swarm.Game.World.Load (loadWorlds) import Swarm.Log -import Swarm.ResourceLoading (initNameGenerator, readAppData) +import Swarm.ResourceLoading (getSwarmLogsPath, initNameGenerator, readAppData) import Swarm.Util.Lens (makeLensesNoSigs) +import System.FilePath +import System.IO (BufferMode (..), IOMode (..), hSetBuffering, openFile) import System.Metrics qualified as Metrics data RuntimeState = RuntimeState @@ -52,6 +59,7 @@ data RuntimeState = RuntimeState , _stdGameConfigInputs :: GameStateConfig , _appData :: Map Text Text , _metrics :: Metrics.Store + , _logger :: Logger } initScenarioInputs :: @@ -94,6 +102,7 @@ data RuntimeOptions = RuntimeOptions { startPaused :: Bool , pauseOnObjectiveCompletion :: Bool , loadTestScenarios :: Bool + , startLogging :: Bool } deriving (Eq, Show) @@ -108,6 +117,7 @@ initRuntimeState opts = do store <- sendIO Metrics.newStore sendIO $ Metrics.registerGcMetrics store gsc <- initGameStateConfig opts + fileLogger <- if startLogging opts then sendIO makeFileLogger else pure mempty return $ RuntimeState { _webPort = Nothing @@ -117,8 +127,19 @@ initRuntimeState opts = do , _appData = initAppDataMap gsc , _stdGameConfigInputs = gsc , _metrics = store + , _logger = fileLogger } +makeFileLogger :: IO Logger +makeFileLogger = do + logPath <- getSwarmLogsPath + logFile <- openFile (logPath "log.txt") WriteMode + hSetBuffering logFile LineBuffering + mkLogger "file log" (T.hPutStrLn logFile . formatMsg) + where + formatMsg :: LogMessage -> Text + formatMsg = showLogMessage Nothing + makeLensesNoSigs ''RuntimeState -- | The port on which the HTTP debug service is running. @@ -149,3 +170,10 @@ appData :: Lens' RuntimeState (Map Text Text) -- will be published together with GHC metrics by the Wai server taking -- a reference to this store. metrics :: Lens' RuntimeState Metrics.Store + +-- | Get the persisted logger - you can think of this is as the IO action, +-- while LoggerEnv should be passed around to enrich logging in current context. +-- For example game engine logs can be enriched with the "game engine" component. +-- While game state can be rebuilt each time time a scenario is started +-- and LoggerEnv discarded, we want to keep around this logging IO action. +logger :: Lens' RuntimeState Logger diff --git a/src/swarm-engine/Swarm/Game/Step.hs b/src/swarm-engine/Swarm/Game/Step.hs index 405fa39ab..0d2e22b8b 100644 --- a/src/swarm-engine/Swarm/Game/Step.hs +++ b/src/swarm-engine/Swarm/Game/Step.hs @@ -1,6 +1,7 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} @@ -57,6 +58,7 @@ import Data.Text qualified as T import Linear (zero) import Prettyprinter (pretty) import Swarm.Effect as Effect (Time, getNow, measureCpuTimeInSec) +import Swarm.Effect.Log qualified as Effect import Swarm.Game.Achievement.Definitions import Swarm.Game.CESK import Swarm.Game.Cosmetic.Display @@ -95,7 +97,12 @@ import Witch (From (from)) import Prelude hiding (lookup) -- | GameState with support for IO and Time effect -type HasGameStepState sig m = (Has (State GameState) sig m, Has (Lift IO) sig m, Has Effect.Time sig m) +type HasGameStepState sig m = + ( Has (State GameState) sig m + , Has Effect.Time sig m + , Has Effect.Log sig m + , Has (Lift IO) sig m + ) -- | The main function to do one game tick. -- @@ -120,14 +127,17 @@ gameTick = measureCpuTimeInSec runTick >>= updateMetrics runTick :: m Bool runTick = do time <- use $ temporal . ticks - zoomRobots $ wakeUpRobotsDoneSleeping time - ticked <- runActiveRobots - updateBaseReplState - -- Possibly update the view center. - modify (robotInfo %~ recalcViewCenter) - -- On new tick see if the winning condition for the current objective is met - when ticked hypotheticalWinCheck' - return ticked + Effect.localData ["tick" Effect..= time] $ do + Effect.logTrace_ "Running tick" + zoomRobots $ wakeUpRobotsDoneSleeping time + ticked <- runActiveRobots + updateBaseReplState + -- Possibly update the view center. + modify (robotInfo %~ recalcViewCenter) + -- On new tick see if the winning condition for the current objective is met + when ticked hypotheticalWinCheck' + Effect.logTrace_ "Finished tick" + return ticked -- | Run active robots for this tick or just single step. runActiveRobots :: HasGameStepState sig m => m Bool @@ -346,7 +356,8 @@ data CompletionsWithExceptions = CompletionsWithExceptions -- 3) The iteration needs to be a "fold", so that state is updated -- after each element. hypotheticalWinCheck :: - (Has (State GameState) sig m, Has Effect.Time sig m, Has (Lift IO) sig m) => + forall m sig. + HasGameStepState sig m => WinStatus -> ObjectiveCompletion -> m () @@ -377,7 +388,8 @@ hypotheticalWinCheck ws oc = do let gameFinished = newWinState /= Ongoing let finishedObjectives = notNull queue - when (finishedObjectives && (gameFinished || shouldPause == PauseOnAnyObjective)) $ + when (finishedObjectives && (gameFinished || shouldPause == PauseOnAnyObjective)) $ do + Effect.logInfo "Objectives finished, pausing game" queue temporal . runStatus .= AutoPause mapM_ handleException $ exceptions finalAccumulator diff --git a/src/swarm-engine/Swarm/Game/Step/Validate.hs b/src/swarm-engine/Swarm/Game/Step/Validate.hs index 8217391af..cd8dd8560 100644 --- a/src/swarm-engine/Swarm/Game/Step/Validate.hs +++ b/src/swarm-engine/Swarm/Game/Step/Validate.hs @@ -13,6 +13,7 @@ import Control.Lens (use, (^.)) import Control.Monad.State (StateT, gets) import Data.List.NonEmpty qualified as NE import Data.Text qualified as T +import Swarm.Effect.Log qualified as Log import Swarm.Effect.Time (runTimeIO) import Swarm.Game.Robot.Concrete (robotLog) import Swarm.Game.State (GameState, messageInfo, robotInfo, winCondition) @@ -33,7 +34,9 @@ playUntilWin = do Just badErrs -> return $ Left badErrs Nothing -> case w of WinConditions (Won _ ts) _ -> return $ Right ts - _ -> runTimeIO gameTick >> playUntilWin + _ -> runEffects gameTick >> playUntilWin + where + runEffects = runTimeIO . Log.runLogIOC mempty mempty minBound -- | Extract any bad error messages from robot logs or the global -- message queue, where "bad" errors are either fatal errors or diff --git a/src/swarm-tui/Swarm/TUI/Controller/Util.hs b/src/swarm-tui/Swarm/TUI/Controller/Util.hs index c27822221..c05672e0f 100644 --- a/src/swarm-tui/Swarm/TUI/Controller/Util.hs +++ b/src/swarm-tui/Swarm/TUI/Controller/Util.hs @@ -22,7 +22,7 @@ import Data.Set qualified as S import Data.Text (Text) import Data.Text qualified as T import Graphics.Vty qualified as V -import Swarm.Effect (TimeIOC, runTimeIO) +import Swarm.Effect qualified as Effect import Swarm.Game.CESK (continue) import Swarm.Game.Device import Swarm.Game.Robot (robotCapabilities) @@ -211,40 +211,28 @@ resetViewport n = do -- | Modifies the game state using a fused-effect state action. zoomGameStateFromAppState :: - (MonadState AppState m, MonadIO m) => - Fused.StateC GameState (TimeIOC (Fused.LiftC IO)) a -> - m a -zoomGameStateFromAppState f = do - gs <- use z - (gs', a) <- liftIO . Fused.runM . runTimeIO $ Fused.runState gs f - z .= gs' - return a - where - z :: Lens' AppState GameState - z = playState . scenarioState . gameState + Fused.StateC GameState (Effect.LogIOC (Effect.TimeIOC (Fused.LiftC IO))) a -> + EventM Name AppState a +zoomGameStateFromAppState f = Brick.zoom playState (zoomGameStateFromPlayState f) -- TODO: inline + +-- | Modifies the game state using a fused-effect state action. +zoomGameStateFromPlayState :: + Fused.StateC GameState (Effect.LogIOC (Effect.TimeIOC (Fused.LiftC IO))) a -> + EventM Name PlayState a +zoomGameStateFromPlayState f = Brick.zoom scenarioState (zoomGameStateFromScenarioState f) -- | Modifies the game state using a fused-effect state action. zoomGameStateFromScenarioState :: (MonadState ScenarioState m, MonadIO m) => - Fused.StateC GameState (TimeIOC (Fused.LiftC IO)) a -> + Fused.StateC GameState (Effect.LogIOC (Effect.TimeIOC (Fused.LiftC IO))) a -> m a zoomGameStateFromScenarioState f = do gs <- use gameState - (gs', a) <- liftIO (Fused.runM (runTimeIO (Fused.runState gs f))) + let runEffects = Effect.runTimeIO . Effect.runLogEnvIOC (gs ^. gameLogEnv) + (gs', a) <- liftIO (Fused.runM (runEffects (Fused.runState gs f))) gameState .= gs' return a --- | Modifies the game state using a fused-effect state action. -zoomGameStateFromPlayState :: - (MonadState PlayState m, MonadIO m) => - Fused.StateC GameState (TimeIOC (Fused.LiftC IO)) a -> - m a -zoomGameStateFromPlayState f = do - gs <- use $ scenarioState . gameState - (gs', a) <- liftIO (Fused.runM (runTimeIO (Fused.runState gs f))) - scenarioState . gameState .= gs' - return a - onlyCreative :: (MonadState ScenarioState m) => m () -> m () onlyCreative a = do c <- use $ gameState . creativeMode diff --git a/src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs b/src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs index 7953a0648..2af899fc5 100644 --- a/src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs +++ b/src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs @@ -49,8 +49,9 @@ import Data.Sequence (Seq) import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as T -import Data.Time (getZonedTime) +import Data.Time (getCurrentTime, getZonedTime) import Data.Yaml (decodeFileEither, prettyPrintParseException) +import Log hiding ((.=)) import Swarm.Failure (SystemFailure (..)) import Swarm.Game.Achievement.Attainment import Swarm.Game.Achievement.Persistence @@ -144,6 +145,7 @@ mkRuntimeOptions AppOpts {..} = { startPaused = pausedAtStart , pauseOnObjectiveCompletion = autoShowObjectives , loadTestScenarios = Set.member LoadTestingScenarios debugOptions + , startLogging = True } data PersistentState @@ -164,6 +166,20 @@ initPersistentState :: initPersistentState opts@(AppOpts {..}) = do (warnings :: Seq SystemFailure, PersistentState initRS initUI initKs initProg) <- runAccum mempty $ do rs <- initRuntimeState $ mkRuntimeOptions opts + + -- TODO: this is a hello world, fix it with proper LogEnv + timeNow <- sendIO getCurrentTime + sendIO $ + execLogger (rs ^. logger) $ + LogMessage + { lmComponent = T.pack "TUI" + , lmDomain = [T.pack "State update"] + , lmTime = timeNow + , lmLevel = LogInfo + , lmMessage = T.pack "Hello world! I just initialized the runtime state" + , lmData = object [] + } + let showMainMenu = not (skipMenu opts) ui <- initUIState UIInitOptions {..} ks <- initKeyHandlingState @@ -214,8 +230,7 @@ constructAppState (PersistentState rs ui key progState) opts@(AppOpts {..}) mCha chan <- sendIO $ maybe initTestChan pure mChan animMgr <- sendIO $ startAnimationManager animMgrTickDuration chan PopupEvent - let gsc = rs ^. stdGameConfigInputs - gs = initGameState gsc + let gs = initGameState (rs ^. stdGameConfigInputs) (rs ^. logger) ps = PlayState { _scenarioState = ScenarioState gs $ initialUiGameplay startTime history diff --git a/src/swarm-util/Swarm/ResourceLoading.hs b/src/swarm-util/Swarm/ResourceLoading.hs index 4fd47ab4a..0d34c7c38 100644 --- a/src/swarm-util/Swarm/ResourceLoading.hs +++ b/src/swarm-util/Swarm/ResourceLoading.hs @@ -15,6 +15,7 @@ module Swarm.ResourceLoading ( getSwarmSavePath, getSwarmHistoryPath, getSwarmAchievementsPath, + getSwarmLogsPath, -- ** Loading text files readAppData, @@ -106,15 +107,21 @@ getSwarmConfigIniFile createDirs = do iniExists <- doesFileExist ini return (iniExists, ini) --- | Get path to swarm data, optionally creating necessary +-- | Get path to swarm XDG (sub)directory, optionally creating necessary -- directories. This could fail if user has bad permissions -- on his own @$HOME@ or @$XDG_DATA_HOME@ which is unlikely. -getSwarmXdgDataSubdir :: Bool -> FilePath -> IO FilePath -getSwarmXdgDataSubdir createDirs subDir = do - swarmData <- ( subDir) <$> getXdgDirectory XdgData "swarm" +getSwarmXdgSubdir :: XdgDirectory -> Bool -> FilePath -> IO FilePath +getSwarmXdgSubdir xdgDir createDirs subDir = do + swarmData <- ( subDir) <$> getXdgDirectory xdgDir "swarm" when createDirs (createDirectoryIfMissing True swarmData) pure swarmData +-- | Get path to swarm data, optionally creating necessary +-- directories. This could fail if user has bad permissions +-- on his own @$HOME@ or @$XDG_DATA_HOME@ which is unlikely. +getSwarmXdgDataSubdir :: Bool -> FilePath -> IO FilePath +getSwarmXdgDataSubdir = getSwarmXdgSubdir XdgData + getSwarmXdgDataFile :: Bool -> FilePath -> IO FilePath getSwarmXdgDataFile createDirs filepath = do let (subDir, file) = splitFileName filepath @@ -137,6 +144,9 @@ getSwarmHistoryPath createDirs = getSwarmXdgDataFile createDirs "history" getSwarmAchievementsPath :: Bool -> IO FilePath getSwarmAchievementsPath createDirs = getSwarmXdgDataSubdir createDirs "achievement" +getSwarmLogsPath :: IO FilePath +getSwarmLogsPath = getSwarmXdgSubdir XdgState True "logs" + -- | Read all the @.txt@ files in the @data/@ directory. readAppData :: (Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) => diff --git a/swarm.cabal b/swarm.cabal index aa8f676a8..5bca72f06 100644 --- a/swarm.cabal +++ b/swarm.cabal @@ -246,6 +246,9 @@ common lens common linear build-depends: linear >=1.21.6 && <1.24 +common log-base + build-depends: log-base >=0.11 && <0.13 + common lsp build-depends: lsp >=2.4 && <2.8 @@ -703,6 +706,7 @@ library swarm-engine fused-effects-lens, lens, linear, + log-base, megaparsec, monoidmap, mtl, @@ -723,6 +727,7 @@ library swarm-engine -- cabal-gild: discover src/swarm-engine exposed-modules: Swarm.Effect + Swarm.Effect.Log Swarm.Effect.Time Swarm.Game.Achievement.Attainment Swarm.Game.Achievement.Description @@ -1034,6 +1039,7 @@ library swarm-tui githash, lens, linear, + log-base, mtl, murmur3, natural-sort,