PreferencesFile.hs

module Termonad.PreferencesFile where

import Termonad.Prelude

import Control.Monad.Trans.Except (ExceptT(..), runExceptT, throwE, withExceptT)
import Data.Aeson (Result(..), fromJSON)
import qualified Data.HashMap.Strict as HashMap
import Data.Yaml (ParseException, ToJSON (toJSON), decodeFileEither, encode, prettyPrintParseException)
import Data.Yaml.Aeson (Value(..))

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 = do
  -- Get the termonad config directory
  confDir <- getXdgDirectory XdgConfig "termonad"
  createDirectoryIfMissing True confDir
  pure $ confDir </> "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.
--
-- Any options that do not exist will get initialized with values from
-- 'defaultConfigOptions'.
tmConfigFromPreferencesFile :: IO TMConfig
tmConfigFromPreferencesFile = do
  confFile <- getPreferencesFile
  -- If there is no preferences file we create it with the default values
  exists <- doesFileExist confFile
  unless exists $ writePreferencesFile confFile defaultConfigOptions
  -- Read the configuration file
  eitherOptions <- readFileWithDefaults confFile
  options <-
    case eitherOptions of
      Left err -> do
        hPutStrLn stderr $ "Error parsing file " <> pack confFile <> ": " <> err
        pure defaultConfigOptions
      Right options -> pure options
  pure TMConfig { options = options, hooks = defaultConfigHooks }

-- | Read the 'ConfigOptions' out of a configuration file.
--
-- Merge the raw 'ConfigOptions' with 'defaultConfigOptions'.  This makes sure
-- that old versions of the configuration file will still be able to be read
-- even if new options are added to 'ConfigOptions' in new versions of
-- Termonad.
readFileWithDefaults :: FilePath -> IO (Either Text ConfigOptions)
readFileWithDefaults file = runExceptT $ do
  -- Read the configuration file as a JSON object
  optsFromFile :: Value <-
    withExceptT parseExceptionToText . ExceptT $ decodeFileEither file
  let optsDefault :: Value = toJSON $ defaultConfigOptions
  -- Then merge it with the default options in JSON before converting it to
  -- a 'ConfigOptions'
  resultToExcept . fromJSON $ mergeObjVals optsFromFile optsDefault
  where
    parseExceptionToText :: ParseException -> Text
    parseExceptionToText = pack . prettyPrintParseException

    resultToExcept :: Result a -> ExceptT Text IO a
    resultToExcept (Success v) = pure v
    resultToExcept (Error str) = throwE (pack str)

-- | Merge 'Value's recursively.
--
-- This merges 'Value's recursively in 'Object' values, taking values that
-- have been explicitly over the defaults.  The defaults are only used if
-- there is no value that has been explicitly set.
--
-- For 'Array', 'String', 'Number', 'Bool', and 'Null', take the first 'Value'
-- (the one that has been explicitly set in the user's config file):
--
-- >>> mergeObjVals (Array [Number 1, Number 2]) (Array [String "hello"])
-- Array [Number 1.0,Number 2.0]
-- >>> mergeObjVals (String "hello") (String "bye")
-- String "hello"
-- >>> mergeObjVals (Number 1) (Number 2)
-- Number 1.0
-- >>> mergeObjVals (Bool True) (Bool False)
-- Bool True
-- >>> mergeObjVals Null Null
-- Null
--
-- Note that 'Value's in 'Array's are not recursed into:
--
-- >>> let obj1 = Object $ HashMap.singleton "hello" (Number 2)
-- >>> let obj2 = Object $ HashMap.singleton "hello" (String "bye")
-- >>> mergeObjVals (Array [obj1]) (Array [obj2])
-- Array [Object (fromList [("hello",Number 2.0)])]
--
-- 'Object's are recursed into.  Unique keys from both Maps will be used.
-- Keys that are in both Maps will be merged according to the rules above:
--
-- >>> let hash1 = HashMap.fromList [("hello", Number 1), ("bye", Number 100)]
-- >>> let hash2 = HashMap.fromList [("hello", Number 2), ("goat", String "chicken")]
-- >>> mergeObjVals (Object hash1) (Object hash2)
-- Object (fromList [("bye",Number 100.0),("goat",String "chicken"),("hello",Number 1.0)])
--
-- 'Value's of different types will use the second 'Value':
--
-- >>> mergeObjVals Null (String "bye")
-- String "bye"
-- >>> mergeObjVals (Bool True) (Number 2)
-- Number 2.0
-- >>> mergeObjVals (Object mempty) (Bool False)
-- Bool False
--
mergeObjVals
  :: Value
     -- ^ Value that has been set explicitly in the User's configuration
     -- file.
  -> Value
     -- ^ Default value that will be used if no explicitly set value.
  -> Value
     -- ^ Merged values.
mergeObjVals optsFromFile optsDefault =
  case (optsFromFile, optsDefault) of
    -- Both the options from the file and the default options are an Object
    -- here.  Recursively merge the keys and values.
    (Object optsFromFileHashMap, Object optsDefaultHashMap) ->
      Object $ HashMap.unionWith mergeObjVals optsFromFileHashMap optsDefaultHashMap
    -- Both the value from the file and the default value are the same type.
    -- Use the value from the file.
    --
    -- XXX: This will end up causing readFileWithDefaults to fail if the value
    -- from the file is old and can no longer properly be decoded into a value
    -- expected by ConfigOptions.
    (Array fromFile, Array _) -> Array fromFile
    (String fromFile, String _) -> String fromFile
    (Number fromFile, Number _) -> Number fromFile
    (Bool fromFile, Bool _) -> Bool fromFile
    (Null, Null) -> Null
    -- The value from the file and the default value are different types. Just
    -- use the default value.
    (_, defVal) -> defVal

writePreferencesFile :: FilePath -> ConfigOptions -> IO ()
writePreferencesFile confFile options = do
  let yaml = encode options
      yamlWithComment =
        "# DO NOT EDIT THIS FILE BY HAND!\n" <>
        "#\n" <>
        "# This file is generated automatically by the Preferences dialog\n" <>
        "# in Termonad.  Please open the Preferences dialog if you wish to\n" <>
        "# modify this file.\n" <>
        "#\n" <>
        "# The settings in this file will be ignored if you have a\n" <>
        "# termonad.hs file in this same directory.\n\n" <>
        yaml
  writeFile confFile yamlWithComment

-- | Save the configuration to the preferences file
-- @~\/.config\/termonad\/termonad.yaml@
saveToPreferencesFile :: TMConfig -> IO ()
saveToPreferencesFile TMConfig { options = options } = do
  confFile <- getPreferencesFile
  writePreferencesFile confFile options