-- This file is part of htalkat -- Copyright (C) 2021 Martin Bays -- -- 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 (/= '#')