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
pull/60/head
Lennart Spitzner 2017-09-29 14:59:41 +02:00
parent 5a12b63035
commit a348ae7fbc
2 changed files with 65 additions and 33 deletions

View File

@ -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

View File

@ -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