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