module Game.LambdaHack.Action.ConfigIO
( mkConfigRules, mkConfigUI, dump
) where
import System.Directory
import System.FilePath
import System.Environment
import qualified Data.ConfigFile as CF
import qualified Data.Char as Char
import Data.List
import qualified System.Random as R
import qualified Data.Text as T
import Game.LambdaHack.Utils.Assert
import Game.LambdaHack.Config
import qualified Game.LambdaHack.Key as K
import qualified Game.LambdaHack.Kind as Kind
import Game.LambdaHack.Content.RuleKind
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) $ 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 :: CP -> Config
parseConfigRules cp =
let configSelfString = let CP conf = cp in CF.to_string conf
configCaves = map (\(n, t) -> (T.pack n, T.pack t)) $ getItems cp "caves"
configDepth = get cp "dungeon" "depth"
configFovMode = get cp "engine" "fovMode"
configSmellTimeout = get cp "engine" "smellTimeout"
configBaseHP = get cp "heroes" "baseHP"
configExtraHeroes = get cp "heroes" "extraHeroes"
configFirstDeathEnds = get cp "heroes" "firstDeathEnds"
configFaction = T.pack $ get cp "heroes" "faction"
in Config{..}
parseConfigUI :: FilePath -> CP -> ConfigUI
parseConfigUI dataDir cp =
let mkKey s =
case K.keyTranslate s of
K.Unknown _ ->
assert `failure` ("unknown config file key <" ++ s ++ ">")
key -> key
configCommands =
let mkCommand (key, def) = (mkKey key, def)
section = getItems cp "commands"
in map mkCommand section
configAppDataDir = dataDir
configDiaryFile = dataDir </> get cp "files" "diaryFile"
configSaveFile = dataDir </> get cp "files" "saveFile"
configBkpFile = dataDir </> get cp "files" "saveFile" <.> ".bkp"
configScoresFile = dataDir </> get cp "files" "scoresFile"
configRulesCfgFile = dataDir </> "config.rules"
configUICfgFile = dataDir </> "config.ui"
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 "heroNames"
in map toNumber section
configMacros =
let trMacro (from, to) =
let !fromTr = mkKey from
!toTr = mkKey to
in if fromTr == toTr
then assert `failure` "degenerate alias: " ++ show toTr
else (fromTr, toTr)
section = getItems cp "macros"
in map trMacro section
configFont = get cp "ui" "font"
configHistoryMax = get cp "ui" "historyMax"
in ConfigUI{..}
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"
return (parseConfigRules cp3, dungeonGen, startingGen)
mkConfigUI :: Kind.Ops RuleKind -> IO ConfigUI
mkConfigUI corule = do
let cpUIDefault = rcfgUIDefault $ Kind.stdRuleset corule
appData <- appDataDir
cpUI <- mkConfig cpUIDefault $ appData </> "config.ui.ini"
return $ parseConfigUI appData cpUI