Expose readConfigs

brittany.cabal

@@ -108,6 +108,7 @@ library {
     , cmdargs >=0.10.14 && <0.11
     , czipwith >=1.0.0.0 && <1.1
     , ghc-boot-th >=8.0.1 && <8.3
+    , filepath >=1.4.1.0 && <1.5
     }
   default-extensions: {
     CPP

src-brittany/Main.hs

@@ -158,7 +158,7 @@ mainCmdParser helpDesc = do
     when printVersion $ do
       do
         putStrLn $ "brittany version " ++ showVersion version
-        putStrLn $ "Copyright (C) 2016-2017 Lennart Spitzner"
+        putStrLn $ "Copyright (C) 2016-2018 Lennart Spitzner"
         putStrLn $ "There is NO WARRANTY, to the extent permitted by law."
       System.Exit.exitSuccess
     when printHelp $ do
@@ -170,10 +170,14 @@ mainCmdParser helpDesc = do
                       Display -> repeat Nothing
                       Inplace -> inputPaths
 
-    config <- runMaybeT (readConfigs cmdlineConfig configPaths) >>= \case
+    configsToLoad <- liftIO $ if null configPaths
+                                then maybeToList <$> (Directory.getCurrentDirectory >>= findLocalConfigPath)
+                                else pure configPaths
+
+    config <- runMaybeT (readConfigsWithUserConfig cmdlineConfig configsToLoad) >>= \case
       Nothing -> System.Exit.exitWith (System.Exit.ExitFailure 53)
       Just x  -> return x
-    when (confUnpack $ _dconf_dump_config $ _conf_debug $ config) $ do
+    when (confUnpack $ _dconf_dump_config $ _conf_debug $ config) $
       trace (showConfigYaml config) $ return ()
 
     results <- zipWithM (coreIO putStrErrLn config suppressOutput) inputPaths outputPaths
@@ -317,42 +321,3 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM = ExceptT.runEx
          ]
       then trace "----"
       else id
-
-
-readConfigs :: CConfig Option -> [System.IO.FilePath] -> MaybeT IO Config
-readConfigs cmdlineConfig configPaths = do
-  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
-      localConfig      <- findLocalConfig
-      userConfigSimple <- readConfig userConfigPathSimple
-      userConfigXdg    <- readConfig userConfigPathXdg
-      let userConfig = userConfigSimple <|> userConfigXdg
-      when (Data.Maybe.isNothing userConfig) $ do
-        liftIO $ Directory.createDirectoryIfMissing True 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

src/Language/Haskell/Brittany.hs

@@ -4,6 +4,10 @@ module Language.Haskell.Brittany
   ( parsePrintModule
   , staticDefaultConfig
   , forwardOptionsSyntaxExtsEnabled
+  , userConfigPath
+  , findLocalConfigPath
+  , readConfigs
+  , readConfigsWithUserConfig
   , Config
   , CConfig(..)
   , CDebugConfig(..)

src/Language/Haskell/Brittany/Internal/Config.hs

@@ -9,6 +9,10 @@ module Language.Haskell.Brittany.Internal.Config
   , staticDefaultConfig
   , forwardOptionsSyntaxExtsEnabled
   , readConfig
+  , userConfigPath
+  , findLocalConfigPath
+  , readConfigs
+  , readConfigsWithUserConfig
   , writeDefaultConfig
   , showConfigYaml
   )
@@ -22,8 +26,10 @@ import           Language.Haskell.Brittany.Internal.Types
 import           Language.Haskell.Brittany.Internal.LayouterBasics
 
 import qualified Data.Yaml
+import           Data.CZipWith
 
 import           UI.Butcher.Monadic
+import Data.Monoid ((<>))
 
 import qualified System.Console.CmdArgs.Explicit as CmdArgs
 
@@ -33,7 +39,8 @@ import           Language.Haskell.Brittany.Internal.Utils
 
 import           Data.Coerce ( Coercible, coerce )
 
-
+import qualified System.Directory as Directory
+import qualified System.FilePath.Posix as FilePath
 
 staticDefaultConfig :: Config
 staticDefaultConfig = Config
@@ -189,10 +196,10 @@ configParser = do
 --     <*> switch (long "barb")
 --     <*> flag 3 5 (long "barc")
 --   )
--- 
+--
 -- configParserInfo :: ParserInfo Config
 -- configParserInfo = ParserInfo
---   { infoParser      = configParser 
+--   { infoParser      = configParser
 --   , infoFullDesc    = True
 --   , infoProgDesc    = return $ PP.text "a haskell code formatting utility based on ghc-exactprint"
 --   , infoHeader      = return $ PP.text "brittany"
@@ -227,6 +234,50 @@ readConfig path = do
       return $ Just fileConf
     else return $ Nothing
 
+-- | Returns a global brittany config file
+-- If there is no global config in a system, one will be created
+userConfigPath :: IO System.IO.FilePath
+userConfigPath = do
+  userBritPathSimple <- Directory.getAppUserDataDirectory "brittany"
+  userBritPathXdg    <- Directory.getXdgDirectory Directory.XdgConfig "brittany"
+  let searchDirs = [userBritPathSimple, userBritPathXdg]
+  globalConfig <- Directory.findFileWith Directory.doesFileExist searchDirs "config.yaml"
+  maybe (writeUserConfig userBritPathXdg) pure globalConfig
+  where
+    writeUserConfig dir = do
+      let createConfPath = dir FilePath.</> "config.yaml"
+      liftIO $ Directory.createDirectoryIfMissing True dir
+      writeDefaultConfig $ createConfPath
+      pure createConfPath
+
+-- | Searhes for a local brittany config path starting from a given directory
+findLocalConfigPath :: System.IO.FilePath -> IO (Maybe System.IO.FilePath)
+findLocalConfigPath dir = do
+  let dirParts = FilePath.splitDirectories dir
+  -- when provided dir is "a/b/c", searchDirs is ["a/b/c", "a/b", "a", "/"]
+  let searchDirs = FilePath.joinPath <$> reverse (List.inits dirParts)
+  Directory.findFileWith Directory.doesFileExist searchDirs "brittany.yaml"
+
+-- | Reads specified configs.
+readConfigs
+  :: CConfig Option        -- ^ Explicit options, take highest priority
+  -> [System.IO.FilePath]  -- ^ List of config files to load and merge, highest priority first
+  -> MaybeT IO Config
+readConfigs cmdlineConfig configPaths = do
+  configs <- readConfig `mapM` configPaths
+  let merged = Semigroup.mconcat $ reverse (cmdlineConfig:catMaybes configs)
+  return $ cZipWith fromOptionIdentity staticDefaultConfig merged
+
+-- | Reads provided configs
+-- but also applies the user default configuration (with a lowest priority)
+readConfigsWithUserConfig
+  :: CConfig Option        -- ^ Explicit options, take highest priority
+  -> [System.IO.FilePath]  -- ^ List of config files to load and merge, highest priority first
+  -> MaybeT IO Config
+readConfigsWithUserConfig cmdlineConfig configPaths = do
+  defaultPath <- liftIO $ userConfigPath
+  readConfigs cmdlineConfig (configPaths ++ [defaultPath])
+
 writeDefaultConfig :: MonadIO m => System.IO.FilePath -> m ()
 writeDefaultConfig path =
   liftIO $ ByteString.writeFile path $ Data.Yaml.encode $ cMap

stack.yaml

@@ -1,4 +1,7 @@
-resolver: lts-10.0
+resolver: lts-10.5
 
 packages:
   - .
+
+extra-deps:
+  - butcher-1.3.0.0