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 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 159 insertions(+) create mode 100644 users/grfn/xanthous/app/Main.hs (limited to 'users/grfn/xanthous/app') diff --git a/users/grfn/xanthous/app/Main.hs b/users/grfn/xanthous/app/Main.hs new file mode 100644 index 000000000000..6d88405fd9e0 --- /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 -- cgit 1.4.1