-- | UI client options.
module Game.LambdaHack.Client.UI.UIOptionsParse
  ( mkUIOptions, applyUIOptions
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , configError, readError, parseConfig
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Control.DeepSeq
import qualified Data.Ini as Ini
import qualified Data.Ini.Reader as Ini
import qualified Data.Ini.Types as Ini
import qualified Data.Map.Strict as M
import           System.FilePath
import           Text.Read

import           Game.LambdaHack.Client.ClientOptions
import           Game.LambdaHack.Client.UI.HumanCmd
import qualified Game.LambdaHack.Client.UI.Key as K
import           Game.LambdaHack.Client.UI.UIOptions
import           Game.LambdaHack.Common.File
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Misc
import           Game.LambdaHack.Content.RuleKind

configError :: String -> a
configError :: String -> a
configError err :: String
err = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ "Error when parsing configuration file. Please fix config.ui.ini or remove it altogether. The details:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err

readError :: Read a => String -> a
readError :: String -> a
readError = (String -> a) -> (a -> a) -> Either String a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> a
forall a. String -> a
configError (String -> a) -> (String -> String) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("when reading a value" String -> String -> String
forall v. Show v => String -> v -> String
`showFailure`)) a -> a
forall a. a -> a
id
            (Either String a -> a)
-> (String -> Either String a) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
forall a. Read a => String -> Either String a
readEither

parseConfig :: Ini.Config -> UIOptions
parseConfig :: Config -> UIOptions
parseConfig cfg :: Config
cfg =
  let uCommands :: [(KM, CmdTriple)]
uCommands =
        let mkCommand :: (String, String) -> (KM, CmdTriple)
mkCommand (ident :: String
ident, keydef :: String
keydef) =
              case String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix "Cmd_" String
ident of
                Just _ ->
                  let (key :: String
key, def :: CmdTriple
def) = String -> (String, CmdTriple)
forall a. Read a => String -> a
readError String
keydef
                  in (String -> KM
K.mkKM String
key, CmdTriple
def :: CmdTriple)
                Nothing -> String -> (KM, CmdTriple)
forall a. String -> a
configError (String -> (KM, CmdTriple)) -> String -> (KM, CmdTriple)
forall a b. (a -> b) -> a -> b
$ "wrong macro id" String -> String -> String
forall v. Show v => String -> v -> String
`showFailure` String
ident
            section :: [(String, String)]
section = String -> Config -> [(String, String)]
Ini.allItems "additional_commands" Config
cfg
        in ((String, String) -> (KM, CmdTriple))
-> [(String, String)] -> [(KM, CmdTriple)]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> (KM, CmdTriple)
mkCommand [(String, String)]
section
      uHeroNames :: [(Int, (Text, Text))]
uHeroNames =
        let toNumber :: (String, String) -> (a, b)
toNumber (ident :: String
ident, nameAndPronoun :: String
nameAndPronoun) =
              case String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix "HeroName_" String
ident of
                Just n :: String
n -> (String -> a
forall a. Read a => String -> a
readError String
n, String -> b
forall a. Read a => String -> a
readError String
nameAndPronoun)
                Nothing -> String -> (a, b)
forall a. String -> a
configError
                           (String -> (a, b)) -> String -> (a, b)
forall a b. (a -> b) -> a -> b
$ "wrong hero name id" String -> String -> String
forall v. Show v => String -> v -> String
`showFailure` String
ident
            section :: [(String, String)]
section = String -> Config -> [(String, String)]
Ini.allItems "hero_names" Config
cfg
        in ((String, String) -> (Int, (Text, Text)))
-> [(String, String)] -> [(Int, (Text, Text))]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> (Int, (Text, Text))
forall a b. (Read a, Read b) => (String, String) -> (a, b)
toNumber [(String, String)]
section
      lookupFail :: forall b. String -> String -> b
      lookupFail :: String -> String -> b
lookupFail optionName :: String
optionName err :: String
err =
        String -> b
forall a. String -> a
configError (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$ "config file access failed"
                      String -> (String, String, Config) -> String
forall v. Show v => String -> v -> String
`showFailure` (String
err, String
optionName, Config
cfg)
      getOptionMaybe :: forall a. Read a => String -> Maybe a
      getOptionMaybe :: String -> Maybe a
getOptionMaybe optionName :: String
optionName =
        let ms :: Maybe String
ms = String -> String -> Config -> Maybe String
Ini.getOption "ui" String
optionName Config
cfg
        in (String -> a) -> (a -> a) -> Either String a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> String -> a
forall b. String -> String -> b
lookupFail String
optionName) a -> a
forall a. a -> a
id (Either String a -> a)
-> (String -> Either String a) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
forall a. Read a => String -> Either String a
readEither (String -> a) -> Maybe String -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
ms
      getOption :: forall a. Read a => String -> a
      getOption :: String -> a
getOption optionName :: String
optionName =
        let s :: String
s = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (String -> String -> String
forall b. String -> String -> b
lookupFail String
optionName "")
                (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> Config -> Maybe String
Ini.getOption "ui" String
optionName Config
cfg
        in (String -> a) -> (a -> a) -> Either String a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> String -> a
forall b. String -> String -> b
lookupFail String
optionName) a -> a
forall a. a -> a
id (Either String a -> a) -> Either String a -> a
forall a b. (a -> b) -> a -> b
$ String -> Either String a
forall a. Read a => String -> Either String a
readEither String
s
      uVi :: Bool
uVi = String -> Bool
forall a. Read a => String -> a
getOption "movementViKeys_hjklyubn"
      -- The option for Vi keys takes precendence,
      -- because the laptop keys are the default.
      uLaptop :: Bool
uLaptop = Bool -> Bool
not Bool
uVi Bool -> Bool -> Bool
&& String -> Bool
forall a. Read a => String -> a
getOption "movementLaptopKeys_uk8o79jl"
      uGtkFontFamily :: Text
uGtkFontFamily = String -> Text
forall a. Read a => String -> a
getOption "gtkFontFamily"
      uSdlFontFile :: Text
uSdlFontFile = String -> Text
forall a. Read a => String -> a
getOption "sdlFontFile"
      uSdlScalableSizeAdd :: Int
uSdlScalableSizeAdd = String -> Int
forall a. Read a => String -> a
getOption "sdlScalableSizeAdd"
      uSdlBitmapSizeAdd :: Int
uSdlBitmapSizeAdd = String -> Int
forall a. Read a => String -> a
getOption "sdlBitmapSizeAdd"
      uScalableFontSize :: Int
uScalableFontSize = String -> Int
forall a. Read a => String -> a
getOption "scalableFontSize"
#ifdef USE_JSFILE
      -- Local storage quota exeeded on Chrome.
      uHistoryMax = getOption "historyMax" `div` 10
#else
      uHistoryMax :: Int
uHistoryMax = String -> Int
forall a. Read a => String -> a
getOption "historyMax"
#endif
      uMaxFps :: Int
uMaxFps = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Read a => String -> a
getOption "maxFps"
      uNoAnim :: Bool
uNoAnim = String -> Bool
forall a. Read a => String -> a
getOption "noAnim"
      uhpWarningPercent :: Int
uhpWarningPercent = String -> Int
forall a. Read a => String -> a
getOption "hpWarningPercent"
      uMessageColors :: Maybe [(MsgClass, Color)]
uMessageColors = String -> Maybe [(MsgClass, Color)]
forall a. Read a => String -> Maybe a
getOptionMaybe "messageColors"
      uCmdline :: [String]
uCmdline = String -> [String]
words (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Read a => String -> a
getOption "overrideCmdline"
  in $WUIOptions :: [(KM, CmdTriple)]
-> [(Int, (Text, Text))]
-> Bool
-> Bool
-> Text
-> Text
-> Int
-> Int
-> Int
-> Int
-> Int
-> Bool
-> Int
-> Maybe [(MsgClass, Color)]
-> [String]
-> UIOptions
UIOptions{..}

-- | Read and parse UI config file.
mkUIOptions :: COps -> Bool -> IO UIOptions
mkUIOptions :: COps -> Bool -> IO UIOptions
mkUIOptions COps{RuleContent
corule :: COps -> RuleContent
corule :: RuleContent
corule} benchmark :: Bool
benchmark = do
  let cfgUIName :: String
cfgUIName = RuleContent -> String
rcfgUIName RuleContent
corule
      sUIDefault :: String
sUIDefault = RuleContent -> String
rcfgUIDefault RuleContent
corule
      cfgUIDefault :: Config
cfgUIDefault =
        (IniReaderError -> Config)
-> (Config -> Config) -> Either IniReaderError Config -> Config
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Config
forall a. String -> a
configError (String -> Config)
-> (IniReaderError -> String) -> IniReaderError -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("Ini.parse sUIDefault" String -> IniReaderError -> String
forall v. Show v => String -> v -> String
`showFailure`)) Config -> Config
forall a. a -> a
id
        (Either IniReaderError Config -> Config)
-> Either IniReaderError Config -> Config
forall a b. (a -> b) -> a -> b
$ String -> Either IniReaderError Config
Ini.parse String
sUIDefault
  String
dataDir <- IO String
appDataDir
  let userPath :: String
userPath = String
dataDir String -> String -> String
</> String
cfgUIName
  Config
cfgUser <- if Bool
benchmark then Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
Ini.emptyConfig else do
    Bool
cpExists <- String -> IO Bool
doesFileExist String
userPath
    if Bool -> Bool
not Bool
cpExists
      then Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
Ini.emptyConfig
      else do
        String
sUser <- String -> IO String
readFile String
userPath
        Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> IO Config) -> Config -> IO Config
forall a b. (a -> b) -> a -> b
$! (IniReaderError -> Config)
-> (Config -> Config) -> Either IniReaderError Config -> Config
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Config
forall a. String -> a
configError (String -> Config)
-> (IniReaderError -> String) -> IniReaderError -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("Ini.parse sUser" String -> IniReaderError -> String
forall v. Show v => String -> v -> String
`showFailure`)) Config -> Config
forall a. a -> a
id
                  (Either IniReaderError Config -> Config)
-> Either IniReaderError Config -> Config
forall a b. (a -> b) -> a -> b
$ String -> Either IniReaderError Config
Ini.parse String
sUser
  let cfgUI :: Config
cfgUI = (Map String String -> Map String String -> Map String String)
-> Config -> Config -> Config
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith Map String String -> Map String String -> Map String String
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Config
cfgUser Config
cfgUIDefault  -- user cfg preferred
      conf :: UIOptions
conf = Config -> UIOptions
parseConfig Config
cfgUI
  -- Catch syntax errors in complex expressions ASAP.
  UIOptions -> IO UIOptions
forall (m :: * -> *) a. Monad m => a -> m a
return (UIOptions -> IO UIOptions) -> UIOptions -> IO UIOptions
forall a b. (a -> b) -> a -> b
$! UIOptions -> UIOptions -> UIOptions
forall a b. NFData a => a -> b -> b
deepseq UIOptions
conf UIOptions
conf

-- | Modify client options with UI options.
applyUIOptions :: COps -> UIOptions -> ClientOptions -> ClientOptions
applyUIOptions :: COps -> UIOptions -> ClientOptions -> ClientOptions
applyUIOptions COps{RuleContent
corule :: RuleContent
corule :: COps -> RuleContent
corule} uioptions :: UIOptions
uioptions soptions :: ClientOptions
soptions =
     (\opts :: ClientOptions
opts -> ClientOptions
opts {sgtkFontFamily :: Maybe Text
sgtkFontFamily =
        ClientOptions -> Maybe Text
sgtkFontFamily ClientOptions
opts Maybe Text -> Maybe Text -> Maybe Text
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Text -> Maybe Text
forall a. a -> Maybe a
Just (UIOptions -> Text
uGtkFontFamily UIOptions
uioptions)}) (ClientOptions -> ClientOptions)
-> (ClientOptions -> ClientOptions)
-> ClientOptions
-> ClientOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     (\opts :: ClientOptions
opts -> ClientOptions
opts {sdlFontFile :: Maybe Text
sdlFontFile =
        ClientOptions -> Maybe Text
sdlFontFile ClientOptions
opts Maybe Text -> Maybe Text -> Maybe Text
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Text -> Maybe Text
forall a. a -> Maybe a
Just (UIOptions -> Text
uSdlFontFile UIOptions
uioptions)}) (ClientOptions -> ClientOptions)
-> (ClientOptions -> ClientOptions)
-> ClientOptions
-> ClientOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     (\opts :: ClientOptions
opts -> ClientOptions
opts {sdlScalableSizeAdd :: Maybe Int
sdlScalableSizeAdd =
        ClientOptions -> Maybe Int
sdlScalableSizeAdd ClientOptions
opts Maybe Int -> Maybe Int -> Maybe Int
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Int -> Maybe Int
forall a. a -> Maybe a
Just (UIOptions -> Int
uSdlScalableSizeAdd UIOptions
uioptions)}) (ClientOptions -> ClientOptions)
-> (ClientOptions -> ClientOptions)
-> ClientOptions
-> ClientOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     (\opts :: ClientOptions
opts -> ClientOptions
opts {sdlBitmapSizeAdd :: Maybe Int
sdlBitmapSizeAdd =
        ClientOptions -> Maybe Int
sdlBitmapSizeAdd ClientOptions
opts Maybe Int -> Maybe Int -> Maybe Int
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Int -> Maybe Int
forall a. a -> Maybe a
Just (UIOptions -> Int
uSdlBitmapSizeAdd UIOptions
uioptions)}) (ClientOptions -> ClientOptions)
-> (ClientOptions -> ClientOptions)
-> ClientOptions
-> ClientOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     (\opts :: ClientOptions
opts -> ClientOptions
opts {sscalableFontSize :: Maybe Int
sscalableFontSize =
        ClientOptions -> Maybe Int
sscalableFontSize ClientOptions
opts Maybe Int -> Maybe Int -> Maybe Int
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Int -> Maybe Int
forall a. a -> Maybe a
Just (UIOptions -> Int
uScalableFontSize UIOptions
uioptions)}) (ClientOptions -> ClientOptions)
-> (ClientOptions -> ClientOptions)
-> ClientOptions
-> ClientOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     (\opts :: ClientOptions
opts -> ClientOptions
opts {smaxFps :: Maybe Int
smaxFps =
        ClientOptions -> Maybe Int
smaxFps ClientOptions
opts Maybe Int -> Maybe Int -> Maybe Int
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Int -> Maybe Int
forall a. a -> Maybe a
Just (UIOptions -> Int
uMaxFps UIOptions
uioptions)}) (ClientOptions -> ClientOptions)
-> (ClientOptions -> ClientOptions)
-> ClientOptions
-> ClientOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     (\opts :: ClientOptions
opts -> ClientOptions
opts {snoAnim :: Maybe Bool
snoAnim =
        ClientOptions -> Maybe Bool
snoAnim ClientOptions
opts Maybe Bool -> Maybe Bool -> Maybe Bool
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Bool -> Maybe Bool
forall a. a -> Maybe a
Just (UIOptions -> Bool
uNoAnim UIOptions
uioptions)}) (ClientOptions -> ClientOptions)
-> (ClientOptions -> ClientOptions)
-> ClientOptions
-> ClientOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     (\opts :: ClientOptions
opts -> ClientOptions
opts {stitle :: Maybe Text
stitle =
        ClientOptions -> Maybe Text
stitle ClientOptions
opts Maybe Text -> Maybe Text -> Maybe Text
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Text -> Maybe Text
forall a. a -> Maybe a
Just (RuleContent -> Text
rtitle RuleContent
corule)}) (ClientOptions -> ClientOptions)
-> (ClientOptions -> ClientOptions)
-> ClientOptions
-> ClientOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     (\opts :: ClientOptions
opts -> ClientOptions
opts {sfontDir :: Maybe String
sfontDir =
        ClientOptions -> Maybe String
sfontDir ClientOptions
opts Maybe String -> Maybe String -> Maybe String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> Maybe String
forall a. a -> Maybe a
Just (RuleContent -> String
rfontDir RuleContent
corule)})
     (ClientOptions -> ClientOptions) -> ClientOptions -> ClientOptions
forall a b. (a -> b) -> a -> b
$ ClientOptions
soptions