module Game.LambdaHack.Client.Action.ConfigIO
( mkConfigUI
) where
import Control.DeepSeq
import qualified Data.Char as Char
import qualified Data.ConfigFile as CF
import System.Directory
import System.Environment
import System.FilePath
import Game.LambdaHack.Client.Config
import Game.LambdaHack.Client.HumanCmd
import qualified Game.LambdaHack.Common.Key as K
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Content.RuleKind
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
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
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
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
mkKM ('C':'T':'R':'L':'-':s) = K.KM {key=mkKey s, modifier=K.Control}
mkKM s = K.KM {key=mkKey s, modifier=K.NoModifier}
configCommands =
let mkCommand (key, def) = (mkKM key, read def :: HumanCmd)
section = getItems cp "commands"
in map mkCommand section
configAppDataDirUI = dataDir
configUICfgFile = dataDir </> "config.ui"
configMacros =
let trMacro (from, to) =
let fromTr = mkKM from
toTr = mkKM 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{..}
mkConfigUI :: Kind.Ops RuleKind -> IO ConfigUI
mkConfigUI corule = do
let cpUIDefault = rcfgUIDefault $ Kind.stdRuleset corule
appData <- appDataDir
cpUI <- mkConfig cpUIDefault $ appData </> "config.ui.ini"
let conf = parseConfigUI appData cpUI
return $! deepseq conf conf