1
1
mirror of https://github.com/aelve/guide.git synced 2024-11-27 10:10:50 +03:00
guide/lib/Config.hs

90 lines
2.3 KiB
Haskell
Raw Normal View History

{-# LANGUAGE
OverloadedStrings,
NoImplicitPrelude
#-}
module Config
(
Config(..),
readConfig,
2016-03-22 23:09:05 +03:00
writeConfig,
modifyConfig,
)
where
import BasePrelude
2016-03-23 01:53:38 +03:00
-- Text
2016-06-12 22:35:13 +03:00
import Data.Text.All (Text)
-- JSON
import Data.Aeson as Aeson
import Data.Aeson.Encode.Pretty as Aeson hiding (Config)
-- ByteString
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
-- Files
import System.Directory
-- Default
import Data.Default
-- Local
import Utils
data Config = Config {
_baseUrl :: Url,
_googleToken :: Text,
_adminPassword :: Text,
_prerender :: Bool }
deriving (Eq, Show)
instance Default Config where
def = Config {
_baseUrl = "/",
_googleToken = "",
_adminPassword = "",
_prerender = False }
instance FromJSON Config where
parseJSON = withObject "config" $ \o -> do
_baseUrl <- o .:? "base-url" .!= _baseUrl def
_googleToken <- o .:? "google-token" .!= _googleToken def
_adminPassword <- o .:? "admin-password" .!= _adminPassword def
_prerender <- o .:? "prerender" .!= _prerender def
return Config{..}
instance ToJSON Config where
toJSON Config{..} = object [
"base-url" .= _baseUrl,
"google-token" .= _googleToken,
"admin-password" .= _adminPassword,
"prerender" .= _prerender ]
readConfig :: IO Config
readConfig = do
let filename = "config.json"
exists <- doesFileExist filename
when (not exists) $ do
putStrLn "config.json doesn't exist, creating it"
BSL.writeFile filename (Aeson.encodePretty (def :: Config))
contents <- BSL.fromStrict <$> BS.readFile filename
case Aeson.eitherDecode' contents of
Left err -> error ("error when reading config: " ++ err)
2016-03-22 23:09:05 +03:00
Right cfg -> do
-- If after an update there are new fields in the config, we should add
-- them to the file which can be done by writing the config to the
-- file after we've read it.
writeConfig cfg
return cfg
2016-03-22 23:09:05 +03:00
writeConfig :: Config -> IO ()
writeConfig cfg = do
-- Create-and-rename is safer than just rewriting the file
let newFile = "config-new.json"
2016-03-22 23:09:05 +03:00
BSL.writeFile newFile (Aeson.encodePretty cfg)
renameFile newFile "config.json"
2016-03-22 23:09:05 +03:00
modifyConfig :: (Config -> IO Config) -> IO ()
modifyConfig func = writeConfig =<< func =<< readConfig