{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
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 UpdaterConfig = UpdaterConfig
{ UpdaterConfig -> Bool
ucCheckForUpdates :: Bool
, UpdaterConfig -> Integer
ucUpdateIntervalDays :: Integer
}
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 GlobalConfig = GlobalConfig
{ GlobalConfig -> UpdaterConfig
gcUpdates :: UpdaterConfig
}
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
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
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
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
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