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 #55pull/60/head
parent
5a12b63035
commit
a348ae7fbc
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue