-- | 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 qualified Data.Text as T
import           Data.Version
import           System.FilePath
import           Text.ParserCombinators.ReadP (readP_to_S)
import           Text.Read

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.ClientOptions
import           Game.LambdaHack.Common.File
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Misc
import           Game.LambdaHack.Common.Save (compatibleVersion, delayPrint)
import qualified Game.LambdaHack.Common.Save as Save
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 s :: String
s = (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:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall v. Show v => String -> v -> String
`showFailure`)) 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

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"
      uLeftHand :: Bool
uLeftHand = String -> Bool
forall a. Read a => String -> a
getOption "movementLeftHandKeys_axwdqezc"
      uChosenFontset :: Text
uChosenFontset = String -> Text
forall a. Read a => String -> a
getOption "chosenFontset"
      uAllFontsScale :: Double
uAllFontsScale = String -> Double
forall a. Read a => String -> a
getOption "allFontsScale"
      uScreen1PerLine :: Bool
uScreen1PerLine = String -> Bool
forall a. Read a => String -> a
getOption "screenOneMessagePerLine"
      uHistory1PerLine :: Bool
uHistory1PerLine = String -> Bool
forall a. Read a => String -> a
getOption "historyOneMessagePerLine"
      uHistoryMax :: Int
uHistoryMax = String -> Int
forall a. Read a => String -> a
getOption "historyMax"
      uMaxFps :: Double
uMaxFps = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max 1 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ String -> Double
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 :: [(String, Color)]
uMessageColors =
        ((String, String) -> (String, Color))
-> [(String, String)] -> [(String, Color)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Color) -> (String, String) -> (String, Color)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second String -> Color
forall a. Read a => String -> a
readError) ([(String, String)] -> [(String, Color)])
-> [(String, String)] -> [(String, Color)]
forall a b. (a -> b) -> a -> b
$ String -> Config -> [(String, String)]
Ini.allItems "message_colors" Config
cfg
      uCmdline :: [String]
uCmdline = [String] -> [String]
glueSeed ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
words (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Read a => String -> a
getOption "overrideCmdline"
      uFonts :: [(Text, FontDefinition)]
uFonts =
        let toFont :: (String, String) -> (Text, b)
toFont (ident :: String
ident, fontString :: String
fontString) = (String -> Text
T.pack String
ident, String -> b
forall a. Read a => String -> a
readError String
fontString)
            section :: [(String, String)]
section = String -> Config -> [(String, String)]
Ini.allItems "fonts" Config
cfg
        in ((String, String) -> (Text, FontDefinition))
-> [(String, String)] -> [(Text, FontDefinition)]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> (Text, FontDefinition)
forall b. Read b => (String, String) -> (Text, b)
toFont [(String, String)]
section
      uFontsets :: [(Text, FontSet)]
uFontsets =
        let toFontSet :: (String, String) -> (Text, b)
toFontSet (ident :: String
ident, fontSetString :: String
fontSetString) =
              (String -> Text
T.pack String
ident, String -> b
forall a. Read a => String -> a
readError String
fontSetString)
            section :: [(String, String)]
section = String -> Config -> [(String, String)]
Ini.allItems "fontsets" Config
cfg
        in ((String, String) -> (Text, FontSet))
-> [(String, String)] -> [(Text, FontSet)]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> (Text, FontSet)
forall b. Read b => (String, String) -> (Text, b)
toFontSet [(String, String)]
section
      uFullscreenMode :: FullscreenMode
uFullscreenMode = String -> FullscreenMode
forall a. Read a => String -> a
getOption "fullscreenMode"
  in $WUIOptions :: [(KM, CmdTriple)]
-> [(Int, (Text, Text))]
-> Bool
-> Bool
-> Text
-> Double
-> Bool
-> Bool
-> Int
-> Double
-> Bool
-> Int
-> [(String, Color)]
-> [String]
-> [(Text, FontDefinition)]
-> [(Text, FontSet)]
-> FullscreenMode
-> UIOptions
UIOptions{..}

glueSeed :: [String] -> [String]
glueSeed :: [String] -> [String]
glueSeed [] = []
glueSeed ("SMGen" : s1 :: String
s1 : s2 :: String
s2 : rest :: [String]
rest) =
  ("SMGen" String -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s2) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
glueSeed [String]
rest
glueSeed (s :: String
s : rest :: [String]
rest) = String
s String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
glueSeed [String]
rest

-- | Read and parse UI config file.
mkUIOptions :: RuleContent -> ClientOptions -> IO UIOptions
mkUIOptions :: RuleContent -> ClientOptions -> IO UIOptions
mkUIOptions corule :: RuleContent
corule clientOptions :: ClientOptions
clientOptions = do
  let benchmark :: Bool
benchmark = ClientOptions -> Bool
sbenchmark ClientOptions
clientOptions
      cfgUIName :: String
cfgUIName = RuleContent -> String
rcfgUIName RuleContent
corule
      (configString :: String
configString, cfgUIDefault :: Config
cfgUIDefault) = RuleContent -> (String, Config)
rcfgUIDefault RuleContent
corule
  String
dataDir <- IO String
appDataDir
  let path :: String -> String
path bkp :: String
bkp = String
dataDir String -> String -> String
</> String
bkp String -> String -> String
forall a. Semigroup a => a -> a -> a
<> 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 -> String
path "")
    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 -> String
path "")
        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
      vExe1 :: Version
vExe1 = RuleContent -> Version
rexeVersion RuleContent
corule
      vExe2 :: Version
vExe2 =
        let optionName :: String
optionName = "version"
            -- Lenient to parse, and reject, old config files:
            s :: String
s = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> Config -> Maybe String
Ini.getOption "version" String
optionName Config
cfgUser
            dummyVersion :: Version
dummyVersion = [Int] -> Version
makeVersion []
        in case ((Version, String) -> Bool)
-> [(Version, String)] -> Maybe (Version, String)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "") (String -> Bool)
-> ((Version, String) -> String) -> (Version, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version, String) -> String
forall a b. (a, b) -> b
snd) ([(Version, String)] -> Maybe (Version, String))
-> [(Version, String)] -> Maybe (Version, String)
forall a b. (a -> b) -> a -> b
$ ReadP Version -> ReadS Version
forall a. ReadP a -> ReadS a
readP_to_S ReadP Version
parseVersion String
s of
          Just (ver :: Version
ver, "") -> Version
ver
          _ -> Version
dummyVersion
  if Bool
benchmark Bool -> Bool -> Bool
|| Version -> Version -> Bool
compatibleVersion Version
vExe1 Version
vExe2 then do
    let 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
  else do
    Bool
cpExists <- String -> IO Bool
doesFileExist (String -> String
path "")
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
cpExists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      String -> String -> IO ()
renameFile (String -> String
path "") (String -> String
path "bkp.")
      Bool
moveAside <- RuleContent -> ClientOptions -> IO Bool
Save.bkpAllSaves RuleContent
corule ClientOptions
clientOptions
      let msg :: Text
msg = "Config file" Text -> Text -> Text
<+> String -> Text
T.pack (String -> String
path "")
                Text -> Text -> Text
<+> "from an incompatible version '"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Version -> String
showVersion Version
vExe2)
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' detected while starting"
                Text -> Text -> Text
<+> String -> Text
T.pack (Version -> String
showVersion Version
vExe1)
                Text -> Text -> Text
<+> "game."
                Text -> Text -> Text
<+> if Bool
moveAside
                    then "The config file and savefiles have been moved aside."
                    else "The config file has been moved aside."
      Text -> IO ()
delayPrint Text
msg
    String -> String -> IO ()
tryWriteFile (String -> String
path "") String
configString
    let confDefault :: UIOptions
confDefault = Config -> UIOptions
parseConfig Config
cfgUIDefault
    UIOptions -> IO UIOptions
forall (m :: * -> *) a. Monad m => a -> m a
return UIOptions
confDefault

-- | Modify client options with UI options.
applyUIOptions :: COps -> UIOptions -> ClientOptions -> ClientOptions
applyUIOptions :: COps -> UIOptions -> ClientOptions -> ClientOptions
applyUIOptions COps{RuleContent
corule :: COps -> RuleContent
corule :: RuleContent
corule} uioptions :: UIOptions
uioptions =
     (\opts :: ClientOptions
opts -> ClientOptions
opts {schosenFontset :: Maybe Text
schosenFontset =
        ClientOptions -> Maybe Text
schosenFontset 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
uChosenFontset UIOptions
uioptions)}) (ClientOptions -> ClientOptions)
-> (ClientOptions -> ClientOptions)
-> ClientOptions
-> ClientOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     (\opts :: ClientOptions
opts -> ClientOptions
opts {sallFontsScale :: Maybe Double
sallFontsScale =
        ClientOptions -> Maybe Double
sallFontsScale ClientOptions
opts Maybe Double -> Maybe Double -> Maybe Double
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Double -> Maybe Double
forall a. a -> Maybe a
Just (UIOptions -> Double
uAllFontsScale UIOptions
uioptions)}) (ClientOptions -> ClientOptions)
-> (ClientOptions -> ClientOptions)
-> ClientOptions
-> ClientOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     (\opts :: ClientOptions
opts -> ClientOptions
opts {sfonts :: [(Text, FontDefinition)]
sfonts = UIOptions -> [(Text, FontDefinition)]
uFonts UIOptions
uioptions}) (ClientOptions -> ClientOptions)
-> (ClientOptions -> ClientOptions)
-> ClientOptions
-> ClientOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     (\opts :: ClientOptions
opts -> ClientOptions
opts {sfontsets :: [(Text, FontSet)]
sfontsets = UIOptions -> [(Text, FontSet)]
uFontsets UIOptions
uioptions}) (ClientOptions -> ClientOptions)
-> (ClientOptions -> ClientOptions)
-> ClientOptions
-> ClientOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     (\opts :: ClientOptions
opts -> ClientOptions
opts {sfullscreenMode :: Maybe FullscreenMode
sfullscreenMode =
        ClientOptions -> Maybe FullscreenMode
sfullscreenMode ClientOptions
opts Maybe FullscreenMode
-> Maybe FullscreenMode -> Maybe FullscreenMode
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` FullscreenMode -> Maybe FullscreenMode
forall a. a -> Maybe a
Just (UIOptions -> FullscreenMode
uFullscreenMode 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 Double
smaxFps =
        ClientOptions -> Maybe Double
smaxFps ClientOptions
opts Maybe Double -> Maybe Double -> Maybe Double
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Double -> Maybe Double
forall a. a -> Maybe a
Just (UIOptions -> Double
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 String
stitle =
        ClientOptions -> Maybe String
stitle 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
rtitle RuleContent
corule)})