From 2f750e4a14be68f275f6fe23995eb9a994e0f5de Mon Sep 17 00:00:00 2001 From: sterni Date: Sat, 11 Sep 2021 16:23:38 +0200 Subject: refactor(grfn/xanthous): avoid unnecessary recompilation MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit hpack is a bit dumb when generating the list of modules for a cabal file's component if multiple of them live in the same directory. Specifically it seems to assume that all modules in the source-dirs of a particular component are also necessary for its compilation. This is quite bad in the case of xanthous since both library and executable have source-dirs: src, so all modules will be compiled twice: Once for the library and then again for the executable despite it depending on the library (actually 4 times in total since we need to build a unprofiled and profiled object for each module…). To fix this we just move Main.hs into its own directory and change the executable's source-dirs, so hpack doesn't get confused anymore. Since all components now have their own source-dirs, unnecessary redundant compilation should be down to 0. The diff of the cabal file shows quite nicely how many module recompilation we've gotten rid of. Change-Id: I2df4fab9b0299b3a2b5d3005508c79b2d9796039 Reviewed-on: https://cl.tvl.fyi/c/depot/+/3533 Tested-by: BuildkiteCI Reviewed-by: tazjin Reviewed-by: grfn --- users/grfn/xanthous/app/Main.hs | 159 +++++++++++++++++++++++++++++++++++++ users/grfn/xanthous/package.yaml | 2 +- users/grfn/xanthous/src/Main.hs | 159 ------------------------------------- users/grfn/xanthous/xanthous.cabal | 62 +-------------- 4 files changed, 162 insertions(+), 220 deletions(-) create mode 100644 users/grfn/xanthous/app/Main.hs delete mode 100644 users/grfn/xanthous/src/Main.hs (limited to 'users') diff --git a/users/grfn/xanthous/app/Main.hs b/users/grfn/xanthous/app/Main.hs new file mode 100644 index 0000000000..6d88405fd9 --- /dev/null +++ b/users/grfn/xanthous/app/Main.hs @@ -0,0 +1,159 @@ +module Main ( main ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (finally) +import Brick +import qualified Brick.BChan +import qualified Graphics.Vty as Vty +import qualified Options.Applicative as Opt +import System.Random +import Control.Monad.Random (getRandom) +import Control.Exception (finally) +import System.Exit (die) +-------------------------------------------------------------------------------- +import qualified Xanthous.Game as Game +import Xanthous.Game.Env (GameEnv(..)) +import Xanthous.App +import Xanthous.Generators.Level + ( GeneratorInput + , parseGeneratorInput + , generateFromInput + , showCells + ) +import qualified Xanthous.Entities.Character as Character +import Xanthous.Generators.Level.Util (regions) +import Xanthous.Generators.Level.LevelContents +import Xanthous.Data (Dimensions, Dimensions'(Dimensions)) +import Data.Array.IArray ( amap ) +-------------------------------------------------------------------------------- + +data RunParams = RunParams + { seed :: Maybe Int + , characterName :: Maybe Text + } + deriving stock (Show, Eq) + +parseRunParams :: Opt.Parser RunParams +parseRunParams = RunParams + <$> optional (Opt.option Opt.auto + ( Opt.long "seed" + <> Opt.help "Random seed for the game." + )) + <*> optional (Opt.strOption + ( Opt.short 'n' + <> Opt.long "name" + <> Opt.help + ( "Name for the character. If not set on the command line, " + <> "will be prompted for at runtime" + ) + )) + +data Command + = Run RunParams + | Load FilePath + | Generate GeneratorInput Dimensions (Maybe Int) + +parseDimensions :: Opt.Parser Dimensions +parseDimensions = Dimensions + <$> Opt.option Opt.auto + ( Opt.short 'w' + <> Opt.long "width" + <> Opt.metavar "TILES" + ) + <*> Opt.option Opt.auto + ( Opt.short 'h' + <> Opt.long "height" + <> Opt.metavar "TILES" + ) + + +parseCommand :: Opt.Parser Command +parseCommand = (<|> Run <$> parseRunParams) $ Opt.subparser + $ Opt.command "run" + (Opt.info + (Run <$> parseRunParams) + (Opt.progDesc "Run the game")) + <> Opt.command "load" + (Opt.info + (Load <$> Opt.argument Opt.str (Opt.metavar "FILE")) + (Opt.progDesc "Load a saved game")) + <> Opt.command "generate" + (Opt.info + (Generate + <$> parseGeneratorInput + <*> parseDimensions + <*> optional + (Opt.option Opt.auto (Opt.long "seed")) + <**> Opt.helper + ) + (Opt.progDesc "Generate a sample level")) + +optParser :: Opt.ParserInfo Command +optParser = Opt.info + (parseCommand <**> Opt.helper) + (Opt.header "Xanthous: a WIP TUI RPG") + +thanks :: IO () +thanks = putStr "\n\n" >> putStrLn "Thanks for playing Xanthous!" + +newGame :: RunParams -> IO () +newGame rparams = do + gameSeed <- maybe getRandom pure $ seed rparams + when (isNothing $ seed rparams) + . putStrLn + $ "Seed: " <> tshow gameSeed + let initialState = Game.initialStateFromSeed gameSeed &~ do + for_ (characterName rparams) $ \cn -> + Game.character . Character.characterName ?= cn + runGame NewGame initialState `finally` do + thanks + when (isNothing $ seed rparams) + . putStrLn + $ "Seed: " <> tshow gameSeed + putStr "\n\n" + +loadGame :: FilePath -> IO () +loadGame saveFile = do + gameState <- maybe (die "Invalid save file!") pure + =<< Game.loadGame . fromStrict <$> readFile @IO saveFile + gameState `deepseq` runGame LoadGame gameState + +runGame :: RunType -> Game.GameState -> IO () +runGame rt gameState = do + eventChan <- Brick.BChan.newBChan 10 + let gameEnv = GameEnv eventChan + app <- makeApp gameEnv rt + let buildVty = Vty.mkVty Vty.defaultConfig + initialVty <- buildVty + _game' <- customMain + initialVty + buildVty + (Just eventChan) + app + gameState + pure () + +runGenerate :: GeneratorInput -> Dimensions -> Maybe Int -> IO () +runGenerate input dims mSeed = do + putStrLn "Generating..." + genSeed <- maybe getRandom pure mSeed + let randGen = mkStdGen genSeed + res = generateFromInput input dims randGen + rs = regions $ amap not res + when (isNothing mSeed) + . putStrLn + $ "Seed: " <> tshow genSeed + putStr "num regions: " + print $ length rs + putStr "region lengths: " + print $ length <$> rs + putStr "character position: " + print =<< chooseCharacterPosition res + putStrLn $ showCells res + +runCommand :: Command -> IO () +runCommand (Run runParams) = newGame runParams +runCommand (Load saveFile) = loadGame saveFile +runCommand (Generate input dims mSeed) = runGenerate input dims mSeed + +main :: IO () +main = runCommand =<< Opt.execParser optParser diff --git a/users/grfn/xanthous/package.yaml b/users/grfn/xanthous/package.yaml index fa217f80dc..605b1cab8c 100644 --- a/users/grfn/xanthous/package.yaml +++ b/users/grfn/xanthous/package.yaml @@ -116,7 +116,7 @@ library: source-dirs: src executable: - source-dirs: src + source-dirs: app main: Main.hs dependencies: - xanthous diff --git a/users/grfn/xanthous/src/Main.hs b/users/grfn/xanthous/src/Main.hs deleted file mode 100644 index 6d88405fd9..0000000000 --- a/users/grfn/xanthous/src/Main.hs +++ /dev/null @@ -1,159 +0,0 @@ -module Main ( main ) where --------------------------------------------------------------------------------- -import Xanthous.Prelude hiding (finally) -import Brick -import qualified Brick.BChan -import qualified Graphics.Vty as Vty -import qualified Options.Applicative as Opt -import System.Random -import Control.Monad.Random (getRandom) -import Control.Exception (finally) -import System.Exit (die) --------------------------------------------------------------------------------- -import qualified Xanthous.Game as Game -import Xanthous.Game.Env (GameEnv(..)) -import Xanthous.App -import Xanthous.Generators.Level - ( GeneratorInput - , parseGeneratorInput - , generateFromInput - , showCells - ) -import qualified Xanthous.Entities.Character as Character -import Xanthous.Generators.Level.Util (regions) -import Xanthous.Generators.Level.LevelContents -import Xanthous.Data (Dimensions, Dimensions'(Dimensions)) -import Data.Array.IArray ( amap ) --------------------------------------------------------------------------------- - -data RunParams = RunParams - { seed :: Maybe Int - , characterName :: Maybe Text - } - deriving stock (Show, Eq) - -parseRunParams :: Opt.Parser RunParams -parseRunParams = RunParams - <$> optional (Opt.option Opt.auto - ( Opt.long "seed" - <> Opt.help "Random seed for the game." - )) - <*> optional (Opt.strOption - ( Opt.short 'n' - <> Opt.long "name" - <> Opt.help - ( "Name for the character. If not set on the command line, " - <> "will be prompted for at runtime" - ) - )) - -data Command - = Run RunParams - | Load FilePath - | Generate GeneratorInput Dimensions (Maybe Int) - -parseDimensions :: Opt.Parser Dimensions -parseDimensions = Dimensions - <$> Opt.option Opt.auto - ( Opt.short 'w' - <> Opt.long "width" - <> Opt.metavar "TILES" - ) - <*> Opt.option Opt.auto - ( Opt.short 'h' - <> Opt.long "height" - <> Opt.metavar "TILES" - ) - - -parseCommand :: Opt.Parser Command -parseCommand = (<|> Run <$> parseRunParams) $ Opt.subparser - $ Opt.command "run" - (Opt.info - (Run <$> parseRunParams) - (Opt.progDesc "Run the game")) - <> Opt.command "load" - (Opt.info - (Load <$> Opt.argument Opt.str (Opt.metavar "FILE")) - (Opt.progDesc "Load a saved game")) - <> Opt.command "generate" - (Opt.info - (Generate - <$> parseGeneratorInput - <*> parseDimensions - <*> optional - (Opt.option Opt.auto (Opt.long "seed")) - <**> Opt.helper - ) - (Opt.progDesc "Generate a sample level")) - -optParser :: Opt.ParserInfo Command -optParser = Opt.info - (parseCommand <**> Opt.helper) - (Opt.header "Xanthous: a WIP TUI RPG") - -thanks :: IO () -thanks = putStr "\n\n" >> putStrLn "Thanks for playing Xanthous!" - -newGame :: RunParams -> IO () -newGame rparams = do - gameSeed <- maybe getRandom pure $ seed rparams - when (isNothing $ seed rparams) - . putStrLn - $ "Seed: " <> tshow gameSeed - let initialState = Game.initialStateFromSeed gameSeed &~ do - for_ (characterName rparams) $ \cn -> - Game.character . Character.characterName ?= cn - runGame NewGame initialState `finally` do - thanks - when (isNothing $ seed rparams) - . putStrLn - $ "Seed: " <> tshow gameSeed - putStr "\n\n" - -loadGame :: FilePath -> IO () -loadGame saveFile = do - gameState <- maybe (die "Invalid save file!") pure - =<< Game.loadGame . fromStrict <$> readFile @IO saveFile - gameState `deepseq` runGame LoadGame gameState - -runGame :: RunType -> Game.GameState -> IO () -runGame rt gameState = do - eventChan <- Brick.BChan.newBChan 10 - let gameEnv = GameEnv eventChan - app <- makeApp gameEnv rt - let buildVty = Vty.mkVty Vty.defaultConfig - initialVty <- buildVty - _game' <- customMain - initialVty - buildVty - (Just eventChan) - app - gameState - pure () - -runGenerate :: GeneratorInput -> Dimensions -> Maybe Int -> IO () -runGenerate input dims mSeed = do - putStrLn "Generating..." - genSeed <- maybe getRandom pure mSeed - let randGen = mkStdGen genSeed - res = generateFromInput input dims randGen - rs = regions $ amap not res - when (isNothing mSeed) - . putStrLn - $ "Seed: " <> tshow genSeed - putStr "num regions: " - print $ length rs - putStr "region lengths: " - print $ length <$> rs - putStr "character position: " - print =<< chooseCharacterPosition res - putStrLn $ showCells res - -runCommand :: Command -> IO () -runCommand (Run runParams) = newGame runParams -runCommand (Load saveFile) = loadGame saveFile -runCommand (Generate input dims mSeed) = runGenerate input dims mSeed - -main :: IO () -main = runCommand =<< Opt.execParser optParser diff --git a/users/grfn/xanthous/xanthous.cabal b/users/grfn/xanthous/xanthous.cabal index 45f85616b6..fc17ceaa20 100644 --- a/users/grfn/xanthous/xanthous.cabal +++ b/users/grfn/xanthous/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 761fd1d1a9f9f9fdf8e14e56922558f7968401c879dcb95ca697dab03d1e9eec +-- hash: c12ae4038a2e1f287de557b72b8493da05ccbf428e7ac7862349c46d241f342f name: xanthous version: 0.1.0.0 @@ -29,7 +29,6 @@ source-repository head library exposed-modules: Data.Aeson.Generic.DerivingVia - Main Xanthous.AI.Gormlak Xanthous.App Xanthous.App.Autocommands @@ -188,66 +187,9 @@ library executable xanthous main-is: Main.hs other-modules: - Data.Aeson.Generic.DerivingVia - Xanthous.AI.Gormlak - Xanthous.App - Xanthous.App.Autocommands - Xanthous.App.Common - Xanthous.App.Prompt - Xanthous.App.Time - Xanthous.Command - Xanthous.Data - Xanthous.Data.App - Xanthous.Data.Entities - Xanthous.Data.EntityChar - Xanthous.Data.EntityMap - Xanthous.Data.EntityMap.Graphics - Xanthous.Data.Levels - Xanthous.Data.Memo - Xanthous.Data.NestedMap - Xanthous.Data.VectorBag - Xanthous.Entities.Character - Xanthous.Entities.Creature - Xanthous.Entities.Creature.Hippocampus - Xanthous.Entities.Draw.Util - Xanthous.Entities.Entities - Xanthous.Entities.Environment - Xanthous.Entities.Item - Xanthous.Entities.Marker - Xanthous.Entities.Raws - Xanthous.Entities.RawTypes - Xanthous.Game - Xanthous.Game.Arbitrary - Xanthous.Game.Draw - Xanthous.Game.Env - Xanthous.Game.Lenses - Xanthous.Game.Memo - Xanthous.Game.Prompt - Xanthous.Game.State - Xanthous.Generators.Level - Xanthous.Generators.Level.CaveAutomata - Xanthous.Generators.Level.Dungeon - Xanthous.Generators.Level.LevelContents - Xanthous.Generators.Level.Util - Xanthous.Generators.Level.Village - Xanthous.Generators.Speech - Xanthous.Messages - Xanthous.Messages.Template - Xanthous.Monad - Xanthous.Orphans - Xanthous.Prelude - Xanthous.Random - Xanthous.Util - Xanthous.Util.Comonad - Xanthous.Util.Graph - Xanthous.Util.Graphics - Xanthous.Util.Inflection - Xanthous.Util.JSON - Xanthous.Util.Optparse - Xanthous.Util.QuickCheck Paths_xanthous hs-source-dirs: - src + app default-extensions: BlockArguments ConstraintKinds -- cgit 1.4.1