Improve config file handling (local+user conf files)

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

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

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