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