{-# LANGUAGE OverloadedStrings, ViewPatterns, RecordWildCards, GeneralizedNewtypeDeriving, TupleSections #-}

module Config.Yaml(
    ConfigYaml,
    readFileConfigYaml,
    settingsFromConfigYaml
    ) where

import Config.Type
import Data.Yaml
import Data.Either
import Data.Maybe
import Data.List.Extra
import Data.Tuple.Extra
import Control.Monad.Extra
import Control.Exception.Extra
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Data.ByteString.Char8 as BS
import qualified Data.HashMap.Strict as Map
import HSE.All hiding (Rule, String)
import Data.Functor
import Data.Semigroup
import Timing
import Util
import Prelude


-- | Read a config file in YAML format. Takes a filename, and optionally the contents.
--   Fails if the YAML doesn't parse or isn't valid HLint YAML
readFileConfigYaml :: FilePath -> Maybe String -> IO ConfigYaml
readFileConfigYaml :: FilePath -> Maybe FilePath -> IO ConfigYaml
readFileConfigYaml file :: FilePath
file contents :: Maybe FilePath
contents = FilePath -> FilePath -> IO ConfigYaml -> IO ConfigYaml
forall a. FilePath -> FilePath -> IO a -> IO a
timedIO "Config" FilePath
file (IO ConfigYaml -> IO ConfigYaml) -> IO ConfigYaml -> IO ConfigYaml
forall a b. (a -> b) -> a -> b
$ do
    Either ParseException ConfigYaml
val <- case Maybe FilePath
contents of
        Nothing -> FilePath -> IO (Either ParseException ConfigYaml)
forall a. FromJSON a => FilePath -> IO (Either ParseException a)
decodeFileEither FilePath
file
        Just src :: FilePath
src -> Either ParseException ConfigYaml
-> IO (Either ParseException ConfigYaml)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseException ConfigYaml
 -> IO (Either ParseException ConfigYaml))
-> Either ParseException ConfigYaml
-> IO (Either ParseException ConfigYaml)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ParseException ConfigYaml
forall a. FromJSON a => ByteString -> Either ParseException a
decodeEither' (ByteString -> Either ParseException ConfigYaml)
-> ByteString -> Either ParseException ConfigYaml
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString
BS.pack FilePath
src
    case Either ParseException ConfigYaml
val of
        Left e :: ParseException
e -> FilePath -> IO ConfigYaml
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO ConfigYaml) -> FilePath -> IO ConfigYaml
forall a b. (a -> b) -> a -> b
$ "Failed to read YAML configuration file " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "\n  " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ParseException -> FilePath
forall e. Exception e => e -> FilePath
displayException ParseException
e
        Right v :: ConfigYaml
v -> ConfigYaml -> IO ConfigYaml
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigYaml
v


---------------------------------------------------------------------
-- YAML DATA TYPE

newtype ConfigYaml = ConfigYaml [ConfigItem] deriving (b -> ConfigYaml -> ConfigYaml
NonEmpty ConfigYaml -> ConfigYaml
ConfigYaml -> ConfigYaml -> ConfigYaml
(ConfigYaml -> ConfigYaml -> ConfigYaml)
-> (NonEmpty ConfigYaml -> ConfigYaml)
-> (forall b. Integral b => b -> ConfigYaml -> ConfigYaml)
-> Semigroup ConfigYaml
forall b. Integral b => b -> ConfigYaml -> ConfigYaml
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> ConfigYaml -> ConfigYaml
$cstimes :: forall b. Integral b => b -> ConfigYaml -> ConfigYaml
sconcat :: NonEmpty ConfigYaml -> ConfigYaml
$csconcat :: NonEmpty ConfigYaml -> ConfigYaml
<> :: ConfigYaml -> ConfigYaml -> ConfigYaml
$c<> :: ConfigYaml -> ConfigYaml -> ConfigYaml
Semigroup,Semigroup ConfigYaml
ConfigYaml
Semigroup ConfigYaml =>
ConfigYaml
-> (ConfigYaml -> ConfigYaml -> ConfigYaml)
-> ([ConfigYaml] -> ConfigYaml)
-> Monoid ConfigYaml
[ConfigYaml] -> ConfigYaml
ConfigYaml -> ConfigYaml -> ConfigYaml
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [ConfigYaml] -> ConfigYaml
$cmconcat :: [ConfigYaml] -> ConfigYaml
mappend :: ConfigYaml -> ConfigYaml -> ConfigYaml
$cmappend :: ConfigYaml -> ConfigYaml -> ConfigYaml
mempty :: ConfigYaml
$cmempty :: ConfigYaml
$cp1Monoid :: Semigroup ConfigYaml
Monoid,Int -> ConfigYaml -> FilePath -> FilePath
[ConfigYaml] -> FilePath -> FilePath
ConfigYaml -> FilePath
(Int -> ConfigYaml -> FilePath -> FilePath)
-> (ConfigYaml -> FilePath)
-> ([ConfigYaml] -> FilePath -> FilePath)
-> Show ConfigYaml
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [ConfigYaml] -> FilePath -> FilePath
$cshowList :: [ConfigYaml] -> FilePath -> FilePath
show :: ConfigYaml -> FilePath
$cshow :: ConfigYaml -> FilePath
showsPrec :: Int -> ConfigYaml -> FilePath -> FilePath
$cshowsPrec :: Int -> ConfigYaml -> FilePath -> FilePath
Show)

data ConfigItem
    = ConfigPackage Package
    | ConfigGroup Group
    | ConfigSetting [Setting]
      deriving Int -> ConfigItem -> FilePath -> FilePath
[ConfigItem] -> FilePath -> FilePath
ConfigItem -> FilePath
(Int -> ConfigItem -> FilePath -> FilePath)
-> (ConfigItem -> FilePath)
-> ([ConfigItem] -> FilePath -> FilePath)
-> Show ConfigItem
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [ConfigItem] -> FilePath -> FilePath
$cshowList :: [ConfigItem] -> FilePath -> FilePath
show :: ConfigItem -> FilePath
$cshow :: ConfigItem -> FilePath
showsPrec :: Int -> ConfigItem -> FilePath -> FilePath
$cshowsPrec :: Int -> ConfigItem -> FilePath -> FilePath
Show

data Package = Package
    {Package -> FilePath
packageName :: String
    ,Package -> [ImportDecl S]
packageModules :: [ImportDecl S]
    } deriving Int -> Package -> FilePath -> FilePath
[Package] -> FilePath -> FilePath
Package -> FilePath
(Int -> Package -> FilePath -> FilePath)
-> (Package -> FilePath)
-> ([Package] -> FilePath -> FilePath)
-> Show Package
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Package] -> FilePath -> FilePath
$cshowList :: [Package] -> FilePath -> FilePath
show :: Package -> FilePath
$cshow :: Package -> FilePath
showsPrec :: Int -> Package -> FilePath -> FilePath
$cshowsPrec :: Int -> Package -> FilePath -> FilePath
Show

data Group = Group
    {Group -> FilePath
groupName :: String
    ,Group -> Bool
groupEnabled :: Bool
    ,Group -> [Either FilePath (ImportDecl S)]
groupImports :: [Either String (ImportDecl S)] -- Left for package imports
    ,Group -> [Either HintRule Classify]
groupRules :: [Either HintRule Classify] -- HintRule has scope set to mempty
    } deriving Int -> Group -> FilePath -> FilePath
[Group] -> FilePath -> FilePath
Group -> FilePath
(Int -> Group -> FilePath -> FilePath)
-> (Group -> FilePath)
-> ([Group] -> FilePath -> FilePath)
-> Show Group
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Group] -> FilePath -> FilePath
$cshowList :: [Group] -> FilePath -> FilePath
show :: Group -> FilePath
$cshow :: Group -> FilePath
showsPrec :: Int -> Group -> FilePath -> FilePath
$cshowsPrec :: Int -> Group -> FilePath -> FilePath
Show


---------------------------------------------------------------------
-- YAML PARSING LIBRARY

data Val = Val
    Value -- the actual value I'm focused on
    [(String, Value)] -- the path of values I followed (for error messages)

newVal :: Value -> Val
newVal :: Value -> Val
newVal x :: Value
x = Value -> [(FilePath, Value)] -> Val
Val Value
x [("root", Value
x)]

getVal :: Val -> Value
getVal :: Val -> Value
getVal (Val x :: Value
x _) = Value
x

addVal :: String -> Value -> Val -> Val
addVal :: FilePath -> Value -> Val -> Val
addVal key :: FilePath
key v :: Value
v (Val focus :: Value
focus path :: [(FilePath, Value)]
path) = Value -> [(FilePath, Value)] -> Val
Val Value
v ([(FilePath, Value)] -> Val) -> [(FilePath, Value)] -> Val
forall a b. (a -> b) -> a -> b
$ (FilePath
key,Value
v) (FilePath, Value) -> [(FilePath, Value)] -> [(FilePath, Value)]
forall a. a -> [a] -> [a]
: [(FilePath, Value)]
path

-- | Failed when parsing some value, give an informative error message.
parseFail :: Val -> String -> Parser a
parseFail :: Val -> FilePath -> Parser a
parseFail (Val focus :: Value
focus path :: [(FilePath, Value)]
path) msg :: FilePath
msg = FilePath -> Parser a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Parser a) -> FilePath -> Parser a
forall a b. (a -> b) -> a -> b
$
    "Error when decoding YAML, " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
msg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
    "Along path: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords [FilePath]
steps FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
    "When at: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst (FilePath -> (FilePath, FilePath)
word1 (FilePath -> (FilePath, FilePath))
-> FilePath -> (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ Value -> FilePath
forall a. Show a => a -> FilePath
show Value
focus) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
    -- aim to show a smallish but relevant context
    ByteString -> FilePath
dotDot (ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
focus) (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> Maybe ByteString
forall a. [a] -> Maybe a
listToMaybe ([ByteString] -> Maybe ByteString)
-> [ByteString] -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\x :: ByteString
x -> ByteString -> Int
BS.length ByteString
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 250) ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ (Value -> ByteString) -> [Value] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode [Value]
contexts)
    where
        (steps :: [FilePath]
steps, contexts :: [Value]
contexts) = [(FilePath, Value)] -> ([FilePath], [Value])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(FilePath, Value)] -> ([FilePath], [Value]))
-> [(FilePath, Value)] -> ([FilePath], [Value])
forall a b. (a -> b) -> a -> b
$ [(FilePath, Value)] -> [(FilePath, Value)]
forall a. [a] -> [a]
reverse [(FilePath, Value)]
path
        dotDot :: ByteString -> FilePath
dotDot x :: ByteString
x = let (a :: ByteString
a,b :: ByteString
b) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt 250 ByteString
x in ByteString -> FilePath
BS.unpack ByteString
a FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (if ByteString -> Bool
BS.null ByteString
b then "" else "...")

parseArray :: Val -> Parser [Val]
parseArray :: Val -> Parser [Val]
parseArray v :: Val
v@(Val -> Value
getVal -> Array xs :: Array
xs) = (Val -> Parser [Val]) -> [Val] -> Parser [Val]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM Val -> Parser [Val]
parseArray ([Val] -> Parser [Val]) -> [Val] -> Parser [Val]
forall a b. (a -> b) -> a -> b
$ (Integer -> Value -> Val) -> [Integer] -> [Value] -> [Val]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\i :: Integer
i x :: Value
x -> FilePath -> Value -> Val -> Val
addVal (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
i) Value
x Val
v) [0..] ([Value] -> [Val]) -> [Value] -> [Val]
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
xs
parseArray v :: Val
v = [Val] -> Parser [Val]
forall (m :: * -> *) a. Monad m => a -> m a
return [Val
v]

parseObject :: Val -> Parser (Map.HashMap T.Text Value)
parseObject :: Val -> Parser (HashMap Text Value)
parseObject (Val -> Value
getVal -> Object x :: HashMap Text Value
x) = HashMap Text Value -> Parser (HashMap Text Value)
forall (m :: * -> *) a. Monad m => a -> m a
return HashMap Text Value
x
parseObject v :: Val
v = Val -> FilePath -> Parser (HashMap Text Value)
forall a. Val -> FilePath -> Parser a
parseFail Val
v "Expected an Object"

parseObject1 :: Val -> Parser (String, Val)
parseObject1 :: Val -> Parser (FilePath, Val)
parseObject1 v :: Val
v = do
    HashMap Text Value
mp <- Val -> Parser (HashMap Text Value)
parseObject Val
v
    case HashMap Text Value -> [Text]
forall k v. HashMap k v -> [k]
Map.keys HashMap Text Value
mp of
        [Text -> FilePath
T.unpack -> FilePath
s] -> (FilePath
s,) (Val -> (FilePath, Val)) -> Parser Val -> Parser (FilePath, Val)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Val -> Parser Val
parseField FilePath
s Val
v
        _ -> Val -> FilePath -> Parser (FilePath, Val)
forall a. Val -> FilePath -> Parser a
parseFail Val
v (FilePath -> Parser (FilePath, Val))
-> FilePath -> Parser (FilePath, Val)
forall a b. (a -> b) -> a -> b
$ "Expected exactly one key but got " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (HashMap Text Value -> Int
forall k v. HashMap k v -> Int
Map.size HashMap Text Value
mp)

parseString :: Val -> Parser String
parseString :: Val -> Parser FilePath
parseString (Val -> Value
getVal -> String x :: Text
x) = FilePath -> Parser FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Parser FilePath) -> FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
x
parseString v :: Val
v = Val -> FilePath -> Parser FilePath
forall a. Val -> FilePath -> Parser a
parseFail Val
v "Expected a String"

parseInt :: Val -> Parser Int
parseInt :: Val -> Parser Int
parseInt (Val -> Value
getVal -> s :: Value
s@Number{}) = Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON Value
s
parseInt v :: Val
v = Val -> FilePath -> Parser Int
forall a. Val -> FilePath -> Parser a
parseFail Val
v "Expected an Int"

parseArrayString :: Val -> Parser [String]
parseArrayString :: Val -> Parser [FilePath]
parseArrayString = Val -> Parser [Val]
parseArray (Val -> Parser [Val])
-> ([Val] -> Parser [FilePath]) -> Val -> Parser [FilePath]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Val -> Parser FilePath) -> [Val] -> Parser [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Val -> Parser FilePath
parseString

parseBool :: Val -> Parser Bool
parseBool :: Val -> Parser Bool
parseBool (Val -> Value
getVal -> Bool b :: Bool
b) = Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
b
parseBool v :: Val
v = Val -> FilePath -> Parser Bool
forall a. Val -> FilePath -> Parser a
parseFail Val
v "Expected a Bool"

parseField :: String -> Val -> Parser Val
parseField :: FilePath -> Val -> Parser Val
parseField s :: FilePath
s v :: Val
v = do
    Maybe Val
x <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt FilePath
s Val
v
    case Maybe Val
x of
        Nothing -> Val -> FilePath -> Parser Val
forall a. Val -> FilePath -> Parser a
parseFail Val
v (FilePath -> Parser Val) -> FilePath -> Parser Val
forall a b. (a -> b) -> a -> b
$ "Expected a field named " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
        Just v :: Val
v -> Val -> Parser Val
forall (m :: * -> *) a. Monad m => a -> m a
return Val
v

parseFieldOpt :: String -> Val -> Parser (Maybe Val)
parseFieldOpt :: FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt s :: FilePath
s v :: Val
v = do
    HashMap Text Value
mp <- Val -> Parser (HashMap Text Value)
parseObject Val
v
    case Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (FilePath -> Text
T.pack FilePath
s) HashMap Text Value
mp of
        Nothing -> Maybe Val -> Parser (Maybe Val)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Val
forall a. Maybe a
Nothing
        Just x :: Value
x -> Maybe Val -> Parser (Maybe Val)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Val -> Parser (Maybe Val))
-> Maybe Val -> Parser (Maybe Val)
forall a b. (a -> b) -> a -> b
$ Val -> Maybe Val
forall a. a -> Maybe a
Just (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ FilePath -> Value -> Val -> Val
addVal FilePath
s Value
x Val
v

allowFields :: Val -> [String] -> Parser ()
allowFields :: Val -> [FilePath] -> Parser ()
allowFields v :: Val
v allow :: [FilePath]
allow = do
    HashMap Text Value
mp <- Val -> Parser (HashMap Text Value)
parseObject Val
v
    let bad :: [FilePath]
bad = (Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
T.unpack (HashMap Text Value -> [Text]
forall k v. HashMap k v -> [k]
Map.keys HashMap Text Value
mp) [FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath]
allow
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([FilePath]
bad [FilePath] -> [FilePath] -> Bool
forall a. Eq a => a -> a -> Bool
/= []) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
        Val -> FilePath -> Parser ()
forall a. Val -> FilePath -> Parser a
parseFail Val
v (FilePath -> Parser ()) -> FilePath -> Parser ()
forall a b. (a -> b) -> a -> b
$ "Not allowed keys: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords [FilePath]
bad

parseHSE :: (ParseMode -> String -> ParseResult v) -> Val -> Parser v
parseHSE :: (ParseMode -> FilePath -> ParseResult v) -> Val -> Parser v
parseHSE parser :: ParseMode -> FilePath -> ParseResult v
parser v :: Val
v = do
    FilePath
x <- Val -> Parser FilePath
parseString Val
v
    case ParseMode -> FilePath -> ParseResult v
parser ParseMode
defaultParseMode{extensions :: [Extension]
extensions=[Extension]
defaultExtensions} FilePath
x of
        ParseOk x :: v
x -> v -> Parser v
forall (m :: * -> *) a. Monad m => a -> m a
return v
x
        ParseFailed loc :: SrcLoc
loc s :: FilePath
s -> Val -> FilePath -> Parser v
forall a. Val -> FilePath -> Parser a
parseFail Val
v (FilePath -> Parser v) -> FilePath -> Parser v
forall a b. (a -> b) -> a -> b
$ "Failed to parse " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ", when parsing:\n  " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x


---------------------------------------------------------------------
-- YAML TO DATA TYPE

instance FromJSON ConfigYaml where
    parseJSON :: Value -> Parser ConfigYaml
parseJSON Null = ConfigYaml -> Parser ConfigYaml
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigYaml
forall a. Monoid a => a
mempty
    parseJSON x :: Value
x = Val -> Parser ConfigYaml
parseConfigYaml (Val -> Parser ConfigYaml) -> Val -> Parser ConfigYaml
forall a b. (a -> b) -> a -> b
$ Value -> Val
newVal Value
x

parseConfigYaml :: Val -> Parser ConfigYaml
parseConfigYaml :: Val -> Parser ConfigYaml
parseConfigYaml v :: Val
v = do
    [Val]
vs <- Val -> Parser [Val]
parseArray Val
v
    ([ConfigItem] -> ConfigYaml)
-> Parser [ConfigItem] -> Parser ConfigYaml
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ConfigItem] -> ConfigYaml
ConfigYaml (Parser [ConfigItem] -> Parser ConfigYaml)
-> Parser [ConfigItem] -> Parser ConfigYaml
forall a b. (a -> b) -> a -> b
$ [Val] -> (Val -> Parser ConfigItem) -> Parser [ConfigItem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Val]
vs ((Val -> Parser ConfigItem) -> Parser [ConfigItem])
-> (Val -> Parser ConfigItem) -> Parser [ConfigItem]
forall a b. (a -> b) -> a -> b
$ \o :: Val
o@Val
v -> do
        (s :: FilePath
s, v :: Val
v) <- Val -> Parser (FilePath, Val)
parseObject1 Val
v
        case FilePath
s of
            "package" -> Package -> ConfigItem
ConfigPackage (Package -> ConfigItem) -> Parser Package -> Parser ConfigItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Val -> Parser Package
parsePackage Val
v
            "group" -> Group -> ConfigItem
ConfigGroup (Group -> ConfigItem) -> Parser Group -> Parser ConfigItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Val -> Parser Group
parseGroup Val
v
            "arguments" -> [Setting] -> ConfigItem
ConfigSetting ([Setting] -> ConfigItem)
-> ([FilePath] -> [Setting]) -> [FilePath] -> ConfigItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Setting) -> [FilePath] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Setting
SettingArgument ([FilePath] -> ConfigItem)
-> Parser [FilePath] -> Parser ConfigItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Val -> Parser [FilePath]
parseArrayString Val
v
            "fixity" -> [Setting] -> ConfigItem
ConfigSetting ([Setting] -> ConfigItem) -> Parser [Setting] -> Parser ConfigItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Val -> Parser [Setting]
parseFixity Val
v
            "smell" -> [Setting] -> ConfigItem
ConfigSetting ([Setting] -> ConfigItem) -> Parser [Setting] -> Parser ConfigItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Val -> Parser [Setting]
parseSmell Val
v
            _ | Maybe Severity -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Severity -> Bool) -> Maybe Severity -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe Severity
getSeverity FilePath
s -> Group -> ConfigItem
ConfigGroup (Group -> ConfigItem)
-> ([Either HintRule Classify] -> Group)
-> [Either HintRule Classify]
-> ConfigItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either HintRule Classify] -> Group
ruleToGroup ([Either HintRule Classify] -> ConfigItem)
-> Parser [Either HintRule Classify] -> Parser ConfigItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Val -> Parser [Either HintRule Classify]
parseRule Val
o
            _ | Just r :: RestrictType
r <- FilePath -> Maybe RestrictType
getRestrictType FilePath
s -> [Setting] -> ConfigItem
ConfigSetting ([Setting] -> ConfigItem)
-> ([Restrict] -> [Setting]) -> [Restrict] -> ConfigItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Restrict -> Setting) -> [Restrict] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Restrict -> Setting
SettingRestrict ([Restrict] -> ConfigItem)
-> Parser [Restrict] -> Parser ConfigItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Val -> Parser [Val]
parseArray Val
v Parser [Val] -> ([Val] -> Parser [Restrict]) -> Parser [Restrict]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Val -> Parser Restrict) -> [Val] -> Parser [Restrict]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (RestrictType -> Val -> Parser Restrict
parseRestrict RestrictType
r))
            _ -> Val -> FilePath -> Parser ConfigItem
forall a. Val -> FilePath -> Parser a
parseFail Val
v "Expecting an object with a 'package' or 'group' key, a hint or a restriction"


parsePackage :: Val -> Parser Package
parsePackage :: Val -> Parser Package
parsePackage v :: Val
v = do
    FilePath
packageName <- FilePath -> Val -> Parser Val
parseField "name" Val
v Parser Val -> (Val -> Parser FilePath) -> Parser FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Val -> Parser FilePath
parseString
    [ImportDecl S]
packageModules <- FilePath -> Val -> Parser Val
parseField "modules" Val
v Parser Val -> (Val -> Parser [Val]) -> Parser [Val]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Val -> Parser [Val]
parseArray Parser [Val]
-> ([Val] -> Parser [ImportDecl S]) -> Parser [ImportDecl S]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Val -> Parser (ImportDecl S)) -> [Val] -> Parser [ImportDecl S]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ParseMode -> FilePath -> ParseResult (ImportDecl S))
-> Val -> Parser (ImportDecl S)
forall v.
(ParseMode -> FilePath -> ParseResult v) -> Val -> Parser v
parseHSE ParseMode -> FilePath -> ParseResult (ImportDecl S)
parseImportDeclWithMode)
    Val -> [FilePath] -> Parser ()
allowFields Val
v ["name","modules"]
    Package -> Parser Package
forall (m :: * -> *) a. Monad m => a -> m a
return Package :: FilePath -> [ImportDecl S] -> Package
Package{..}

parseFixity :: Val -> Parser [Setting]
parseFixity :: Val -> Parser [Setting]
parseFixity v :: Val
v = Val -> Parser [Val]
parseArray Val
v Parser [Val] -> ([Val] -> Parser [Setting]) -> Parser [Setting]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Val -> Parser [Setting]) -> [Val] -> Parser [Setting]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM ((ParseMode -> FilePath -> ParseResult (Decl S))
-> Val -> Parser (Decl S)
forall v.
(ParseMode -> FilePath -> ParseResult v) -> Val -> Parser v
parseHSE ParseMode -> FilePath -> ParseResult (Decl S)
parseDeclWithMode (Val -> Parser (Decl S))
-> (Decl S -> Parser [Setting]) -> Val -> Parser [Setting]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Decl S -> Parser [Setting]
forall a. Decl a -> Parser [Setting]
f)
    where
        f :: Decl a -> Parser [Setting]
f x :: Decl a
x@InfixDecl{} = [Setting] -> Parser [Setting]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Setting] -> Parser [Setting]) -> [Setting] -> Parser [Setting]
forall a b. (a -> b) -> a -> b
$ (Fixity -> Setting) -> [Fixity] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Fixity -> Setting
Infix ([Fixity] -> [Setting]) -> [Fixity] -> [Setting]
forall a b. (a -> b) -> a -> b
$ Decl a -> [Fixity]
forall a. Decl a -> [Fixity]
getFixity Decl a
x
        f _ = Val -> FilePath -> Parser [Setting]
forall a. Val -> FilePath -> Parser a
parseFail Val
v "Expected fixity declaration"

parseSmell :: Val -> Parser [Setting]
parseSmell :: Val -> Parser [Setting]
parseSmell v :: Val
v = do
  FilePath
smellName <- FilePath -> Val -> Parser Val
parseField "type" Val
v Parser Val -> (Val -> Parser FilePath) -> Parser FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Val -> Parser FilePath
parseString
  SmellType
smellType <- Val -> FilePath -> Maybe SmellType -> Parser SmellType
forall a. Val -> FilePath -> Maybe a -> Parser a
require Val
v "Expected SmellType"  (Maybe SmellType -> Parser SmellType)
-> Maybe SmellType -> Parser SmellType
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe SmellType
getSmellType FilePath
smellName
  Int
smellLimit <- FilePath -> Val -> Parser Val
parseField "limit" Val
v Parser Val -> (Val -> Parser Int) -> Parser Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Val -> Parser Int
parseInt
  [Setting] -> Parser [Setting]
forall (m :: * -> *) a. Monad m => a -> m a
return [SmellType -> Int -> Setting
SettingSmell SmellType
smellType Int
smellLimit]
    where
      require :: Val -> String -> Maybe a -> Parser a
      require :: Val -> FilePath -> Maybe a -> Parser a
require _ _ (Just a :: a
a) = a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
      require val :: Val
val err :: FilePath
err Nothing = Val -> FilePath -> Parser a
forall a. Val -> FilePath -> Parser a
parseFail Val
val FilePath
err 

parseGroup :: Val -> Parser Group
parseGroup :: Val -> Parser Group
parseGroup v :: Val
v = do
    FilePath
groupName <- FilePath -> Val -> Parser Val
parseField "name" Val
v Parser Val -> (Val -> Parser FilePath) -> Parser FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Val -> Parser FilePath
parseString
    Bool
groupEnabled <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "enabled" Val
v Parser (Maybe Val) -> (Maybe Val -> Parser Bool) -> Parser Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser Bool -> (Val -> Parser Bool) -> Maybe Val -> Parser Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) Val -> Parser Bool
parseBool
    [Either FilePath (ImportDecl S)]
groupImports <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "imports" Val
v Parser (Maybe Val)
-> (Maybe Val -> Parser [Either FilePath (ImportDecl S)])
-> Parser [Either FilePath (ImportDecl S)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser [Either FilePath (ImportDecl S)]
-> (Val -> Parser [Either FilePath (ImportDecl S)])
-> Maybe Val
-> Parser [Either FilePath (ImportDecl S)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Either FilePath (ImportDecl S)]
-> Parser [Either FilePath (ImportDecl S)]
forall (m :: * -> *) a. Monad m => a -> m a
return []) (Val -> Parser [Val]
parseArray (Val -> Parser [Val])
-> ([Val] -> Parser [Either FilePath (ImportDecl S)])
-> Val
-> Parser [Either FilePath (ImportDecl S)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Val -> Parser (Either FilePath (ImportDecl S)))
-> [Val] -> Parser [Either FilePath (ImportDecl S)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Val -> Parser (Either FilePath (ImportDecl S))
parseImport)
    [Either HintRule Classify]
groupRules <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "rules" Val
v Parser (Maybe Val) -> (Maybe Val -> Parser [Val]) -> Parser [Val]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser [Val] -> (Val -> Parser [Val]) -> Maybe Val -> Parser [Val]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Val] -> Parser [Val]
forall (m :: * -> *) a. Monad m => a -> m a
return []) Val -> Parser [Val]
parseArray Parser [Val]
-> ([Val] -> Parser [Either HintRule Classify])
-> Parser [Either HintRule Classify]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Val -> Parser [Either HintRule Classify])
-> [Val] -> Parser [Either HintRule Classify]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM Val -> Parser [Either HintRule Classify]
parseRule
    Val -> [FilePath] -> Parser ()
allowFields Val
v ["name","enabled","imports","rules"]
    Group -> Parser Group
forall (m :: * -> *) a. Monad m => a -> m a
return Group :: FilePath
-> Bool
-> [Either FilePath (ImportDecl S)]
-> [Either HintRule Classify]
-> Group
Group{..}
    where
        parseImport :: Val -> Parser (Either FilePath (ImportDecl S))
parseImport v :: Val
v = do
            FilePath
x <- Val -> Parser FilePath
parseString Val
v
            case FilePath -> (FilePath, FilePath)
word1 FilePath
x of
                ("package", x :: FilePath
x) -> Either FilePath (ImportDecl S)
-> Parser (Either FilePath (ImportDecl S))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath (ImportDecl S)
 -> Parser (Either FilePath (ImportDecl S)))
-> Either FilePath (ImportDecl S)
-> Parser (Either FilePath (ImportDecl S))
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath (ImportDecl S)
forall a b. a -> Either a b
Left FilePath
x
                _ -> ImportDecl S -> Either FilePath (ImportDecl S)
forall a b. b -> Either a b
Right (ImportDecl S -> Either FilePath (ImportDecl S))
-> Parser (ImportDecl S) -> Parser (Either FilePath (ImportDecl S))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParseMode -> FilePath -> ParseResult (ImportDecl S))
-> Val -> Parser (ImportDecl S)
forall v.
(ParseMode -> FilePath -> ParseResult v) -> Val -> Parser v
parseHSE ParseMode -> FilePath -> ParseResult (ImportDecl S)
parseImportDeclWithMode Val
v

ruleToGroup :: [Either HintRule Classify] -> Group
ruleToGroup :: [Either HintRule Classify] -> Group
ruleToGroup = FilePath
-> Bool
-> [Either FilePath (ImportDecl S)]
-> [Either HintRule Classify]
-> Group
Group "" Bool
True []

parseRule :: Val -> Parser [Either HintRule Classify]
parseRule :: Val -> Parser [Either HintRule Classify]
parseRule v :: Val
v = do
    (severity :: Severity
severity, v :: Val
v) <- Val -> Parser (Severity, Val)
parseSeverityKey Val
v
    Bool
isRule <- Maybe Val -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Val -> Bool) -> Parser (Maybe Val) -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "lhs" Val
v
    if Bool
isRule then do
        Exp S
hintRuleLHS <- FilePath -> Val -> Parser Val
parseField "lhs" Val
v Parser Val -> (Val -> Parser (Exp S)) -> Parser (Exp S)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ParseMode -> FilePath -> ParseResult (Exp S))
-> Val -> Parser (Exp S)
forall v.
(ParseMode -> FilePath -> ParseResult v) -> Val -> Parser v
parseHSE ParseMode -> FilePath -> ParseResult (Exp S)
parseExpWithMode
        Exp S
hintRuleRHS <- FilePath -> Val -> Parser Val
parseField "rhs" Val
v Parser Val -> (Val -> Parser (Exp S)) -> Parser (Exp S)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ParseMode -> FilePath -> ParseResult (Exp S))
-> Val -> Parser (Exp S)
forall v.
(ParseMode -> FilePath -> ParseResult v) -> Val -> Parser v
parseHSE ParseMode -> FilePath -> ParseResult (Exp S)
parseExpWithMode
        [Note]
hintRuleNotes <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "note" Val
v Parser (Maybe Val) -> (Maybe Val -> Parser [Note]) -> Parser [Note]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser [Note]
-> (Val -> Parser [Note]) -> Maybe Val -> Parser [Note]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Note] -> Parser [Note]
forall (m :: * -> *) a. Monad m => a -> m a
return []) (([FilePath] -> [Note]) -> Parser [FilePath] -> Parser [Note]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> Note) -> [FilePath] -> [Note]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Note
asNote) (Parser [FilePath] -> Parser [Note])
-> (Val -> Parser [FilePath]) -> Val -> Parser [Note]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val -> Parser [FilePath]
parseArrayString)
        FilePath
hintRuleName <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "name" Val
v Parser (Maybe Val)
-> (Maybe Val -> Parser FilePath) -> Parser FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser FilePath
-> (Val -> Parser FilePath) -> Maybe Val -> Parser FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> Parser FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Parser FilePath) -> FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ Exp S -> Exp S -> FilePath
guessName Exp S
hintRuleLHS Exp S
hintRuleRHS) Val -> Parser FilePath
parseString
        Maybe (Exp S)
hintRuleSide <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "side" Val
v Parser (Maybe Val)
-> (Maybe Val -> Parser (Maybe (Exp S))) -> Parser (Maybe (Exp S))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser (Maybe (Exp S))
-> (Val -> Parser (Maybe (Exp S)))
-> Maybe Val
-> Parser (Maybe (Exp S))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (Exp S) -> Parser (Maybe (Exp S))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Exp S)
forall a. Maybe a
Nothing) ((Exp S -> Maybe (Exp S))
-> Parser (Exp S) -> Parser (Maybe (Exp S))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp S -> Maybe (Exp S)
forall a. a -> Maybe a
Just (Parser (Exp S) -> Parser (Maybe (Exp S)))
-> (Val -> Parser (Exp S)) -> Val -> Parser (Maybe (Exp S))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseMode -> FilePath -> ParseResult (Exp S))
-> Val -> Parser (Exp S)
forall v.
(ParseMode -> FilePath -> ParseResult v) -> Val -> Parser v
parseHSE ParseMode -> FilePath -> ParseResult (Exp S)
parseExpWithMode)
        Val -> [FilePath] -> Parser ()
allowFields Val
v ["lhs","rhs","note","name","side"]
        let hintRuleScope :: Scope
hintRuleScope = Scope
forall a. Monoid a => a
mempty
        [Either HintRule Classify] -> Parser [Either HintRule Classify]
forall (m :: * -> *) a. Monad m => a -> m a
return [HintRule -> Either HintRule Classify
forall a b. a -> Either a b
Left HintRule :: Severity
-> FilePath
-> Scope
-> Exp S
-> Exp S
-> Maybe (Exp S)
-> [Note]
-> HintRule
HintRule{hintRuleSeverity :: Severity
hintRuleSeverity=Severity
severity, ..}]
     else do
        [FilePath]
names <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "name" Val
v Parser (Maybe Val)
-> (Maybe Val -> Parser [FilePath]) -> Parser [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser [FilePath]
-> (Val -> Parser [FilePath]) -> Maybe Val -> Parser [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([FilePath] -> Parser [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []) Val -> Parser [FilePath]
parseArrayString
        [(FilePath, FilePath)]
within <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "within" Val
v Parser (Maybe Val)
-> (Maybe Val -> Parser [(FilePath, FilePath)])
-> Parser [(FilePath, FilePath)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser [(FilePath, FilePath)]
-> (Val -> Parser [(FilePath, FilePath)])
-> Maybe Val
-> Parser [(FilePath, FilePath)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([(FilePath, FilePath)] -> Parser [(FilePath, FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return [("","")]) (Val -> Parser [Val]
parseArray (Val -> Parser [Val])
-> ([Val] -> Parser [(FilePath, FilePath)])
-> Val
-> Parser [(FilePath, FilePath)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Val -> Parser [(FilePath, FilePath)])
-> [Val] -> Parser [(FilePath, FilePath)]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM Val -> Parser [(FilePath, FilePath)]
parseWithin)
        [Either HintRule Classify] -> Parser [Either HintRule Classify]
forall (m :: * -> *) a. Monad m => a -> m a
return [Classify -> Either HintRule Classify
forall a b. b -> Either a b
Right (Classify -> Either HintRule Classify)
-> Classify -> Either HintRule Classify
forall a b. (a -> b) -> a -> b
$ Severity -> FilePath -> FilePath -> FilePath -> Classify
Classify Severity
severity FilePath
n FilePath
a FilePath
b | (a :: FilePath
a,b :: FilePath
b) <- [(FilePath, FilePath)]
within, FilePath
n <- ["" | [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
names] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
names]

parseRestrict :: RestrictType -> Val -> Parser Restrict
parseRestrict :: RestrictType -> Val -> Parser Restrict
parseRestrict restrictType :: RestrictType
restrictType v :: Val
v = do
    Maybe Val
def <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "default" Val
v
    case Maybe Val
def of
        Just def :: Val
def -> do
            Bool
b <- Val -> Parser Bool
parseBool Val
def
            Val -> [FilePath] -> Parser ()
allowFields Val
v ["default"]
            Restrict -> Parser Restrict
forall (m :: * -> *) a. Monad m => a -> m a
return (Restrict -> Parser Restrict) -> Restrict -> Parser Restrict
forall a b. (a -> b) -> a -> b
$ RestrictType
-> Bool
-> [FilePath]
-> [FilePath]
-> [(FilePath, FilePath)]
-> Restrict
Restrict RestrictType
restrictType Bool
b [] [] []
        Nothing -> do
            [FilePath]
restrictName <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "name" Val
v Parser (Maybe Val)
-> (Maybe Val -> Parser [FilePath]) -> Parser [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser [FilePath]
-> (Val -> Parser [FilePath]) -> Maybe Val -> Parser [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([FilePath] -> Parser [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []) Val -> Parser [FilePath]
parseArrayString
            [(FilePath, FilePath)]
restrictWithin <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "within" Val
v Parser (Maybe Val)
-> (Maybe Val -> Parser [(FilePath, FilePath)])
-> Parser [(FilePath, FilePath)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser [(FilePath, FilePath)]
-> (Val -> Parser [(FilePath, FilePath)])
-> Maybe Val
-> Parser [(FilePath, FilePath)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([(FilePath, FilePath)] -> Parser [(FilePath, FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return [("","")]) (Val -> Parser [Val]
parseArray (Val -> Parser [Val])
-> ([Val] -> Parser [(FilePath, FilePath)])
-> Val
-> Parser [(FilePath, FilePath)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Val -> Parser [(FilePath, FilePath)])
-> [Val] -> Parser [(FilePath, FilePath)]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM Val -> Parser [(FilePath, FilePath)]
parseWithin)
            [FilePath]
restrictAs <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "as" Val
v Parser (Maybe Val)
-> (Maybe Val -> Parser [FilePath]) -> Parser [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser [FilePath]
-> (Val -> Parser [FilePath]) -> Maybe Val -> Parser [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([FilePath] -> Parser [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []) Val -> Parser [FilePath]
parseArrayString
            Val -> [FilePath] -> Parser ()
allowFields Val
v ([FilePath] -> Parser ()) -> [FilePath] -> Parser ()
forall a b. (a -> b) -> a -> b
$ ["as" | RestrictType
restrictType RestrictType -> RestrictType -> Bool
forall a. Eq a => a -> a -> Bool
== RestrictType
RestrictModule] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ["name","within"]
            Restrict -> Parser Restrict
forall (m :: * -> *) a. Monad m => a -> m a
return Restrict :: RestrictType
-> Bool
-> [FilePath]
-> [FilePath]
-> [(FilePath, FilePath)]
-> Restrict
Restrict{restrictDefault :: Bool
restrictDefault=Bool
True,..}

parseWithin :: Val -> Parser [(String, String)] -- (module, decl)
parseWithin :: Val -> Parser [(FilePath, FilePath)]
parseWithin v :: Val
v = do
    Exp S
x <- (ParseMode -> FilePath -> ParseResult (Exp S))
-> Val -> Parser (Exp S)
forall v.
(ParseMode -> FilePath -> ParseResult v) -> Val -> Parser v
parseHSE ParseMode -> FilePath -> ParseResult (Exp S)
parseExpWithMode Val
v
    case Exp S
x of
        Var _ (UnQual _ name :: Name S
name) -> [(FilePath, FilePath)] -> Parser [(FilePath, FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return [("",Name S -> FilePath
forall a. Named a => a -> FilePath
fromNamed Name S
name)]
        Var _ (Qual _ (ModuleName _ mod :: FilePath
mod) name :: Name S
name) -> [(FilePath, FilePath)] -> Parser [(FilePath, FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath
mod, Name S -> FilePath
forall a. Named a => a -> FilePath
fromNamed Name S
name)]
        Con _ (UnQual _ name :: Name S
name) -> [(FilePath, FilePath)] -> Parser [(FilePath, FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Name S -> FilePath
forall a. Named a => a -> FilePath
fromNamed Name S
name,""),("",Name S -> FilePath
forall a. Named a => a -> FilePath
fromNamed Name S
name)]
        Con _ (Qual _ (ModuleName _ mod :: FilePath
mod) name :: Name S
name) -> [(FilePath, FilePath)] -> Parser [(FilePath, FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath
mod FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Name S -> FilePath
forall a. Named a => a -> FilePath
fromNamed Name S
name,""),(FilePath
mod,Name S -> FilePath
forall a. Named a => a -> FilePath
fromNamed Name S
name)]
        _ -> Val -> FilePath -> Parser [(FilePath, FilePath)]
forall a. Val -> FilePath -> Parser a
parseFail Val
v "Bad classification rule"

parseSeverityKey :: Val -> Parser (Severity, Val)
parseSeverityKey :: Val -> Parser (Severity, Val)
parseSeverityKey v :: Val
v = do
    (s :: FilePath
s, v :: Val
v) <- Val -> Parser (FilePath, Val)
parseObject1 Val
v
    case FilePath -> Maybe Severity
getSeverity FilePath
s of
        Just sev :: Severity
sev -> (Severity, Val) -> Parser (Severity, Val)
forall (m :: * -> *) a. Monad m => a -> m a
return (Severity
sev, Val
v)
        _ -> Val -> FilePath -> Parser (Severity, Val)
forall a. Val -> FilePath -> Parser a
parseFail Val
v (FilePath -> Parser (Severity, Val))
-> FilePath -> Parser (Severity, Val)
forall a b. (a -> b) -> a -> b
$ "Key should be a severity (e.g. warn/error/suggest) but got " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s


guessName :: Exp_ -> Exp_ -> String
guessName :: Exp S -> Exp S -> FilePath
guessName lhs :: Exp S
lhs rhs :: Exp S
rhs
    | n :: FilePath
n:_ <- [FilePath]
rs [FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath]
ls = "Use " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
n
    | n :: FilePath
n:_ <- [FilePath]
ls [FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath]
rs = "Redundant " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
n
    | Bool
otherwise = FilePath
defaultHintName
    where
        (ls :: [FilePath]
ls, rs :: [FilePath]
rs) = (Exp S -> [FilePath]) -> (Exp S, Exp S) -> ([FilePath], [FilePath])
forall a b. (a -> b) -> (a, a) -> (b, b)
both Exp S -> [FilePath]
f (Exp S
lhs, Exp S
rhs)
        f :: Exp S -> [FilePath]
f = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
isUnifyVar) ([FilePath] -> [FilePath])
-> (Exp S -> [FilePath]) -> Exp S -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name S -> FilePath) -> [Name S] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: Name S
x -> Name S -> FilePath
forall a. Named a => a -> FilePath
fromNamed (Name S
x :: Name S)) ([Name S] -> [FilePath])
-> (Exp S -> [Name S]) -> Exp S -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp S -> [Name S]
forall x (f :: * -> *). (Data x, Data (f S)) => x -> [f S]
childrenS


asNote :: String -> Note
asNote :: FilePath -> Note
asNote "IncreasesLaziness" = Note
IncreasesLaziness
asNote "DecreasesLaziness" = Note
DecreasesLaziness
asNote (FilePath -> (FilePath, FilePath)
word1 -> ("RemovesError",x :: FilePath
x)) = FilePath -> Note
RemovesError FilePath
x
asNote (FilePath -> (FilePath, FilePath)
word1 -> ("ValidInstance",x :: FilePath
x)) = (FilePath -> FilePath -> Note) -> (FilePath, FilePath) -> Note
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FilePath -> FilePath -> Note
ValidInstance ((FilePath, FilePath) -> Note) -> (FilePath, FilePath) -> Note
forall a b. (a -> b) -> a -> b
$ FilePath -> (FilePath, FilePath)
word1 FilePath
x
asNote (FilePath -> (FilePath, FilePath)
word1 -> ("RequiresExtension",x :: FilePath
x)) = FilePath -> Note
RequiresExtension FilePath
x
asNote x :: FilePath
x = FilePath -> Note
Note FilePath
x


---------------------------------------------------------------------
-- SETTINGS

settingsFromConfigYaml :: [ConfigYaml] -> [Setting]
settingsFromConfigYaml :: [ConfigYaml] -> [Setting]
settingsFromConfigYaml ([ConfigYaml] -> ConfigYaml
forall a. Monoid a => [a] -> a
mconcat -> ConfigYaml configs :: [ConfigItem]
configs) = [Setting]
settings [Setting] -> [Setting] -> [Setting]
forall a. [a] -> [a] -> [a]
++ (Group -> [Setting]) -> [Group] -> [Setting]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Group -> [Setting]
f [Group]
groups
    where
        packages :: [Package]
packages = [Package
x | ConfigPackage x :: Package
x <- [ConfigItem]
configs]
        groups :: [Group]
groups = [Group
x | ConfigGroup x :: Group
x <- [ConfigItem]
configs]
        settings :: [Setting]
settings = [[Setting]] -> [Setting]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Setting]
x | ConfigSetting x :: [Setting]
x <- [ConfigItem]
configs]
        packageMap :: HashMap FilePath [ImportDecl S]
packageMap = ([ImportDecl S] -> [ImportDecl S] -> [ImportDecl S])
-> [(FilePath, [ImportDecl S])] -> HashMap FilePath [ImportDecl S]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
Map.fromListWith [ImportDecl S] -> [ImportDecl S] -> [ImportDecl S]
forall a. [a] -> [a] -> [a]
(++) [(FilePath
packageName, [ImportDecl S]
packageModules) | Package{..} <- [Package]
packages]
        groupMap :: HashMap FilePath Bool
groupMap = (Bool -> Bool -> Bool)
-> [(FilePath, Bool)] -> HashMap FilePath Bool
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
Map.fromListWith (\new :: Bool
new old :: Bool
old -> Bool
new) [(FilePath
groupName, Bool
groupEnabled) | Group{..} <- [Group]
groups]

        f :: Group -> [Setting]
f Group{..}
            | FilePath -> HashMap FilePath Bool -> Maybe Bool
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup FilePath
groupName HashMap FilePath Bool
groupMap Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False = []
            | Bool
otherwise = (Either HintRule Classify -> Setting)
-> [Either HintRule Classify] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map ((HintRule -> Setting)
-> (Classify -> Setting) -> Either HintRule Classify -> Setting
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\r :: HintRule
r -> HintRule -> Setting
SettingMatchExp HintRule
r{hintRuleScope :: Scope
hintRuleScope=Scope
scope}) Classify -> Setting
SettingClassify) [Either HintRule Classify]
groupRules
            where scope :: Scope
scope = HashMap FilePath [ImportDecl S]
-> [Either FilePath (ImportDecl S)] -> Scope
asScope HashMap FilePath [ImportDecl S]
packageMap [Either FilePath (ImportDecl S)]
groupImports

asScope :: Map.HashMap String [ImportDecl S] -> [Either String (ImportDecl S)] -> Scope
asScope :: HashMap FilePath [ImportDecl S]
-> [Either FilePath (ImportDecl S)] -> Scope
asScope packages :: HashMap FilePath [ImportDecl S]
packages xs :: [Either FilePath (ImportDecl S)]
xs = Module S -> Scope
scopeCreate (Module S -> Scope) -> Module S -> Scope
forall a b. (a -> b) -> a -> b
$ S
-> Maybe (ModuleHead S)
-> [ModulePragma S]
-> [ImportDecl S]
-> [Decl S]
-> Module S
forall l.
l
-> Maybe (ModuleHead l)
-> [ModulePragma l]
-> [ImportDecl l]
-> [Decl l]
-> Module l
Module S
an Maybe (ModuleHead S)
forall a. Maybe a
Nothing [] ((Either FilePath (ImportDecl S) -> [ImportDecl S])
-> [Either FilePath (ImportDecl S)] -> [ImportDecl S]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Either FilePath (ImportDecl S) -> [ImportDecl S]
f [Either FilePath (ImportDecl S)]
xs) []
    where
        f :: Either FilePath (ImportDecl S) -> [ImportDecl S]
f (Right x :: ImportDecl S
x) = [ImportDecl S
x]
        f (Left x :: FilePath
x) | Just pkg :: [ImportDecl S]
pkg <- FilePath -> HashMap FilePath [ImportDecl S] -> Maybe [ImportDecl S]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup FilePath
x HashMap FilePath [ImportDecl S]
packages = [ImportDecl S]
pkg
                   | Bool
otherwise = FilePath -> [ImportDecl S]
forall a. HasCallStack => FilePath -> a
error (FilePath -> [ImportDecl S]) -> FilePath -> [ImportDecl S]
forall a b. (a -> b) -> a -> b
$ "asScope failed to do lookup, " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x