module Config.Read(readFilesConfig) where

import Config.Type
import Control.Monad
import Control.Exception.Extra
import Config.Yaml
import Data.List.Extra
import System.FilePath


readFilesConfig :: [(FilePath, Maybe String)] -> IO [Setting]
readFilesConfig :: [(FilePath, Maybe FilePath)] -> IO [Setting]
readFilesConfig [(FilePath, Maybe FilePath)]
files = do
    let ([(FilePath, Maybe FilePath)]
yaml, [(FilePath, Maybe FilePath)]
haskell) = ((FilePath, Maybe FilePath) -> Bool)
-> [(FilePath, Maybe FilePath)]
-> ([(FilePath, Maybe FilePath)], [(FilePath, Maybe FilePath)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\(FilePath
x,Maybe FilePath
_) -> FilePath -> FilePath
lower (FilePath -> FilePath
takeExtension FilePath
x) FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
".yml",FilePath
".yaml"]) [(FilePath, Maybe FilePath)]
files
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(FilePath, Maybe FilePath)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FilePath, Maybe FilePath)]
haskell) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        FilePath -> IO ()
forall a. Partial => FilePath -> IO a
errorIO (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"HLint 2.3 and beyond cannot use Haskell configuration files.\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                  FilePath
"Tried to use: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [(FilePath, Maybe FilePath)] -> FilePath
forall a. Show a => a -> FilePath
show [(FilePath, Maybe FilePath)]
haskell FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                  FilePath
"Convert it to .yaml file format, following the example at\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                  FilePath
"  <https://github.com/ndmitchell/hlint/blob/master/data/hlint.yaml>"
    [ConfigYaml]
yaml <- ((FilePath, Maybe FilePath) -> IO ConfigYaml)
-> [(FilePath, Maybe FilePath)] -> IO [ConfigYaml]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((FilePath -> Maybe FilePath -> IO ConfigYaml)
-> (FilePath, Maybe FilePath) -> IO ConfigYaml
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FilePath -> Maybe FilePath -> IO ConfigYaml
readFileConfigYaml) [(FilePath, Maybe FilePath)]
yaml
    [Setting] -> IO [Setting]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Setting] -> IO [Setting]) -> [Setting] -> IO [Setting]
forall a b. (a -> b) -> a -> b
$ [ConfigYaml] -> [Setting]
settingsFromConfigYaml [ConfigYaml]
yaml