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
  )

-- | Get the path to the preferences file @~\/.config\/termonad\/termonad.yaml@.
getPreferencesFile :: IO FilePath
getPreferencesFile :: IO FilePath
getPreferencesFile = do
  -- Get the termonad config directory
  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"

-- | Read the configuration for the preferences file
-- @~\/.config\/termonad\/termonad.yaml@. This file stores only the 'options' of
-- 'TMConfig' so 'hooks' are initialized with 'defaultConfigHooks'.  If the
-- file doesn't exist, create it with the default values.
tmConfigFromPreferencesFile :: IO TMConfig
tmConfigFromPreferencesFile :: IO TMConfig
tmConfigFromPreferencesFile = do
  FilePath
confFile <- IO FilePath
getPreferencesFile
  -- If there is no preferences file we create it with the default values
  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
  -- Read the configuration file
  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

-- | Save the configuration to the preferences file
-- @~\/.config\/termonad\/termonad.yaml@
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