From a348ae7fbcc4bfbfb301f6dacd4cc0e096b9c7b2 Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <hexagoxel@hexagoxel.de>
Date: Fri, 29 Sep 2017 14:59:41 +0200
Subject: [PATCH] Switch to XDG path for config; Search conf in parents

- switch to XDG path should be backwards-compatible:
  - new config will be written to XDG path
  - but existing config in ~/.brittany will be respected
- looks for "brittany.yaml" not only in cwd, but in parents too.
  uses the first file found.

fixes #45, fixes #55
---
 src-brittany/Main.hs                          | 43 +++++++++++----
 .../Haskell/Brittany/Internal/Config.hs       | 55 +++++++++++--------
 2 files changed, 65 insertions(+), 33 deletions(-)

diff --git a/src-brittany/Main.hs b/src-brittany/Main.hs
index 129ee50..71b278a 100644
--- a/src-brittany/Main.hs
+++ b/src-brittany/Main.hs
@@ -292,15 +292,38 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM = EitherT.runEi
 
 readConfigs :: CConfig Option -> [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
+  userBritPathSimple <- liftIO $ Directory.getAppUserDataDirectory "brittany"
+  userBritPathXdg    <- liftIO
+    $ Directory.getXdgDirectory Directory.XdgConfig "brittany"
+  let userConfigPathSimple = userBritPathSimple FilePath.</> "config.yaml"
+  let userConfigPathXdg    = userBritPathXdg FilePath.</> "config.yaml"
+  let
+    findLocalConfig :: MaybeT IO (Maybe (CConfig Option))
+    findLocalConfig = do
+      cwd <- liftIO $ Directory.getCurrentDirectory
+      let dirParts = FilePath.splitDirectories cwd
+      let searchDirs =
+            [ FilePath.joinPath x | x <- reverse $ List.inits dirParts ]
+      -- when cwd is "a/b/c", searchDirs is ["a/b/c", "a/b", "a", "/"]
+      mFilePath <- liftIO $ Directory.findFileWith Directory.doesFileExist
+                                                   searchDirs
+                                                   "brittany.yaml"
+      case mFilePath of
+        Nothing -> pure Nothing
+        Just fp -> readConfig fp
+  configsRead <- 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
+      localConfig      <- findLocalConfig
+      userConfigSimple <- readConfig userConfigPathSimple
+      userConfigXdg    <- readConfig userConfigPathXdg
+      let userConfig = userConfigSimple <|> userConfigXdg
+      when (Data.Maybe.isNothing userConfig) $ do
+        liftIO $ Directory.createDirectoryIfMissing False userBritPathXdg
+        writeDefaultConfig userConfigPathXdg
+      -- rightmost has highest priority
+      pure $ [userConfig, localConfig]
+    paths -> readConfig `mapM` reverse paths
+                   -- reverse to give highest priority to the first
+  merged <-
+    pure $ Semigroup.mconcat $ catMaybes $ configsRead ++ [Just cmdlineConfig]
   return $ cZipWith fromOptionIdentity staticDefaultConfig merged
diff --git a/src/Language/Haskell/Brittany/Internal/Config.hs b/src/Language/Haskell/Brittany/Internal/Config.hs
index 49651d7..baaca1f 100644
--- a/src/Language/Haskell/Brittany/Internal/Config.hs
+++ b/src/Language/Haskell/Brittany/Internal/Config.hs
@@ -8,7 +8,8 @@ module Language.Haskell.Brittany.Internal.Config
   , configParser
   , staticDefaultConfig
   , forwardOptionsSyntaxExtsEnabled
-  , readMergePersConfig
+  , readConfig
+  , writeDefaultConfig
   , showConfigYaml
   )
 where
@@ -198,29 +199,37 @@ configParser = do
 --   , infoIntersperse = True
 --   }
 
-readMergePersConfig
-  :: System.IO.FilePath -> Bool -> CConfig Option -> MaybeT IO (CConfig Option)
-readMergePersConfig path shouldCreate conf = do
+
+-- | Reads a config from a file. If the file does not exist, returns
+-- Nothing. If the file exists and parsing fails, prints to stderr and
+-- aborts the MaybeT. Otherwise succeed via Just.
+-- If the second parameter is True and the file does not exist, writes the
+-- staticDefaultConfig to the file.
+readConfig
+  :: MonadIO m => System.IO.FilePath -> MaybeT m (Maybe (CConfig Option))
+readConfig path = do
   exists <- liftIO $ System.Directory.doesFileExist path
-  if
-    | exists -> do
-        contents <- liftIO $ ByteString.readFile path -- no lazy IO, tyvm.
-        fileConf <- case Data.Yaml.decodeEither contents of
-          Left e -> do
-            liftIO
-              $ putStrErrLn
-              $ "error reading in brittany config from " ++ path ++ ":"
-            liftIO $ putStrErrLn e
-            mzero
-          Right x -> return x
-        return $ fileConf Semigroup.<> conf
-    | shouldCreate -> do
-        liftIO $ ByteString.writeFile path
-               $ Data.Yaml.encode
-               $ cMap (Option . Just . runIdentity) staticDefaultConfig
-        return $ conf
-    | otherwise -> do
-        return conf
+  if exists
+    then do
+      contents <- liftIO $ ByteString.readFile path -- no lazy IO, tyvm.
+      fileConf <- case Data.Yaml.decodeEither contents of
+        Left e -> do
+          liftIO
+            $  putStrErrLn
+            $  "error reading in brittany config from "
+            ++ path
+            ++ ":"
+          liftIO $ putStrErrLn e
+          mzero
+        Right x -> return x
+      return $ Just fileConf
+    else return $ Nothing
+
+writeDefaultConfig :: MonadIO m => System.IO.FilePath -> m ()
+writeDefaultConfig path =
+  liftIO $ ByteString.writeFile path $ Data.Yaml.encode $ cMap
+    (Option . Just . runIdentity)
+    staticDefaultConfig
 
 showConfigYaml :: Config -> String
 showConfigYaml = Data.ByteString.Char8.unpack