module Termonad.PreferencesFile where
import Termonad.Prelude
import Data.Yaml (decodeFileEither, encode, prettyPrintParseException)
import System.Directory
( XdgDirectory(XdgConfig)
, createDirectoryIfMissing
, doesFileExist
, getXdgDirectory
)
import Termonad.Types
( ConfigOptions
, TMConfig(TMConfig, hooks, options)
, defaultConfigHooks
, defaultConfigOptions
)
getPreferencesFile :: IO FilePath
getPreferencesFile :: IO FilePath
getPreferencesFile = do
FilePath
confDir <- XdgDirectory -> FilePath -> IO FilePath
getXdgDirectory XdgDirectory
XdgConfig "termonad"
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
confDir
FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
confDir FilePath -> FilePath -> FilePath
</> "termonad.yaml"
tmConfigFromPreferencesFile :: IO TMConfig
tmConfigFromPreferencesFile :: IO TMConfig
tmConfigFromPreferencesFile = do
FilePath
confFile <- IO FilePath
getPreferencesFile
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
confFile
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ConfigOptions -> IO ()
writePreferencesFile FilePath
confFile ConfigOptions
defaultConfigOptions
Either ParseException ConfigOptions
eitherOptions <- FilePath -> IO (Either ParseException ConfigOptions)
forall a. FromJSON a => FilePath -> IO (Either ParseException a)
decodeFileEither FilePath
confFile
ConfigOptions
options <-
case Either ParseException ConfigOptions
eitherOptions of
Left err :: ParseException
err -> do
Handle -> Text -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> Text -> m ()
hPutStrLn Handle
stderr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "Error parsing file " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Element Text] -> Text
forall seq. IsSequence seq => [Element seq] -> seq
pack FilePath
[Element Text]
confFile
Handle -> Text -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> Text -> m ()
hPutStrLn Handle
stderr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Element Text] -> Text
forall seq. IsSequence seq => [Element seq] -> seq
pack ([Element Text] -> Text) -> [Element Text] -> Text
forall a b. (a -> b) -> a -> b
$ ParseException -> FilePath
prettyPrintParseException ParseException
err
ConfigOptions -> IO ConfigOptions
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigOptions
defaultConfigOptions
Right options :: ConfigOptions
options -> ConfigOptions -> IO ConfigOptions
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigOptions
options
TMConfig -> IO TMConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TMConfig -> IO TMConfig) -> TMConfig -> IO TMConfig
forall a b. (a -> b) -> a -> b
$ $WTMConfig :: ConfigOptions -> ConfigHooks -> TMConfig
TMConfig { options :: ConfigOptions
options = ConfigOptions
options, hooks :: ConfigHooks
hooks = ConfigHooks
defaultConfigHooks }
writePreferencesFile :: FilePath -> ConfigOptions -> IO ()
writePreferencesFile :: FilePath -> ConfigOptions -> IO ()
writePreferencesFile confFile :: FilePath
confFile options :: ConfigOptions
options = do
let yaml :: ByteString
yaml = ConfigOptions -> ByteString
forall a. ToJSON a => a -> ByteString
encode ConfigOptions
options
yamlWithComment :: ByteString
yamlWithComment =
"# DO NOT EDIT THIS FILE BY HAND!\n" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
"#\n" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
"# This file is generated automatically by the Preferences dialog\n" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
"# in Termonad. Please open the Preferences dialog if you wish to\n" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
"# modify this file.\n" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
"#\n" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
"# The settings in this file will be ignored if you have a\n" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
"# termonad.hs file in this same directory.\n\n" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
ByteString
yaml
FilePath -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> ByteString -> m ()
writeFile FilePath
confFile ByteString
yamlWithComment
saveToPreferencesFile :: TMConfig -> IO ()
saveToPreferencesFile :: TMConfig -> IO ()
saveToPreferencesFile TMConfig { options :: TMConfig -> ConfigOptions
options = ConfigOptions
options } = do
FilePath
confFile <- IO FilePath
getPreferencesFile
FilePath -> ConfigOptions -> IO ()
writePreferencesFile FilePath
confFile ConfigOptions
options