about summary refs log tree commit diff
path: root/users/grfn/xanthous/src/Main.hs
diff options
context:
space:
mode:
authorsterni <sternenseemann@systemli.org>2021-09-11T14·23+0200
committersterni <sternenseemann@systemli.org>2021-09-11T16·00+0000
commit2f750e4a14be68f275f6fe23995eb9a994e0f5de (patch)
treefa825b6379206cef791600c6df70d0bce2fa5b29 /users/grfn/xanthous/src/Main.hs
parenta63057414df62f2b680692018fddbcbeae32f15f (diff)
refactor(grfn/xanthous): avoid unnecessary recompilation r/2850
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 <mail@tazj.in>
Reviewed-by: grfn <grfn@gws.fyi>
Diffstat (limited to 'users/grfn/xanthous/src/Main.hs')
-rw-r--r--users/grfn/xanthous/src/Main.hs159
1 files changed, 0 insertions, 159 deletions
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