2016-03-22 01:17:53 +03:00
|
|
|
|
{-# LANGUAGE
|
|
|
|
|
OverloadedStrings,
|
|
|
|
|
NoImplicitPrelude
|
|
|
|
|
#-}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
module Config
|
|
|
|
|
(
|
|
|
|
|
Config(..),
|
|
|
|
|
readConfig,
|
2016-03-22 23:09:05 +03:00
|
|
|
|
writeConfig,
|
2016-03-22 01:17:53 +03:00
|
|
|
|
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)
|
2016-03-22 01:17:53 +03:00
|
|
|
|
-- 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 {
|
2016-05-04 21:18:18 +03:00
|
|
|
|
_baseUrl :: Url,
|
|
|
|
|
_googleToken :: Text,
|
|
|
|
|
_adminPassword :: Text,
|
|
|
|
|
_prerender :: Bool }
|
2016-03-22 01:17:53 +03:00
|
|
|
|
deriving (Eq, Show)
|
|
|
|
|
|
|
|
|
|
instance Default Config where
|
|
|
|
|
def = Config {
|
2016-05-04 21:18:18 +03:00
|
|
|
|
_baseUrl = "/",
|
|
|
|
|
_googleToken = "",
|
|
|
|
|
_adminPassword = "",
|
|
|
|
|
_prerender = False }
|
2016-03-22 01:17:53 +03:00
|
|
|
|
|
|
|
|
|
instance FromJSON Config where
|
|
|
|
|
parseJSON = withObject "config" $ \o -> do
|
2016-05-04 21:18:18 +03:00
|
|
|
|
_baseUrl <- o .:? "base-url" .!= _baseUrl def
|
|
|
|
|
_googleToken <- o .:? "google-token" .!= _googleToken def
|
|
|
|
|
_adminPassword <- o .:? "admin-password" .!= _adminPassword def
|
|
|
|
|
_prerender <- o .:? "prerender" .!= _prerender def
|
2016-03-22 01:17:53 +03:00
|
|
|
|
return Config{..}
|
|
|
|
|
|
|
|
|
|
instance ToJSON Config where
|
|
|
|
|
toJSON Config{..} = object [
|
2016-05-04 21:18:18 +03:00
|
|
|
|
"base-url" .= _baseUrl,
|
|
|
|
|
"google-token" .= _googleToken,
|
|
|
|
|
"admin-password" .= _adminPassword,
|
|
|
|
|
"prerender" .= _prerender ]
|
2016-03-22 01:17:53 +03:00
|
|
|
|
|
|
|
|
|
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 01:17:53 +03:00
|
|
|
|
|
2016-03-22 23:09:05 +03:00
|
|
|
|
writeConfig :: Config -> IO ()
|
|
|
|
|
writeConfig cfg = do
|
2016-03-22 01:17:53 +03:00
|
|
|
|
-- 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)
|
2016-03-22 01:17:53 +03:00
|
|
|
|
renameFile newFile "config.json"
|
2016-03-22 23:09:05 +03:00
|
|
|
|
|
|
|
|
|
modifyConfig :: (Config -> IO Config) -> IO ()
|
|
|
|
|
modifyConfig func = writeConfig =<< func =<< readConfig
|