{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE StrictData        #-}

{-|
Module      : Headroom.Config.Global
Description : Global configutation
Copyright   : (c) 2019-2022 Vaclav Svejcar
License     : BSD-3-Clause
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

/Global configuration/ is configuration shared between all /Headroom/ instances
and it's located in user's home directory.
-}

module Headroom.Config.Global
  ( GlobalConfig(..)
  , UpdaterConfig(..)
  , initGlobalConfigIfNeeded
  , loadGlobalConfig
  , parseGlobalConfig
  , globalConfigPath
  )
where

import           Data.Aeson                          ( FromJSON(..)
                                                     , genericParseJSON
                                                     )
import qualified Data.Yaml                          as Y
import           Headroom.Data.Has                   ( Has(..)
                                                     , HasRIO
                                                     )
import           Headroom.Data.Serialization         ( aesonOptions )
import           Headroom.Embedded                   ( defaultGlobalConfig )
import           Headroom.IO.FileSystem              ( FileSystem(..) )
import           Headroom.Meta                       ( globalConfigDirName
                                                     , globalConfigFileName
                                                     )
import           RIO
import qualified RIO.ByteString                     as B
import           RIO.FilePath                        ( (</>) )


---------------------------------  DATA TYPES  ---------------------------------

-- | Data type representing updater configuration.
data UpdaterConfig = UpdaterConfig
  { UpdaterConfig -> Bool
ucCheckForUpdates    :: Bool    -- ^ whether to check for updates
  , UpdaterConfig -> Integer
ucUpdateIntervalDays :: Integer -- ^ how ofter check for updates
  }
  deriving (UpdaterConfig -> UpdaterConfig -> Bool
(UpdaterConfig -> UpdaterConfig -> Bool)
-> (UpdaterConfig -> UpdaterConfig -> Bool) -> Eq UpdaterConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdaterConfig -> UpdaterConfig -> Bool
$c/= :: UpdaterConfig -> UpdaterConfig -> Bool
== :: UpdaterConfig -> UpdaterConfig -> Bool
$c== :: UpdaterConfig -> UpdaterConfig -> Bool
Eq, (forall x. UpdaterConfig -> Rep UpdaterConfig x)
-> (forall x. Rep UpdaterConfig x -> UpdaterConfig)
-> Generic UpdaterConfig
forall x. Rep UpdaterConfig x -> UpdaterConfig
forall x. UpdaterConfig -> Rep UpdaterConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdaterConfig x -> UpdaterConfig
$cfrom :: forall x. UpdaterConfig -> Rep UpdaterConfig x
Generic, Int -> UpdaterConfig -> ShowS
[UpdaterConfig] -> ShowS
UpdaterConfig -> String
(Int -> UpdaterConfig -> ShowS)
-> (UpdaterConfig -> String)
-> ([UpdaterConfig] -> ShowS)
-> Show UpdaterConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdaterConfig] -> ShowS
$cshowList :: [UpdaterConfig] -> ShowS
show :: UpdaterConfig -> String
$cshow :: UpdaterConfig -> String
showsPrec :: Int -> UpdaterConfig -> ShowS
$cshowsPrec :: Int -> UpdaterConfig -> ShowS
Show)

instance FromJSON UpdaterConfig where
  parseJSON :: Value -> Parser UpdaterConfig
parseJSON = Options -> Value -> Parser UpdaterConfig
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

-- | Data type representing global configuration options.
data GlobalConfig = GlobalConfig
  { GlobalConfig -> UpdaterConfig
gcUpdates :: UpdaterConfig -- ^ config for updater
  }
  deriving (GlobalConfig -> GlobalConfig -> Bool
(GlobalConfig -> GlobalConfig -> Bool)
-> (GlobalConfig -> GlobalConfig -> Bool) -> Eq GlobalConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlobalConfig -> GlobalConfig -> Bool
$c/= :: GlobalConfig -> GlobalConfig -> Bool
== :: GlobalConfig -> GlobalConfig -> Bool
$c== :: GlobalConfig -> GlobalConfig -> Bool
Eq, (forall x. GlobalConfig -> Rep GlobalConfig x)
-> (forall x. Rep GlobalConfig x -> GlobalConfig)
-> Generic GlobalConfig
forall x. Rep GlobalConfig x -> GlobalConfig
forall x. GlobalConfig -> Rep GlobalConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GlobalConfig x -> GlobalConfig
$cfrom :: forall x. GlobalConfig -> Rep GlobalConfig x
Generic, Int -> GlobalConfig -> ShowS
[GlobalConfig] -> ShowS
GlobalConfig -> String
(Int -> GlobalConfig -> ShowS)
-> (GlobalConfig -> String)
-> ([GlobalConfig] -> ShowS)
-> Show GlobalConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlobalConfig] -> ShowS
$cshowList :: [GlobalConfig] -> ShowS
show :: GlobalConfig -> String
$cshow :: GlobalConfig -> String
showsPrec :: Int -> GlobalConfig -> ShowS
$cshowsPrec :: Int -> GlobalConfig -> ShowS
Show)

instance FromJSON GlobalConfig where
  parseJSON :: Value -> Parser GlobalConfig
parseJSON = Options -> Value -> Parser GlobalConfig
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions


------------------------------  PUBLIC FUNCTIONS  ------------------------------

-- | Checks if global configuration /YAML/ file is already present and if not,
-- it creates one with default values.
initGlobalConfigIfNeeded :: (HasRIO FileSystem env) => RIO env ()
initGlobalConfigIfNeeded :: RIO env ()
initGlobalConfigIfNeeded = do
  FileSystem {GetUserDirectoryFn (RIO env)
DoesFileExistFn (RIO env)
ListFilesFn (RIO env)
CreateDirectoryFn (RIO env)
LoadFileFn (RIO env)
FindFilesByExtsFn (RIO env)
WriteFileFn (RIO env)
FindFilesFn (RIO env)
FindFilesByTypesFn (RIO env)
fsWriteFile :: forall (m :: * -> *). FileSystem m -> WriteFileFn m
fsLoadFile :: forall (m :: * -> *). FileSystem m -> LoadFileFn m
fsListFiles :: forall (m :: * -> *). FileSystem m -> ListFilesFn m
fsGetUserDirectory :: forall (m :: * -> *). FileSystem m -> GetCurrentDirectoryFn m
fsGetCurrentDirectory :: forall (m :: * -> *). FileSystem m -> GetCurrentDirectoryFn m
fsFindFilesByTypes :: forall (m :: * -> *). FileSystem m -> FindFilesByTypesFn m
fsFindFilesByExts :: forall (m :: * -> *). FileSystem m -> FindFilesByExtsFn m
fsFindFiles :: forall (m :: * -> *). FileSystem m -> FindFilesFn m
fsDoesFileExist :: forall (m :: * -> *). FileSystem m -> DoesFileExistFn m
fsCreateDirectory :: forall (m :: * -> *). FileSystem m -> CreateDirectoryFn m
fsWriteFile :: WriteFileFn (RIO env)
fsLoadFile :: LoadFileFn (RIO env)
fsListFiles :: ListFilesFn (RIO env)
fsGetUserDirectory :: GetUserDirectoryFn (RIO env)
fsGetCurrentDirectory :: GetUserDirectoryFn (RIO env)
fsFindFilesByTypes :: FindFilesByTypesFn (RIO env)
fsFindFilesByExts :: FindFilesByExtsFn (RIO env)
fsFindFiles :: FindFilesFn (RIO env)
fsDoesFileExist :: DoesFileExistFn (RIO env)
fsCreateDirectory :: CreateDirectoryFn (RIO env)
..} <- RIO env (FileSystem (RIO env))
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  String
userDir         <- GetUserDirectoryFn (RIO env)
fsGetUserDirectory
  String
configPath      <- GetUserDirectoryFn (RIO env)
forall env. HasRIO FileSystem env => RIO env String
globalConfigPath
  RIO env Bool -> RIO env () -> RIO env ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Bool -> Bool
not (Bool -> Bool) -> RIO env Bool -> RIO env Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DoesFileExistFn (RIO env)
fsDoesFileExist String
configPath) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ do
    CreateDirectoryFn (RIO env)
fsCreateDirectory CreateDirectoryFn (RIO env) -> CreateDirectoryFn (RIO env)
forall a b. (a -> b) -> a -> b
$ String
userDir String -> ShowS
</> String
forall a. IsString a => a
globalConfigDirName
    WriteFileFn (RIO env)
fsWriteFile String
configPath Text
forall a. IsString a => a
defaultGlobalConfig


-- | Loads global configuration from /YAML/ file.
loadGlobalConfig :: (HasRIO FileSystem env) => RIO env GlobalConfig
loadGlobalConfig :: RIO env GlobalConfig
loadGlobalConfig = do
  String
configPath <- RIO env String
forall env. HasRIO FileSystem env => RIO env String
globalConfigPath
  ByteString
content    <- IO ByteString -> RIO env ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> RIO env ByteString)
-> (String -> IO ByteString) -> String -> RIO env ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ByteString
forall (m :: * -> *). MonadIO m => String -> m ByteString
B.readFile (String -> RIO env ByteString) -> String -> RIO env ByteString
forall a b. (a -> b) -> a -> b
$ String
configPath
  ByteString -> RIO env GlobalConfig
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
ByteString -> m a
Y.decodeThrow ByteString
content


-- | Parses global configuration /YAML/ file.
parseGlobalConfig :: (MonadThrow m) => ByteString -> m GlobalConfig
parseGlobalConfig :: ByteString -> m GlobalConfig
parseGlobalConfig = ByteString -> m GlobalConfig
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
ByteString -> m a
Y.decodeThrow


-- | Path to global configuration /YAML/ file in user's directory.
globalConfigPath :: HasRIO FileSystem env => RIO env FilePath
globalConfigPath :: RIO env String
globalConfigPath = do
  FileSystem {RIO env String
DoesFileExistFn (RIO env)
ListFilesFn (RIO env)
CreateDirectoryFn (RIO env)
LoadFileFn (RIO env)
FindFilesByExtsFn (RIO env)
WriteFileFn (RIO env)
FindFilesFn (RIO env)
FindFilesByTypesFn (RIO env)
fsWriteFile :: WriteFileFn (RIO env)
fsLoadFile :: LoadFileFn (RIO env)
fsListFiles :: ListFilesFn (RIO env)
fsGetUserDirectory :: RIO env String
fsGetCurrentDirectory :: RIO env String
fsFindFilesByTypes :: FindFilesByTypesFn (RIO env)
fsFindFilesByExts :: FindFilesByExtsFn (RIO env)
fsFindFiles :: FindFilesFn (RIO env)
fsDoesFileExist :: DoesFileExistFn (RIO env)
fsCreateDirectory :: CreateDirectoryFn (RIO env)
fsWriteFile :: forall (m :: * -> *). FileSystem m -> WriteFileFn m
fsLoadFile :: forall (m :: * -> *). FileSystem m -> LoadFileFn m
fsListFiles :: forall (m :: * -> *). FileSystem m -> ListFilesFn m
fsGetUserDirectory :: forall (m :: * -> *). FileSystem m -> GetCurrentDirectoryFn m
fsGetCurrentDirectory :: forall (m :: * -> *). FileSystem m -> GetCurrentDirectoryFn m
fsFindFilesByTypes :: forall (m :: * -> *). FileSystem m -> FindFilesByTypesFn m
fsFindFilesByExts :: forall (m :: * -> *). FileSystem m -> FindFilesByExtsFn m
fsFindFiles :: forall (m :: * -> *). FileSystem m -> FindFilesFn m
fsDoesFileExist :: forall (m :: * -> *). FileSystem m -> DoesFileExistFn m
fsCreateDirectory :: forall (m :: * -> *). FileSystem m -> CreateDirectoryFn m
..} <- RIO env (FileSystem (RIO env))
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  String
userDir         <- RIO env String
fsGetUserDirectory
  String -> RIO env String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> RIO env String) -> String -> RIO env String
forall a b. (a -> b) -> a -> b
$ String
userDir String -> ShowS
</> String
forall a. IsString a => a
globalConfigDirName String -> ShowS
</> String
forall a. IsString a => a
globalConfigFileName