htalkat-0.1.2: Config.hs

-- This file is part of htalkat
-- Copyright (C) 2021 Martin Bays <mbays@sdf.org>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of version 3 of the GNU General Public License as
-- published by the Free Software Foundation, or any later version.
--
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see http://www.gnu.org/licenses/.

module Config where

import           Safe             (readMay)
import           System.Directory (doesFileExist)
import           System.Exit      (exitFailure)
import           System.FilePath  ((</>))

import           Opts
import           Util

#if !(MIN_VERSION_base(4,11,0))
import           Data.Semigroup
#endif

data Config = Config
    { listen_host        :: String
    , listen_port        :: Int
    , accept_unnamed     :: Bool
    , curses_local_top   :: Bool
    , curses_log         :: Bool
    , use_dumb_client    :: Bool
    , interactive_client :: [String]
    } deriving (Read)

confFilePath :: FilePath -> FilePath
confFilePath = (</> "htalkat.conf")

defaultConfigFile :: String
defaultConfigFile = unlines
    [ "Config"
    , "    { listen_host = \"\"  # Empty means bind all available hosts"
    , "    , listen_port = 5518"
    , "    , accept_unnamed = True  # Accept connections even from unnamed users"
    , ""
    , "    , curses_local_top = True  # Display you above remote in curses client"
    , "    , curses_log = False  # Log conversations to files in ~/.htalkat/logs/"
    , ""
    , "    , use_dumb_client = False  # Prefer dumb line-based client to curses client"
    , ""
    , "    # interactive_client: if non-empty, run in place of built-in client."
    , "    # First string is the command to run, and subsequent strings are arguments."
    , "    # It will be executed with two further arguments:"
    , "    # the path to a unix domain socket to interact with,"
    , "    # and the name of the remote user."
    , "    # Minimal example:"
    , "    #, interactive_client = [\"sh\", \"-c\","
    , "    #    \"socat unix-connect:\\\"$1\\\" stdio\", \"talkatc\"]"
    , "    , interactive_client = []"
    , "    }"
    ]

applyOptToConf :: Opt -> Config -> Config
applyOptToConf (Host h) conf = conf { listen_host = h }
applyOptToConf (Port pStr) conf | Just p <- readMay pStr = conf { listen_port = p }
applyOptToConf AcceptUnnamed conf = conf { accept_unnamed = True }
applyOptToConf BlockUnnamed conf = conf { accept_unnamed = False }
applyOptToConf DumbClient conf = conf { use_dumb_client = True }
applyOptToConf CursesClient conf = conf { use_dumb_client = False }
applyOptToConf LocalTop conf = conf { curses_local_top = True }
applyOptToConf LocalBottom conf = conf { curses_local_top = False }
applyOptToConf Log conf = conf { curses_log = True }
applyOptToConf NoLog conf = conf { curses_log = False }
applyOptToConf _ conf = conf

createConfigFileIfNecessary :: FilePath -> IO ()
createConfigFileIfNecessary ddir =
    let cpath = confFilePath ddir
    in doesFileExist cpath >>! writeFile cpath defaultConfigFile

loadConfig :: FilePath -> IO Config
loadConfig ddir = do
    createConfigFileIfNecessary ddir
    s <- readFile (confFilePath ddir)
    case readReadConfig (confFilePath ddir) s of
        Left err   -> putStrLn err >> exitFailure >> undefined
        Right conf -> pure conf

readReadConfig :: FilePath -> String -> Either String Config
readReadConfig path s =
    -- Based on https://hackage.haskell.org/package/tce-conf by Dino Morelli
    case reads $ removeComments s of
        [(c, _)    ] -> Right c
        ((_, x) : _) -> Left $ "ERROR parsing config file: " <> x <> hint
        [          ] -> Left $ "ERROR parsing config file" <> hint
    where
    hint = "; to recreate, remove " <> path <> " and try again."
    removeComments :: String -> String
    removeComments = unlines . map removeComment . lines
    removeComment = takeWhile (/= '#')