module Game.LambdaHack.Server.Action.ConfigIO
( mkConfigRules, dump
) where
import Control.Arrow (first, (***))
import Control.DeepSeq
import qualified Data.Char as Char
import qualified Data.ConfigFile as CF
import qualified Data.EnumMap.Strict as EM
import Data.List
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import System.Directory
import System.Environment
import System.FilePath
import qualified System.Random as R
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Content.RuleKind
import Game.LambdaHack.Server.Config
import Game.LambdaHack.Utils.Assert
overrideCP :: CP -> FilePath -> IO CP
overrideCP cp@(CP defCF) cfile = do
b <- doesFileExist cfile
if not b
then return cp
else do
c <- CF.readfile defCF cfile
return $ toCP $ forceEither c
mkConfig :: String -> FilePath -> IO CP
mkConfig configDefault cfile = do
let delComment = map (drop 2) $ init . drop 3 $ lines configDefault
unConfig = unlines delComment
!defCF = forceEither $ CF.readstring CF.emptyCP unConfig
!defCP = toCP defCF
overrideCP defCP cfile
appDataDir :: IO FilePath
appDataDir = do
progName <- getProgName
let name = takeWhile Char.isAlphaNum progName
getAppUserDataDirectory name
dump :: Config -> FilePath -> IO ()
dump Config{configSelfString} fn = do
current <- getCurrentDirectory
let path = current </> fn
writeFile path configSelfString
set :: CP -> CF.SectionSpec -> CF.OptionSpec -> String -> CP
set (CP conf) s o v =
if CF.has_option conf s o
then assert `failure`"Overwritten config option: " ++ s ++ "." ++ o
else CP $ forceEither $ CF.set conf s o v
getSetGen :: CP
-> String
-> IO (R.StdGen, CP)
getSetGen config option =
case getOption config "engine" option of
Just sg -> return (read sg, config)
Nothing -> do
g <- R.newStdGen
let gs = show g
c = set config "engine" option gs
return (g, c)
newtype CP = CP CF.ConfigParser
instance Show CP where
show (CP conf) = show $ CF.to_string conf
toCP :: CF.ConfigParser -> CP
toCP cf = CP $ cf {CF.optionxform = id}
forceEither :: Show a => Either a b -> b
forceEither (Left a) = assert `failure` a
forceEither (Right b) = b
getOption :: CF.Get_C a => CP -> CF.SectionSpec -> CF.OptionSpec -> Maybe a
getOption (CP conf) s o =
if CF.has_option conf s o
then Just $ forceEither $ CF.get conf s o
else Nothing
get :: CF.Get_C a => CP -> CF.SectionSpec -> CF.OptionSpec -> a
get (CP conf) s o =
if CF.has_option conf s o
then forceEither $ CF.get conf s o
else assert `failure` "Unknown config option: " ++ s ++ "." ++ o
getItems :: CP -> CF.SectionSpec -> [(String, String)]
getItems (CP conf) s =
if CF.has_section conf s
then forceEither $ CF.items conf s
else assert `failure` "Unknown config section: " ++ s
parseConfigRules :: FilePath -> CP -> Config
parseConfigRules dataDir cp =
let configSelfString = let CP conf = cp in CF.to_string conf
configCaves =
let section = getItems cp "caves"
readCaves = EM.fromList . map (toEnum *** first T.pack)
in M.fromList $ map (T.pack *** (readCaves . read)) section
configFirstDeathEnds = get cp "engine" "firstDeathEnds"
configFovMode = get cp "engine" "fovMode"
configSaveBkpClips = get cp "engine" "saveBkpClips"
configAppDataDir = dataDir
configScoresFile = dataDir </> get cp "file" "scoresFile"
configRulesCfgFile = dataDir </> "config.rules"
configHeroNames =
let toNumber (ident, name) =
case stripPrefix "HeroName_" ident of
Just n -> (read n, T.pack name)
Nothing -> assert `failure` ("wrong hero name id " ++ ident)
section = getItems cp "heroName"
in map toNumber section
configPlayers =
let section = getItems cp "players"
in M.fromList $ map (T.pack *** read) section
configScenario =
let section = getItems cp "scenario"
in M.fromList $ map (T.pack *** read) section
in Config{..}
mkConfigRules :: Kind.Ops RuleKind -> IO (Config, R.StdGen, R.StdGen)
mkConfigRules corule = do
let cpRulesDefault = rcfgRulesDefault $ Kind.stdRuleset corule
appData <- appDataDir
cpRules <- mkConfig cpRulesDefault $ appData </> "config.rules.ini"
(dungeonGen, cp2) <- getSetGen cpRules "dungeonRandomGenerator"
(startingGen, cp3) <- getSetGen cp2 "startingRandomGenerator"
let conf = parseConfigRules appData cp3
!res = deepseq conf (conf, dungeonGen, startingGen)
return res