From 23f19e653f14e4a0c53acbbc414c83d4d79a8d10 Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <lsp@informatik.uni-kiel.de>
Date: Sun, 7 Aug 2016 15:14:57 +0200
Subject: [PATCH] Improve config file handling (local+user conf files)
---
brittany.cabal | 1 +
src-brittany/Main.hs | 28 +++++++++++++----
src/Language/Haskell/Brittany/Config.hs | 41 +++++++++++++------------
3 files changed, 45 insertions(+), 25 deletions(-)
diff --git a/brittany.cabal b/brittany.cabal
index ccc9ec9..e488cd8 100644
--- a/brittany.cabal
+++ b/brittany.cabal
@@ -131,6 +131,7 @@ executable brittany
, strict
, monad-memo
, safe
+ , filepath >=1.4.1.0 && <1.5
}
hs-source-dirs: src-brittany
default-language: Haskell2010
diff --git a/src-brittany/Main.hs b/src-brittany/Main.hs
index 0fa51ff..0c1f774 100644
--- a/src-brittany/Main.hs
+++ b/src-brittany/Main.hs
@@ -40,6 +40,8 @@ import DataTreePrint
import UI.Butcher.Monadic
import qualified System.Exit
+import qualified System.Directory as Directory
+import qualified System.FilePath.Posix as FilePath
import Paths_brittany
@@ -119,12 +121,9 @@ mainCmdParser = do
_ -> do
liftIO $ putStrErrLn $ "more than one output, aborting"
System.Exit.exitWith (System.Exit.ExitFailure 50)
- let configPath = maybe "brittany.yaml" id $ listToMaybe $ reverse configPaths
- config <- do
- may <- runMaybeT $ readMergePersConfig cmdlineConfig configPath
- case may of
- Nothing -> System.Exit.exitWith (System.Exit.ExitFailure 50)
- Just x -> return x
+ config <- runMaybeT (readConfigs cmdlineConfig configPaths) >>= \case
+ Nothing -> System.Exit.exitWith (System.Exit.ExitFailure 50)
+ Just x -> return x
when (runIdentity $ _dconf_dump_config $ _conf_debug $ config) $ do
trace (showTree config) $ return ()
liftIO $ do
@@ -214,3 +213,20 @@ mainCmdParser = do
]
then trace "----"
else id
+
+readConfigs :: ConfigF Maybe -> [System.IO.FilePath] -> MaybeT IO Config
+readConfigs cmdlineConfig configPaths = do
+ let defLocalConfigPath = "brittany.yaml"
+ userBritPath <- liftIO $ Directory.getAppUserDataDirectory "brittany"
+ let defUserConfigPath = userBritPath FilePath.</> "config.yaml"
+ merged <- case configPaths of
+ [] -> do
+ liftIO $ Directory.createDirectoryIfMissing False userBritPath
+ return cmdlineConfig
+ >>= readMergePersConfig defLocalConfigPath False
+ >>= readMergePersConfig defUserConfigPath True
+ -- TODO: ensure that paths exist ?
+ paths -> foldl (\prev p -> prev >>= readMergePersConfig p False)
+ (return cmdlineConfig)
+ paths
+ return $ cZip fromMaybeIdentity staticDefaultConfig merged
diff --git a/src/Language/Haskell/Brittany/Config.hs b/src/Language/Haskell/Brittany/Config.hs
index c357f92..2f16373 100644
--- a/src/Language/Haskell/Brittany/Config.hs
+++ b/src/Language/Haskell/Brittany/Config.hs
@@ -142,23 +142,26 @@ configParser = do
-- , infoIntersperse = True
-- }
-readMergePersConfig :: ConfigF Maybe -> System.IO.FilePath -> MaybeT IO Config
-readMergePersConfig conf path = do
+readMergePersConfig
+ :: System.IO.FilePath -> Bool -> ConfigF Maybe -> MaybeT IO (ConfigF Maybe)
+readMergePersConfig path shouldCreate conf = do
exists <- liftIO $ System.Directory.doesFileExist path
- if exists
- then do
- contents <- liftIO $ ByteString.readFile path -- no lazy IO, tyvm.
- fileConf <- case Data.Yaml.decodeEither contents of
- Left e -> do
- liftIO $ putStrLn $ "error reading in brittany config from " ++ path ++ ":"
- liftIO $ putStrLn e
- mzero
- Right x -> return x
- return $ cZip fromMaybeIdentity staticDefaultConfig
- $ cZip (<|>) conf fileConf
- else do
- liftIO $ ByteString.writeFile path
- $ Data.Yaml.encode
- $ cMap (Just . runIdentity) staticDefaultConfig
- return $ cZip fromMaybeIdentity staticDefaultConfig
- $ conf
+ if
+ | exists -> do
+ contents <- liftIO $ ByteString.readFile path -- no lazy IO, tyvm.
+ fileConf <- case Data.Yaml.decodeEither contents of
+ Left e -> do
+ liftIO
+ $ putStrLn
+ $ "error reading in brittany config from " ++ path ++ ":"
+ liftIO $ putStrLn e
+ mzero
+ Right x -> return x
+ return $ (cZip (<|>) conf fileConf)
+ | shouldCreate -> do
+ liftIO $ ByteString.writeFile path
+ $ Data.Yaml.encode
+ $ cMap (Just . runIdentity) staticDefaultConfig
+ return $ conf
+ | otherwise -> do
+ return conf