{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings, ViewPatterns, RecordWildCards, GeneralizedNewtypeDeriving, TupleSections #-}

module Config.Yaml(
    ConfigYaml,
    ConfigYamlBuiltin (..),
    ConfigYamlUser (..),
    readFileConfigYaml,
    settingsFromConfigYaml,
    isBuiltinYaml,
    ) where

#if defined(MIN_VERSION_aeson)
#if MIN_VERSION_aeson(2,0,0)
#define AESON 2
#else
#define AESON 1
#endif
#else
#define AESON 2
#endif

import GHC.Driver.Ppr
import GHC.Driver.Errors.Types
import GHC.Types.Error hiding (Severity)

import Config.Type
import Data.Either.Extra
import Data.Maybe
import Data.List.NonEmpty qualified as NE
import Data.List.Extra
import Data.Tuple.Extra
import Control.Monad.Extra
import Data.Text qualified as T
import Data.Vector qualified as V
import Data.ByteString.Char8 qualified as BS
import Data.HashMap.Strict qualified as Map
import Data.Generics.Uniplate.DataOnly
import GHC.All
import Fixity
import Extension
import GHC.Unit.Module
import Data.Functor
import Data.Monoid
import Data.Semigroup
import Timing
import Prelude

import GHC.Data.Bag
import GHC.Parser.Lexer
import GHC.Utils.Error hiding (Severity)
import GHC.Hs
import GHC.Types.SrcLoc
import GHC.Types.Name.Reader
import GHC.Types.Name.Occurrence
import GHC.Util (baseDynFlags, Scope, scopeCreate)
import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances
import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader
import Data.Char
#if AESON == 2
import Data.Aeson.KeyMap (toHashMapText)
#endif

#ifdef HS_YAML

import Data.YAML (Pos)
import Data.YAML.Aeson (encode1Strict, decode1Strict)
import Data.Aeson hiding (encode)
import Data.Aeson.Types (Parser)
import Data.ByteString qualified as BSS

decodeFileEither :: FilePath -> IO (Either (Pos, String) ConfigYaml)
decodeFileEither path = decode1Strict <$> BSS.readFile path

decodeEither' :: BSS.ByteString -> Either (Pos, String) ConfigYaml
decodeEither' = decode1Strict

displayException :: (Pos, String) -> String
displayException = show

encode :: Value -> BSS.ByteString
encode = encode1Strict

#else

import Data.Yaml
import Control.Exception.Extra

#endif

#if AESON == 1
toHashMapText :: a -> a
toHashMapText = id
#endif

-- | 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 :: String -> Maybe String -> IO ConfigYaml
readFileConfigYaml String
file Maybe String
contents = String -> String -> IO ConfigYaml -> IO ConfigYaml
forall a. String -> String -> IO a -> IO a
timedIO String
"Config" String
file (IO ConfigYaml -> IO ConfigYaml) -> IO ConfigYaml -> IO ConfigYaml
forall a b. (a -> b) -> a -> b
$ do
    Either ParseException ConfigYaml
val <- case Maybe String
contents of
        Maybe String
Nothing ->
            if String -> Bool
isBuiltinYaml String
file
                then (ConfigYamlBuiltin -> ConfigYaml)
-> Either ParseException ConfigYamlBuiltin
-> Either ParseException ConfigYaml
forall b c a. (b -> c) -> Either a b -> Either a c
mapRight ConfigYamlBuiltin -> ConfigYaml
getConfigYamlBuiltin (Either ParseException ConfigYamlBuiltin
 -> Either ParseException ConfigYaml)
-> IO (Either ParseException ConfigYamlBuiltin)
-> IO (Either ParseException ConfigYaml)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Either ParseException ConfigYamlBuiltin)
forall a. FromJSON a => String -> IO (Either ParseException a)
decodeFileEither String
file
                else (ConfigYamlUser -> ConfigYaml)
-> Either ParseException ConfigYamlUser
-> Either ParseException ConfigYaml
forall b c a. (b -> c) -> Either a b -> Either a c
mapRight ConfigYamlUser -> ConfigYaml
getConfigYamlUser (Either ParseException ConfigYamlUser
 -> Either ParseException ConfigYaml)
-> IO (Either ParseException ConfigYamlUser)
-> IO (Either ParseException ConfigYaml)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Either ParseException ConfigYamlUser)
forall a. FromJSON a => String -> IO (Either ParseException a)
decodeFileEither String
file
        Just String
src -> Either ParseException ConfigYaml
-> IO (Either ParseException ConfigYaml)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseException ConfigYaml
 -> IO (Either ParseException ConfigYaml))
-> Either ParseException ConfigYaml
-> IO (Either ParseException ConfigYaml)
forall a b. (a -> b) -> a -> b
$
            if String -> Bool
isBuiltinYaml String
file
                then (ConfigYamlBuiltin -> ConfigYaml)
-> Either ParseException ConfigYamlBuiltin
-> Either ParseException ConfigYaml
forall b c a. (b -> c) -> Either a b -> Either a c
mapRight ConfigYamlBuiltin -> ConfigYaml
getConfigYamlBuiltin (Either ParseException ConfigYamlBuiltin
 -> Either ParseException ConfigYaml)
-> Either ParseException ConfigYamlBuiltin
-> Either ParseException ConfigYaml
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ParseException ConfigYamlBuiltin
forall a. FromJSON a => ByteString -> Either ParseException a
decodeEither' (ByteString -> Either ParseException ConfigYamlBuiltin)
-> ByteString -> Either ParseException ConfigYamlBuiltin
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack String
src
                else (ConfigYamlUser -> ConfigYaml)
-> Either ParseException ConfigYamlUser
-> Either ParseException ConfigYaml
forall b c a. (b -> c) -> Either a b -> Either a c
mapRight ConfigYamlUser -> ConfigYaml
getConfigYamlUser (Either ParseException ConfigYamlUser
 -> Either ParseException ConfigYaml)
-> Either ParseException ConfigYamlUser
-> Either ParseException ConfigYaml
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ParseException ConfigYamlUser
forall a. FromJSON a => ByteString -> Either ParseException a
decodeEither' (ByteString -> Either ParseException ConfigYamlUser)
-> ByteString -> Either ParseException ConfigYamlUser
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack String
src
    case Either ParseException ConfigYaml
val of
        Left ParseException
e -> String -> IO ConfigYaml
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ConfigYaml) -> String -> IO ConfigYaml
forall a b. (a -> b) -> a -> b
$ String
"Failed to read YAML configuration file " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ParseException -> String
forall e. Exception e => e -> String
displayException ParseException
e
        Right ConfigYaml
v -> ConfigYaml -> IO ConfigYaml
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigYaml
v

isBuiltinYaml :: FilePath -> Bool
isBuiltinYaml :: String -> Bool
isBuiltinYaml = (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"data/hlint.yaml")

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

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

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

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

data Group = Group
    {Group -> String
groupName :: String
    ,Group -> Bool
groupEnabled :: Bool
    ,Group -> [Either String (HsExtendInstances (LImportDecl GhcPs))]
groupImports :: [Either String (HsExtendInstances (LImportDecl GhcPs))]
    ,Group -> [Either HintRule Classify]
groupRules :: [Either HintRule Classify] -- HintRule has scope set to mempty
    } deriving Int -> Group -> String -> String
[Group] -> String -> String
Group -> String
(Int -> Group -> String -> String)
-> (Group -> String) -> ([Group] -> String -> String) -> Show Group
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Group -> String -> String
showsPrec :: Int -> Group -> String -> String
$cshow :: Group -> String
show :: Group -> String
$cshowList :: [Group] -> String -> String
showList :: [Group] -> String -> String
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 Value
x = Value -> [(String, Value)] -> Val
Val Value
x [(String
"root", Value
x)]

getVal :: Val -> Value
getVal :: Val -> Value
getVal (Val Value
x [(String, Value)]
_) = Value
x

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

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

parseArray :: Val -> Parser [Val]
parseArray :: Val -> Parser [Val]
parseArray v :: Val
v@(Val -> Value
getVal -> Array 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. Enum a => (a -> b -> c) -> a -> [b] -> [c]
zipWithFrom (\Integer
i Value
x -> String -> Value -> Val -> Val
addVal (Integer -> String
forall a. Show a => a -> String
show Integer
i) Value
x Val
v) Integer
0 ([Value] -> [Val]) -> [Value] -> [Val]
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
xs
parseArray Val
v = [Val] -> Parser [Val]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Val
v]

parseObject :: Val -> Parser (Map.HashMap T.Text Value)
parseObject :: Val -> Parser (HashMap Text Value)
parseObject (Val -> Value
getVal -> Object Object
x) = HashMap Text Value -> Parser (HashMap Text Value)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> HashMap Text Value
forall v. KeyMap v -> HashMap Text v
toHashMapText Object
x)
parseObject Val
v = Val -> String -> Parser (HashMap Text Value)
forall a. Val -> String -> Parser a
parseFail Val
v String
"Expected an Object"

parseObject1 :: Val -> Parser (String, Val)
parseObject1 :: Val -> Parser (String, Val)
parseObject1 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 -> String
T.unpack -> String
s] -> (String
s,) (Val -> (String, Val)) -> Parser Val -> Parser (String, Val)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Val -> Parser Val
parseField String
s Val
v
        [Text]
_ -> Val -> String -> Parser (String, Val)
forall a. Val -> String -> Parser a
parseFail Val
v (String -> Parser (String, Val)) -> String -> Parser (String, Val)
forall a b. (a -> b) -> a -> b
$ String
"Expected exactly one key but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
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 String
parseString (Val -> Value
getVal -> String Text
x) = String -> Parser String
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Parser String) -> String -> Parser String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
x
parseString Val
v = Val -> String -> Parser String
forall a. Val -> String -> Parser a
parseFail Val
v String
"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 Val
v = Val -> String -> Parser Int
forall a. Val -> String -> Parser a
parseFail Val
v String
"Expected an Int"

parseArrayString :: Val -> Parser [String]
parseArrayString :: Val -> Parser [String]
parseArrayString = Val -> Parser [Val]
parseArray (Val -> Parser [Val])
-> ([Val] -> Parser [String]) -> Val -> Parser [String]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Val -> Parser String) -> [Val] -> Parser [String]
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 Val -> Parser String
parseString

maybeParse :: (Val -> Parser a) -> Maybe Val -> Parser (Maybe a)
maybeParse :: forall a. (Val -> Parser a) -> Maybe Val -> Parser (Maybe a)
maybeParse Val -> Parser a
parseValue Maybe Val
Nothing = Maybe a -> Parser (Maybe a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
maybeParse Val -> Parser a
parseValue (Just Val
value) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Parser a -> Parser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Val -> Parser a
parseValue Val
value

maybeParseEnum :: [(T.Text, a)] -> Maybe Val -> Parser (Maybe a)
maybeParseEnum :: forall a. [(Text, a)] -> Maybe Val -> Parser (Maybe a)
maybeParseEnum [(Text, a)]
_ Maybe Val
Nothing = Maybe a -> Parser (Maybe a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
maybeParseEnum [(Text, a)]
dict (Just Val
val) = case Val -> Value
getVal Val
val of
  String Text
str | Just a
x <- Text -> [(Text, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
str [(Text, a)]
dict -> Maybe a -> Parser (Maybe a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> Parser (Maybe a)) -> Maybe a -> Parser (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
x
  Value
_ -> Val -> String -> Parser (Maybe a)
forall a. Val -> String -> Parser a
parseFail Val
val (String -> Parser (Maybe a))
-> (Text -> String) -> Text -> Parser (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Parser (Maybe a)) -> Text -> Parser (Maybe a)
forall a b. (a -> b) -> a -> b
$ Text
"expected '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"', '" ((Text, a) -> Text
forall a b. (a, b) -> a
fst ((Text, a) -> Text) -> [(Text, a)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, a)]
dict) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"

parseBool :: Val -> Parser Bool
parseBool :: Val -> Parser Bool
parseBool (Val -> Value
getVal -> Bool Bool
b) = Bool -> Parser Bool
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
b
parseBool Val
v = Val -> String -> Parser Bool
forall a. Val -> String -> Parser a
parseFail Val
v String
"Expected a Bool"

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

parseFieldOpt :: String -> Val -> Parser (Maybe Val)
parseFieldOpt :: String -> Val -> Parser (Maybe Val)
parseFieldOpt String
s 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 (String -> Text
T.pack String
s) HashMap Text Value
mp of
        Maybe Value
Nothing -> Maybe Val -> Parser (Maybe Val)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Val
forall a. Maybe a
Nothing
        Just Value
x -> Maybe Val -> Parser (Maybe Val)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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
$ String -> Value -> Val -> Val
addVal String
s Value
x Val
v

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

parseGHC :: (ParseFlags -> String -> ParseResult v) -> Val -> Parser v
parseGHC :: forall v.
(ParseFlags -> String -> ParseResult v) -> Val -> Parser v
parseGHC ParseFlags -> String -> ParseResult v
parser Val
v = do
    String
x <- Val -> Parser String
parseString Val
v
    case ParseFlags -> String -> ParseResult v
parser ParseFlags
defaultParseFlags{enabledExtensions=configExtensions, disabledExtensions=[]} String
x of
        POk PState
_ v
x -> v -> Parser v
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure v
x
        PFailed PState
ps ->
          let errMsg :: MsgEnvelope GhcMessage
errMsg = NonEmpty (MsgEnvelope GhcMessage) -> MsgEnvelope GhcMessage
forall a. NonEmpty a -> a
NE.head (NonEmpty (MsgEnvelope GhcMessage) -> MsgEnvelope GhcMessage)
-> (Messages GhcMessage -> NonEmpty (MsgEnvelope GhcMessage))
-> Messages GhcMessage
-> MsgEnvelope GhcMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MsgEnvelope GhcMessage] -> NonEmpty (MsgEnvelope GhcMessage)
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList ([MsgEnvelope GhcMessage] -> NonEmpty (MsgEnvelope GhcMessage))
-> (Messages GhcMessage -> [MsgEnvelope GhcMessage])
-> Messages GhcMessage
-> NonEmpty (MsgEnvelope GhcMessage)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bag (MsgEnvelope GhcMessage) -> [MsgEnvelope GhcMessage]
forall a. Bag a -> [a]
bagToList (Bag (MsgEnvelope GhcMessage) -> [MsgEnvelope GhcMessage])
-> (Messages GhcMessage -> Bag (MsgEnvelope GhcMessage))
-> Messages GhcMessage
-> [MsgEnvelope GhcMessage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Messages GhcMessage -> Bag (MsgEnvelope GhcMessage)
forall e. Messages e -> Bag (MsgEnvelope e)
getMessages (Messages GhcMessage -> MsgEnvelope GhcMessage)
-> Messages GhcMessage -> MsgEnvelope GhcMessage
forall a b. (a -> b) -> a -> b
$ PsMessage -> GhcMessage
GhcPsMessage (PsMessage -> GhcMessage)
-> Messages PsMessage -> Messages GhcMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Messages PsMessage, Messages PsMessage) -> Messages PsMessage
forall a b. (a, b) -> b
snd (PState -> (Messages PsMessage, Messages PsMessage)
getPsMessages PState
ps)
              msg :: String
msg = DynFlags -> SDoc -> String
showSDoc DynFlags
baseDynFlags (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ MsgEnvelope GhcMessage -> SDoc
forall e. Diagnostic e => MsgEnvelope e -> SDoc
pprLocMsgEnvelopeDefault MsgEnvelope GhcMessage
errMsg
          in Val -> String -> Parser v
forall a. Val -> String -> Parser a
parseFail Val
v (String -> Parser v) -> String -> Parser v
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", when parsing:\n " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x

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

newtype ConfigYamlBuiltin = ConfigYamlBuiltin { ConfigYamlBuiltin -> ConfigYaml
getConfigYamlBuiltin :: ConfigYaml }
  deriving (NonEmpty ConfigYamlBuiltin -> ConfigYamlBuiltin
ConfigYamlBuiltin -> ConfigYamlBuiltin -> ConfigYamlBuiltin
(ConfigYamlBuiltin -> ConfigYamlBuiltin -> ConfigYamlBuiltin)
-> (NonEmpty ConfigYamlBuiltin -> ConfigYamlBuiltin)
-> (forall b.
    Integral b =>
    b -> ConfigYamlBuiltin -> ConfigYamlBuiltin)
-> Semigroup ConfigYamlBuiltin
forall b. Integral b => b -> ConfigYamlBuiltin -> ConfigYamlBuiltin
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: ConfigYamlBuiltin -> ConfigYamlBuiltin -> ConfigYamlBuiltin
<> :: ConfigYamlBuiltin -> ConfigYamlBuiltin -> ConfigYamlBuiltin
$csconcat :: NonEmpty ConfigYamlBuiltin -> ConfigYamlBuiltin
sconcat :: NonEmpty ConfigYamlBuiltin -> ConfigYamlBuiltin
$cstimes :: forall b. Integral b => b -> ConfigYamlBuiltin -> ConfigYamlBuiltin
stimes :: forall b. Integral b => b -> ConfigYamlBuiltin -> ConfigYamlBuiltin
Semigroup, Semigroup ConfigYamlBuiltin
ConfigYamlBuiltin
Semigroup ConfigYamlBuiltin =>
ConfigYamlBuiltin
-> (ConfigYamlBuiltin -> ConfigYamlBuiltin -> ConfigYamlBuiltin)
-> ([ConfigYamlBuiltin] -> ConfigYamlBuiltin)
-> Monoid ConfigYamlBuiltin
[ConfigYamlBuiltin] -> ConfigYamlBuiltin
ConfigYamlBuiltin -> ConfigYamlBuiltin -> ConfigYamlBuiltin
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: ConfigYamlBuiltin
mempty :: ConfigYamlBuiltin
$cmappend :: ConfigYamlBuiltin -> ConfigYamlBuiltin -> ConfigYamlBuiltin
mappend :: ConfigYamlBuiltin -> ConfigYamlBuiltin -> ConfigYamlBuiltin
$cmconcat :: [ConfigYamlBuiltin] -> ConfigYamlBuiltin
mconcat :: [ConfigYamlBuiltin] -> ConfigYamlBuiltin
Monoid)

newtype ConfigYamlUser = ConfigYamlUser { ConfigYamlUser -> ConfigYaml
getConfigYamlUser :: ConfigYaml }
  deriving (NonEmpty ConfigYamlUser -> ConfigYamlUser
ConfigYamlUser -> ConfigYamlUser -> ConfigYamlUser
(ConfigYamlUser -> ConfigYamlUser -> ConfigYamlUser)
-> (NonEmpty ConfigYamlUser -> ConfigYamlUser)
-> (forall b. Integral b => b -> ConfigYamlUser -> ConfigYamlUser)
-> Semigroup ConfigYamlUser
forall b. Integral b => b -> ConfigYamlUser -> ConfigYamlUser
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: ConfigYamlUser -> ConfigYamlUser -> ConfigYamlUser
<> :: ConfigYamlUser -> ConfigYamlUser -> ConfigYamlUser
$csconcat :: NonEmpty ConfigYamlUser -> ConfigYamlUser
sconcat :: NonEmpty ConfigYamlUser -> ConfigYamlUser
$cstimes :: forall b. Integral b => b -> ConfigYamlUser -> ConfigYamlUser
stimes :: forall b. Integral b => b -> ConfigYamlUser -> ConfigYamlUser
Semigroup, Semigroup ConfigYamlUser
ConfigYamlUser
Semigroup ConfigYamlUser =>
ConfigYamlUser
-> (ConfigYamlUser -> ConfigYamlUser -> ConfigYamlUser)
-> ([ConfigYamlUser] -> ConfigYamlUser)
-> Monoid ConfigYamlUser
[ConfigYamlUser] -> ConfigYamlUser
ConfigYamlUser -> ConfigYamlUser -> ConfigYamlUser
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: ConfigYamlUser
mempty :: ConfigYamlUser
$cmappend :: ConfigYamlUser -> ConfigYamlUser -> ConfigYamlUser
mappend :: ConfigYamlUser -> ConfigYamlUser -> ConfigYamlUser
$cmconcat :: [ConfigYamlUser] -> ConfigYamlUser
mconcat :: [ConfigYamlUser] -> ConfigYamlUser
Monoid)

instance FromJSON ConfigYamlBuiltin where
    parseJSON :: Value -> Parser ConfigYamlBuiltin
parseJSON Value
Null = ConfigYamlBuiltin -> Parser ConfigYamlBuiltin
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigYamlBuiltin
forall a. Monoid a => a
mempty
    parseJSON Value
x = ConfigYaml -> ConfigYamlBuiltin
ConfigYamlBuiltin (ConfigYaml -> ConfigYamlBuiltin)
-> Parser ConfigYaml -> Parser ConfigYamlBuiltin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Val -> Parser ConfigYaml
parseConfigYaml Bool
True (Value -> Val
newVal Value
x)

instance FromJSON ConfigYamlUser where
  parseJSON :: Value -> Parser ConfigYamlUser
parseJSON Value
Null = ConfigYamlUser -> Parser ConfigYamlUser
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigYamlUser
forall a. Monoid a => a
mempty
  parseJSON Value
x = ConfigYaml -> ConfigYamlUser
ConfigYamlUser (ConfigYaml -> ConfigYamlUser)
-> Parser ConfigYaml -> Parser ConfigYamlUser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Val -> Parser ConfigYaml
parseConfigYaml Bool
False (Value -> Val
newVal Value
x)

parseConfigYaml :: Bool -> Val -> Parser ConfigYaml
parseConfigYaml :: Bool -> Val -> Parser ConfigYaml
parseConfigYaml Bool
isBuiltin Val
v = do
    [Val]
vs <- Val -> Parser [Val]
parseArray Val
v
    ([ConfigItem] -> ConfigYaml)
-> Parser [ConfigItem] -> Parser ConfigYaml
forall a b. (a -> b) -> Parser a -> Parser b
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
$ \Val
o -> do
        (String
s, Val
v) <- Val -> Parser (String, Val)
parseObject1 Val
o
        case String
s of
            String
"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
            String
"group" -> Group -> ConfigItem
ConfigGroup (Group -> ConfigItem) -> Parser Group -> Parser ConfigItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Val -> Parser Group
parseGroup Bool
isBuiltin Val
v
            String
"arguments" -> [Setting] -> ConfigItem
ConfigSetting ([Setting] -> ConfigItem)
-> ([String] -> [Setting]) -> [String] -> ConfigItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Setting) -> [String] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map String -> Setting
SettingArgument ([String] -> ConfigItem) -> Parser [String] -> Parser ConfigItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Val -> Parser [String]
parseArrayString Val
v
            String
"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
            String
"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
            String
_ | Maybe Severity -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Severity -> Bool) -> Maybe Severity -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Maybe Severity
getSeverity String
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
<$> Bool -> Val -> Parser [Either HintRule Classify]
parseRule Bool
isBuiltin Val
o
            String
_ | Just RestrictType
r <- String -> Maybe RestrictType
getRestrictType String
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 a b. Parser a -> (a -> Parser b) -> Parser b
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (RestrictType -> Val -> Parser Restrict
parseRestrict RestrictType
r))
            String
_ -> Val -> String -> Parser ConfigItem
forall a. Val -> String -> Parser a
parseFail Val
v String
"Expecting an object with a 'package' or 'group' key, a hint or a restriction"


parsePackage :: Val -> Parser Package
parsePackage :: Val -> Parser Package
parsePackage Val
v = do
    String
packageName <- String -> Val -> Parser Val
parseField String
"name" Val
v Parser Val -> (Val -> Parser String) -> Parser String
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Val -> Parser String
parseString
    [HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
packageModules <- String -> Val -> Parser Val
parseField String
"modules" Val
v Parser Val -> (Val -> Parser [Val]) -> Parser [Val]
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Val -> Parser [Val]
parseArray Parser [Val]
-> ([Val]
    -> Parser
         [HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs))])
-> Parser
     [HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Val
 -> Parser
      (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs))))
-> [Val]
-> Parser
     [HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
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 ((GenLocated SrcSpanAnnA (ImportDecl GhcPs)
 -> HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> Parser (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> Parser
     (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a. a -> HsExtendInstances a
extendInstances (Parser (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
 -> Parser
      (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs))))
-> (Val -> Parser (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> Val
-> Parser
     (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParseFlags
 -> String
 -> ParseResult (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> Val -> Parser (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall v.
(ParseFlags -> String -> ParseResult v) -> Val -> Parser v
parseGHC ParseFlags -> String -> ParseResult (LImportDecl GhcPs)
ParseFlags
-> String
-> ParseResult (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
parseImportDeclGhcWithMode)
    Val -> [String] -> Parser ()
allowFields Val
v [String
"name",String
"modules"]
    Package -> Parser Package
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Package{String
[HsExtendInstances (LImportDecl GhcPs)]
[HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
packageName :: String
packageModules :: [HsExtendInstances (LImportDecl GhcPs)]
packageName :: String
packageModules :: [HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
..}

parseFixity :: Val -> Parser [Setting]
parseFixity :: Val -> Parser [Setting]
parseFixity Val
v = Val -> Parser [Val]
parseArray Val
v Parser [Val] -> ([Val] -> Parser [Setting]) -> Parser [Setting]
forall a b. Parser a -> (a -> Parser b) -> Parser b
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 ((ParseFlags
 -> String -> ParseResult (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> Val -> Parser (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall v.
(ParseFlags -> String -> ParseResult v) -> Val -> Parser v
parseGHC ParseFlags -> String -> ParseResult (LHsDecl GhcPs)
ParseFlags
-> String -> ParseResult (GenLocated SrcSpanAnnA (HsDecl GhcPs))
parseDeclGhcWithMode (Val -> Parser (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> Parser [Setting])
-> Val
-> Parser [Setting]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> GenLocated SrcSpanAnnA (HsDecl GhcPs) -> Parser [Setting]
forall {l}. GenLocated l (HsDecl GhcPs) -> Parser [Setting]
f)
    where
        f :: GenLocated l (HsDecl GhcPs) -> Parser [Setting]
f (L l
_ (SigD XSigD GhcPs
_ (FixSig XFixSig GhcPs
_ FixitySig GhcPs
x))) = [Setting] -> Parser [Setting]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Setting] -> Parser [Setting]) -> [Setting] -> Parser [Setting]
forall a b. (a -> b) -> a -> b
$ (FixityInfo -> Setting) -> [FixityInfo] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map FixityInfo -> Setting
Infix ([FixityInfo] -> [Setting]) -> [FixityInfo] -> [Setting]
forall a b. (a -> b) -> a -> b
$ FixitySig GhcPs -> [FixityInfo]
fromFixitySig FixitySig GhcPs
x
        f GenLocated l (HsDecl GhcPs)
_ = Val -> String -> Parser [Setting]
forall a. Val -> String -> Parser a
parseFail Val
v String
"Expected fixity declaration"

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

parseGroup :: Bool -> Val -> Parser Group
parseGroup :: Bool -> Val -> Parser Group
parseGroup Bool
isBuiltin Val
v = do
    String
groupName <- String -> Val -> Parser Val
parseField String
"name" Val
v Parser Val -> (Val -> Parser String) -> Parser String
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Val -> Parser String
parseString
    Bool
groupEnabled <- String -> Val -> Parser (Maybe Val)
parseFieldOpt String
"enabled" Val
v Parser (Maybe Val) -> (Maybe Val -> Parser Bool) -> Parser Bool
forall a b. Parser a -> (a -> Parser b) -> Parser b
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 a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) Val -> Parser Bool
parseBool
    [Either
   String
   (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))]
groupImports <- String -> Val -> Parser (Maybe Val)
parseFieldOpt String
"imports" Val
v Parser (Maybe Val)
-> (Maybe Val
    -> Parser
         [Either
            String
            (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))])
-> Parser
     [Either
        String
        (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))]
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser
  [Either
     String
     (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))]
-> (Val
    -> Parser
         [Either
            String
            (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))])
-> Maybe Val
-> Parser
     [Either
        String
        (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Either
   String
   (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))]
-> Parser
     [Either
        String
        (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (Val -> Parser [Val]
parseArray (Val -> Parser [Val])
-> ([Val]
    -> Parser
         [Either
            String
            (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))])
-> Val
-> Parser
     [Either
        String
        (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Val
 -> Parser
      (Either
         String
         (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))))
-> [Val]
-> Parser
     [Either
        String
        (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))]
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 Val
-> Parser
     (Either
        String
        (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs))))
parseImport)
    [Either HintRule Classify]
groupRules <- String -> Val -> Parser (Maybe Val)
parseFieldOpt String
"rules" Val
v Parser (Maybe Val) -> (Maybe Val -> Parser [Val]) -> Parser [Val]
forall a b. Parser a -> (a -> Parser b) -> Parser b
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 a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) Val -> Parser [Val]
parseArray Parser [Val]
-> ([Val] -> Parser [Either HintRule Classify])
-> Parser [Either HintRule Classify]
forall a b. Parser a -> (a -> Parser b) -> Parser b
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 (Bool -> Val -> Parser [Either HintRule Classify]
parseRule Bool
isBuiltin)
    Val -> [String] -> Parser ()
allowFields Val
v [String
"name",String
"enabled",String
"imports",String
"rules"]
    Group -> Parser Group
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Group{Bool
String
[Either String (HsExtendInstances (LImportDecl GhcPs))]
[Either
   String
   (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))]
[Either HintRule Classify]
groupName :: String
groupEnabled :: Bool
groupImports :: [Either String (HsExtendInstances (LImportDecl GhcPs))]
groupRules :: [Either HintRule Classify]
groupName :: String
groupEnabled :: Bool
groupImports :: [Either
   String
   (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))]
groupRules :: [Either HintRule Classify]
..}
    where
        parseImport :: Val
-> Parser
     (Either
        String
        (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs))))
parseImport Val
v = do
            String
x <- Val -> Parser String
parseString Val
v
            case String -> (String, String)
word1 String
x of
                 (String
"package", String
x) -> Either
  String
  (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> Parser
     (Either
        String
        (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs))))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   String
   (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
 -> Parser
      (Either
         String
         (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))))
-> Either
     String
     (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> Parser
     (Either
        String
        (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs))))
forall a b. (a -> b) -> a -> b
$ String
-> Either
     String
     (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
forall a b. a -> Either a b
Left String
x
                 (String, String)
_ -> HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> Either
     String
     (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
forall a b. b -> Either a b
Right (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
 -> Either
      String
      (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs))))
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
    -> HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Either
     String
     (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a. a -> HsExtendInstances a
extendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
 -> Either
      String
      (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs))))
-> Parser (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> Parser
     (Either
        String
        (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParseFlags
 -> String
 -> ParseResult (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> Val -> Parser (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall v.
(ParseFlags -> String -> ParseResult v) -> Val -> Parser v
parseGHC ParseFlags -> String -> ParseResult (LImportDecl GhcPs)
ParseFlags
-> String
-> ParseResult (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
parseImportDeclGhcWithMode Val
v

ruleToGroup :: [Either HintRule Classify] -> Group
ruleToGroup :: [Either HintRule Classify] -> Group
ruleToGroup = String
-> Bool
-> [Either String (HsExtendInstances (LImportDecl GhcPs))]
-> [Either HintRule Classify]
-> Group
Group String
"" Bool
True []

parseRule :: Bool -> Val -> Parser [Either HintRule Classify]
parseRule :: Bool -> Val -> Parser [Either HintRule Classify]
parseRule Bool
isBuiltin Val
v = do
    (Severity
severity, 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
<$> String -> Val -> Parser (Maybe Val)
parseFieldOpt String
"lhs" Val
v
    if Bool
isRule then do
        [Note]
hintRuleNotes <- String -> Val -> Parser (Maybe Val)
parseFieldOpt String
"note" Val
v Parser (Maybe Val) -> (Maybe Val -> Parser [Note]) -> Parser [Note]
forall a b. Parser a -> (a -> Parser b) -> Parser b
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 a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (([String] -> [Note]) -> Parser [String] -> Parser [Note]
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Note) -> [String] -> [Note]
forall a b. (a -> b) -> [a] -> [b]
map String -> Note
asNote) (Parser [String] -> Parser [Note])
-> (Val -> Parser [String]) -> Val -> Parser [Note]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val -> Parser [String]
parseArrayString)
        GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs <- String -> Val -> Parser Val
parseField String
"lhs" Val
v Parser Val
-> (Val -> Parser (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Parser (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ParseFlags
 -> String -> ParseResult (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Val -> Parser (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall v.
(ParseFlags -> String -> ParseResult v) -> Val -> Parser v
parseGHC ParseFlags -> String -> ParseResult (LHsExpr GhcPs)
ParseFlags
-> String -> ParseResult (GenLocated SrcSpanAnnA (HsExpr GhcPs))
parseExpGhcWithMode
        GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs <- String -> Val -> Parser Val
parseField String
"rhs" Val
v Parser Val
-> (Val -> Parser (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Parser (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ParseFlags
 -> String -> ParseResult (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Val -> Parser (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall v.
(ParseFlags -> String -> ParseResult v) -> Val -> Parser v
parseGHC ParseFlags -> String -> ParseResult (LHsExpr GhcPs)
ParseFlags
-> String -> ParseResult (GenLocated SrcSpanAnnA (HsExpr GhcPs))
parseExpGhcWithMode
        Maybe (HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
hintRuleSide <- String -> Val -> Parser (Maybe Val)
parseFieldOpt String
"side" Val
v Parser (Maybe Val)
-> (Maybe Val
    -> Parser
         (Maybe
            (HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> Parser
     (Maybe (HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser
  (Maybe (HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> (Val
    -> Parser
         (Maybe
            (HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> Maybe Val
-> Parser
     (Maybe (HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Parser
     (Maybe (HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. Maybe a
Nothing) ((GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> Maybe
      (HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> Parser (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Parser
     (Maybe (HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Maybe
     (HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. a -> Maybe a
Just (HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> Maybe
      (HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Maybe
     (HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> HsExtendInstances a
extendInstances) (Parser (GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> Parser
      (Maybe
         (HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> (Val -> Parser (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Val
-> Parser
     (Maybe (HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseFlags
 -> String -> ParseResult (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Val -> Parser (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall v.
(ParseFlags -> String -> ParseResult v) -> Val -> Parser v
parseGHC ParseFlags -> String -> ParseResult (LHsExpr GhcPs)
ParseFlags
-> String -> ParseResult (GenLocated SrcSpanAnnA (HsExpr GhcPs))
parseExpGhcWithMode)
        String
hintRuleName <- String -> Val -> Parser (Maybe Val)
parseFieldOpt String
"name" Val
v Parser (Maybe Val) -> (Maybe Val -> Parser String) -> Parser String
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser String
-> (Val -> Parser String) -> Maybe Val -> Parser String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser String
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Parser String) -> String -> Parser String
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> LHsExpr GhcPs -> String
guessName LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs) Val -> Parser String
parseString

        Val -> [String] -> Parser ()
allowFields Val
v [String
"lhs",String
"rhs",String
"note",String
"name",String
"side"]
        let hintRuleScope :: Scope
hintRuleScope = Scope
forall a. Monoid a => a
mempty
        [Either HintRule Classify] -> Parser [Either HintRule Classify]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Either HintRule Classify] -> Parser [Either HintRule Classify])
-> [Either HintRule Classify] -> Parser [Either HintRule Classify]
forall a b. (a -> b) -> a -> b
$
          HintRule -> Either HintRule Classify
forall a b. a -> Either a b
Left HintRule {hintRuleSeverity :: Severity
hintRuleSeverity = Severity
severity, hintRuleLHS :: HsExtendInstances (LHsExpr GhcPs)
hintRuleLHS = GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> HsExtendInstances a
extendInstances GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs, hintRuleRHS :: HsExtendInstances (LHsExpr GhcPs)
hintRuleRHS = GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> HsExtendInstances a
extendInstances GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs, String
[Note]
Maybe (HsExtendInstances (LHsExpr GhcPs))
Maybe (HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
Scope
hintRuleNotes :: [Note]
hintRuleSide :: Maybe (HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
hintRuleName :: String
hintRuleScope :: Scope
hintRuleName :: String
hintRuleNotes :: [Note]
hintRuleScope :: Scope
hintRuleSide :: Maybe (HsExtendInstances (LHsExpr GhcPs))
..}
            Either HintRule Classify
-> [Either HintRule Classify] -> [Either HintRule Classify]
forall a. a -> [a] -> [a]
: [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 -> String -> String -> String -> Classify
Classify Severity
severity String
hintRuleName String
"" String
"" | Bool -> Bool
not Bool
isBuiltin]
     else do
        [String]
names <- String -> Val -> Parser (Maybe Val)
parseFieldOpt String
"name" Val
v Parser (Maybe Val)
-> (Maybe Val -> Parser [String]) -> Parser [String]
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser [String]
-> (Val -> Parser [String]) -> Maybe Val -> Parser [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([String] -> Parser [String]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) Val -> Parser [String]
parseArrayString
        [(String, String)]
within <- String -> Val -> Parser (Maybe Val)
parseFieldOpt String
"within" Val
v Parser (Maybe Val)
-> (Maybe Val -> Parser [(String, String)])
-> Parser [(String, String)]
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser [(String, String)]
-> (Val -> Parser [(String, String)])
-> Maybe Val
-> Parser [(String, String)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([(String, String)] -> Parser [(String, String)]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(String
"",String
"")]) (Val -> Parser [Val]
parseArray (Val -> Parser [Val])
-> ([Val] -> Parser [(String, String)])
-> Val
-> Parser [(String, String)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Val -> Parser [(String, String)])
-> [Val] -> Parser [(String, String)]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM Val -> Parser [(String, String)]
parseWithin)
        [Either HintRule Classify] -> Parser [Either HintRule Classify]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [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 -> String -> String -> String -> Classify
Classify Severity
severity String
n String
a String
b | (String
a,String
b) <- [(String, String)]
within, String
n <- [String
"" | [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
names] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
names]

parseRestrict :: RestrictType -> Val -> Parser Restrict
parseRestrict :: RestrictType -> Val -> Parser Restrict
parseRestrict RestrictType
restrictType Val
v = do
    Maybe Val
def <- String -> Val -> Parser (Maybe Val)
parseFieldOpt String
"default" Val
v
    case Maybe Val
def of
        Just Val
def -> do
            Bool
b <- Val -> Parser Bool
parseBool Val
def
            Val -> [String] -> Parser ()
allowFields Val
v [String
"default"]
            Restrict -> Parser Restrict
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Restrict -> Parser Restrict) -> Restrict -> Parser Restrict
forall a b. (a -> b) -> a -> b
$ RestrictType
-> Bool
-> [String]
-> [String]
-> Alt Maybe Bool
-> Alt Maybe RestrictImportStyle
-> Alt Maybe QualifiedStyle
-> [(String, String)]
-> RestrictIdents
-> Maybe String
-> Restrict
Restrict RestrictType
restrictType Bool
b [] [String]
forall a. Monoid a => a
mempty Alt Maybe Bool
forall a. Monoid a => a
mempty Alt Maybe RestrictImportStyle
forall a. Monoid a => a
mempty Alt Maybe QualifiedStyle
forall a. Monoid a => a
mempty [] RestrictIdents
NoRestrictIdents Maybe String
forall a. Maybe a
Nothing
        Maybe Val
Nothing -> do
            [String]
restrictName <- String -> Val -> Parser (Maybe Val)
parseFieldOpt String
"name" Val
v Parser (Maybe Val)
-> (Maybe Val -> Parser [String]) -> Parser [String]
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser [String]
-> (Val -> Parser [String]) -> Maybe Val -> Parser [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([String] -> Parser [String]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) Val -> Parser [String]
parseArrayString
            [(String, String)]
restrictWithin <- String -> Val -> Parser (Maybe Val)
parseFieldOpt String
"within" Val
v Parser (Maybe Val)
-> (Maybe Val -> Parser [(String, String)])
-> Parser [(String, String)]
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser [(String, String)]
-> (Val -> Parser [(String, String)])
-> Maybe Val
-> Parser [(String, String)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([(String, String)] -> Parser [(String, String)]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(String
"",String
"")]) (Val -> Parser [Val]
parseArray (Val -> Parser [Val])
-> ([Val] -> Parser [(String, String)])
-> Val
-> Parser [(String, String)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Val -> Parser [(String, String)])
-> [Val] -> Parser [(String, String)]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM Val -> Parser [(String, String)]
parseWithin)
            [String]
restrictAs <- String -> Val -> Parser (Maybe Val)
parseFieldOpt String
"as" Val
v Parser (Maybe Val)
-> (Maybe Val -> Parser [String]) -> Parser [String]
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser [String]
-> (Val -> Parser [String]) -> Maybe Val -> Parser [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([String] -> Parser [String]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) Val -> Parser [String]
parseArrayString
            Alt Maybe Bool
restrictAsRequired <- String -> Val -> Parser (Maybe Val)
parseFieldOpt String
"asRequired" Val
v Parser (Maybe Val)
-> (Maybe Val -> Parser (Alt Maybe Bool))
-> Parser (Alt Maybe Bool)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe Bool -> Alt Maybe Bool)
-> Parser (Maybe Bool) -> Parser (Alt Maybe Bool)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Bool -> Alt Maybe Bool
forall {k} (f :: k -> *) (a :: k). f a -> Alt f a
Alt (Parser (Maybe Bool) -> Parser (Alt Maybe Bool))
-> (Maybe Val -> Parser (Maybe Bool))
-> Maybe Val
-> Parser (Alt Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Val -> Parser Bool) -> Maybe Val -> Parser (Maybe Bool)
forall a. (Val -> Parser a) -> Maybe Val -> Parser (Maybe a)
maybeParse Val -> Parser Bool
parseBool
            Alt Maybe RestrictImportStyle
restrictImportStyle <- String -> Val -> Parser (Maybe Val)
parseFieldOpt String
"importStyle" Val
v Parser (Maybe Val)
-> (Maybe Val -> Parser (Alt Maybe RestrictImportStyle))
-> Parser (Alt Maybe RestrictImportStyle)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe RestrictImportStyle -> Alt Maybe RestrictImportStyle)
-> Parser (Maybe RestrictImportStyle)
-> Parser (Alt Maybe RestrictImportStyle)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe RestrictImportStyle -> Alt Maybe RestrictImportStyle
forall {k} (f :: k -> *) (a :: k). f a -> Alt f a
Alt (Parser (Maybe RestrictImportStyle)
 -> Parser (Alt Maybe RestrictImportStyle))
-> (Maybe Val -> Parser (Maybe RestrictImportStyle))
-> Maybe Val
-> Parser (Alt Maybe RestrictImportStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, RestrictImportStyle)]
-> Maybe Val -> Parser (Maybe RestrictImportStyle)
forall a. [(Text, a)] -> Maybe Val -> Parser (Maybe a)
maybeParseEnum
              [ (Text
"qualified"          , RestrictImportStyle
ImportStyleQualified)
              , (Text
"unqualified"        , RestrictImportStyle
ImportStyleUnqualified)
              , (Text
"explicit"           , RestrictImportStyle
ImportStyleExplicit)
              , (Text
"explicitOrQualified", RestrictImportStyle
ImportStyleExplicitOrQualified)
              , (Text
"unrestricted"       , RestrictImportStyle
ImportStyleUnrestricted)
              ]
            Alt Maybe QualifiedStyle
restrictQualifiedStyle <- String -> Val -> Parser (Maybe Val)
parseFieldOpt String
"qualifiedStyle" Val
v Parser (Maybe Val)
-> (Maybe Val -> Parser (Alt Maybe QualifiedStyle))
-> Parser (Alt Maybe QualifiedStyle)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe QualifiedStyle -> Alt Maybe QualifiedStyle)
-> Parser (Maybe QualifiedStyle)
-> Parser (Alt Maybe QualifiedStyle)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe QualifiedStyle -> Alt Maybe QualifiedStyle
forall {k} (f :: k -> *) (a :: k). f a -> Alt f a
Alt (Parser (Maybe QualifiedStyle)
 -> Parser (Alt Maybe QualifiedStyle))
-> (Maybe Val -> Parser (Maybe QualifiedStyle))
-> Maybe Val
-> Parser (Alt Maybe QualifiedStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, QualifiedStyle)]
-> Maybe Val -> Parser (Maybe QualifiedStyle)
forall a. [(Text, a)] -> Maybe Val -> Parser (Maybe a)
maybeParseEnum
              [ (Text
"pre"         , QualifiedStyle
QualifiedStylePre)
              , (Text
"post"        , QualifiedStyle
QualifiedStylePost)
              , (Text
"unrestricted", QualifiedStyle
QualifiedStyleUnrestricted)
              ]


            Maybe Val
restrictBadIdents <- String -> Val -> Parser (Maybe Val)
parseFieldOpt String
"badidents" Val
v
            Maybe Val
restrictOnlyAllowedIdents <- String -> Val -> Parser (Maybe Val)
parseFieldOpt String
"only" Val
v
            RestrictIdents
restrictIdents <-
                case (Maybe Val
restrictBadIdents, Maybe Val
restrictOnlyAllowedIdents) of
                    (Just Val
badIdents, Maybe Val
Nothing) -> [String] -> RestrictIdents
ForbidIdents ([String] -> RestrictIdents)
-> Parser [String] -> Parser RestrictIdents
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Val -> Parser [String]
parseArrayString Val
badIdents
                    (Maybe Val
Nothing, Just Val
onlyIdents) -> [String] -> RestrictIdents
OnlyIdents ([String] -> RestrictIdents)
-> Parser [String] -> Parser RestrictIdents
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Val -> Parser [String]
parseArrayString Val
onlyIdents
                    (Maybe Val
Nothing, Maybe Val
Nothing) -> RestrictIdents -> Parser RestrictIdents
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RestrictIdents
NoRestrictIdents
                    (Maybe Val, Maybe Val)
_ -> Val -> String -> Parser RestrictIdents
forall a. Val -> String -> Parser a
parseFail Val
v String
"The following options are mutually exclusive: badidents, only"

            Maybe String
restrictMessage <- String -> Val -> Parser (Maybe Val)
parseFieldOpt String
"message" Val
v Parser (Maybe Val)
-> (Maybe Val -> Parser (Maybe String)) -> Parser (Maybe String)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Val -> Parser String) -> Maybe Val -> Parser (Maybe String)
forall a. (Val -> Parser a) -> Maybe Val -> Parser (Maybe a)
maybeParse Val -> Parser String
parseString
            Val -> [String] -> Parser ()
allowFields Val
v ([String] -> Parser ()) -> [String] -> Parser ()
forall a b. (a -> b) -> a -> b
$
                [String
"name", String
"within", String
"message"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                if RestrictType
restrictType RestrictType -> RestrictType -> Bool
forall a. Eq a => a -> a -> Bool
== RestrictType
RestrictModule
                    then [String
"as", String
"asRequired", String
"importStyle", String
"qualifiedStyle", String
"badidents", String
"only"]
                    else []
            Restrict -> Parser Restrict
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Restrict{restrictDefault :: Bool
restrictDefault=Bool
True,[String]
[(String, String)]
Maybe String
Alt Maybe Bool
Alt Maybe QualifiedStyle
Alt Maybe RestrictImportStyle
RestrictIdents
RestrictType
restrictType :: RestrictType
restrictName :: [String]
restrictWithin :: [(String, String)]
restrictAs :: [String]
restrictAsRequired :: Alt Maybe Bool
restrictImportStyle :: Alt Maybe RestrictImportStyle
restrictQualifiedStyle :: Alt Maybe QualifiedStyle
restrictIdents :: RestrictIdents
restrictMessage :: Maybe String
restrictType :: RestrictType
restrictName :: [String]
restrictAs :: [String]
restrictAsRequired :: Alt Maybe Bool
restrictImportStyle :: Alt Maybe RestrictImportStyle
restrictQualifiedStyle :: Alt Maybe QualifiedStyle
restrictWithin :: [(String, String)]
restrictIdents :: RestrictIdents
restrictMessage :: Maybe String
..}

parseWithin :: Val -> Parser [(String, String)] -- (module, decl)
parseWithin :: Val -> Parser [(String, String)]
parseWithin Val
v = do
    String
s <- Val -> Parser String
parseString Val
v
    if Char
'*' Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
s
        then [(String, String)] -> Parser [(String, String)]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(String
s, String
"")]
        else do
            GenLocated SrcSpanAnnA (HsExpr GhcPs)
x <- (ParseFlags
 -> String -> ParseResult (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Val -> Parser (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall v.
(ParseFlags -> String -> ParseResult v) -> Val -> Parser v
parseGHC ParseFlags -> String -> ParseResult (LHsExpr GhcPs)
ParseFlags
-> String -> ParseResult (GenLocated SrcSpanAnnA (HsExpr GhcPs))
parseExpGhcWithMode Val
v
            case GenLocated SrcSpanAnnA (HsExpr GhcPs)
x of
                L SrcSpanAnnA
_ (HsVar XVar GhcPs
_ (L SrcSpanAnnN
_ (Unqual OccName
x))) -> [(String, String)] -> Parser [(String, String)]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(String, String)] -> Parser [(String, String)])
-> [(String, String)] -> Parser [(String, String)]
forall a b. (a -> b) -> a -> b
$ String -> String -> [(String, String)]
f String
"" (OccName -> String
occNameString OccName
x)
                L SrcSpanAnnA
_ (HsVar XVar GhcPs
_ (L SrcSpanAnnN
_ (Qual ModuleName
mod OccName
x))) -> [(String, String)] -> Parser [(String, String)]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(String, String)] -> Parser [(String, String)])
-> [(String, String)] -> Parser [(String, String)]
forall a b. (a -> b) -> a -> b
$ String -> String -> [(String, String)]
f (ModuleName -> String
moduleNameString ModuleName
mod) (OccName -> String
occNameString OccName
x)
                GenLocated SrcSpanAnnA (HsExpr GhcPs)
_ -> Val -> String -> Parser [(String, String)]
forall a. Val -> String -> Parser a
parseFail Val
v String
"Bad classification rule"
            where
                f :: String -> String -> [(String, String)]
f String
mod name :: String
name@(Char
c:String
_) | Char -> Bool
isUpper Char
c = [(String
mod,String
name),(String
mod String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
'.' | String
mod String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
""] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name, String
"")]
                f String
mod String
name = [(String
mod, String
name)]

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


guessName :: LHsExpr GhcPs -> LHsExpr GhcPs -> String
guessName :: LHsExpr GhcPs -> LHsExpr GhcPs -> String
guessName LHsExpr GhcPs
lhs LHsExpr GhcPs
rhs
    | String
n:[String]
_ <- [String]
rs [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
ls = String
"Use " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n
    | String
n:[String]
_ <- [String]
ls [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
rs = String
"Redundant " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n
    | Bool
otherwise = String
defaultHintName
    where
        ([String]
ls, [String]
rs) = (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [String])
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs),
    GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> ([String], [String])
forall a b. (a -> b) -> (a, a) -> (b, b)
both LHsExpr GhcPs -> [String]
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [String]
f (LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs, LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs)
        f :: LHsExpr GhcPs -> [String]
        f :: LHsExpr GhcPs -> [String]
f LHsExpr GhcPs
x = [String
y | L SrcSpanAnnA
_ (HsVar XVar GhcPs
_ (L SrcSpanAnnN
_ RdrName
x)) <- GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall on. Uniplate on => on -> [on]
universe LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x, let y :: String
y = RdrName -> String
occNameStr RdrName
x, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
isUnifyVar String
y, String
y String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"."]


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


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

settingsFromConfigYaml :: [ConfigYaml] -> [Setting]
settingsFromConfigYaml :: [ConfigYaml] -> [Setting]
settingsFromConfigYaml ([ConfigYaml] -> ConfigYaml
forall a. Monoid a => [a] -> a
mconcat -> ConfigYaml [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 Package
x <- [ConfigItem]
configs]
        groups :: [Group]
groups = [Group
x | ConfigGroup Group
x <- [ConfigItem]
configs]
        settings :: [Setting]
settings = [[Setting]] -> [Setting]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Setting]
x | ConfigSetting [Setting]
x <- [ConfigItem]
configs]
        packageMap' :: HashMap String [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
packageMap' = ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
 -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
 -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
-> [(String, [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])]
-> HashMap String [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
Map.fromListWith [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a. [a] -> [a] -> [a]
(++) [(String
packageName, (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
 -> GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> [HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
forall a. HsExtendInstances a -> a
unextendInstances [HsExtendInstances (LImportDecl GhcPs)]
[HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
packageModules) | Package{String
[HsExtendInstances (LImportDecl GhcPs)]
packageName :: Package -> String
packageModules :: Package -> [HsExtendInstances (LImportDecl GhcPs)]
packageName :: String
packageModules :: [HsExtendInstances (LImportDecl GhcPs)]
..} <- [Package]
packages]
        groupMap :: HashMap String Bool
groupMap = (Bool -> Bool -> Bool) -> [(String, Bool)] -> HashMap String Bool
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
Map.fromListWith (\Bool
new Bool
old -> Bool
new) [(String
groupName, Bool
groupEnabled) | Group{Bool
String
[Either String (HsExtendInstances (LImportDecl GhcPs))]
[Either HintRule Classify]
groupName :: Group -> String
groupEnabled :: Group -> Bool
groupImports :: Group -> [Either String (HsExtendInstances (LImportDecl GhcPs))]
groupRules :: Group -> [Either HintRule Classify]
groupName :: String
groupEnabled :: Bool
groupImports :: [Either String (HsExtendInstances (LImportDecl GhcPs))]
groupRules :: [Either HintRule Classify]
..} <- [Group]
groups]

        f :: Group -> [Setting]
f Group{Bool
String
[Either String (HsExtendInstances (LImportDecl GhcPs))]
[Either HintRule Classify]
groupName :: Group -> String
groupEnabled :: Group -> Bool
groupImports :: Group -> [Either String (HsExtendInstances (LImportDecl GhcPs))]
groupRules :: Group -> [Either HintRule Classify]
groupName :: String
groupEnabled :: Bool
groupImports :: [Either String (HsExtendInstances (LImportDecl GhcPs))]
groupRules :: [Either HintRule Classify]
..}
            | String -> HashMap String Bool -> Maybe Bool
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup String
groupName HashMap String 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 (\HintRule
r -> HintRule -> Setting
SettingMatchExp HintRule
r{hintRuleScope=scope'}) Classify -> Setting
SettingClassify) [Either HintRule Classify]
groupRules
            where
              scope' :: Scope
scope'= HashMap String [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [Either String (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
-> Scope
asScope' HashMap String [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
packageMap' ((Either
   String
   (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
 -> Either String (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> [Either
      String
      (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))]
-> [Either String (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map ((HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
 -> GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> Either
     String
     (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> Either String (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
forall a. HsExtendInstances a -> a
unextendInstances) [Either String (HsExtendInstances (LImportDecl GhcPs))]
[Either
   String
   (HsExtendInstances (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))]
groupImports)

asScope' :: Map.HashMap String [LocatedA (ImportDecl GhcPs)] -> [Either String (LocatedA (ImportDecl GhcPs))] -> Scope
asScope' :: HashMap String [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [Either String (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
-> Scope
asScope' HashMap String [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
packages [Either String (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
xs = HsModule GhcPs -> Scope
scopeCreate (XCModule GhcPs
-> Maybe (XRec GhcPs ModuleName)
-> Maybe (XRec GhcPs [LIE GhcPs])
-> [LImportDecl GhcPs]
-> [LHsDecl GhcPs]
-> HsModule GhcPs
forall p.
XCModule p
-> Maybe (XRec p ModuleName)
-> Maybe (XRec p [LIE p])
-> [LImportDecl p]
-> [LHsDecl p]
-> HsModule p
HsModule (EpAnn AnnsModule
-> LayoutInfo GhcPs
-> Maybe (LocatedP (WarningTxt GhcPs))
-> Maybe (LHsDoc GhcPs)
-> XModulePs
XModulePs EpAnn AnnsModule
forall ann. EpAnn ann
EpAnnNotUsed LayoutInfo GhcPs
forall pass. LayoutInfo pass
NoLayoutInfo Maybe (LocatedP (WarningTxt GhcPs))
forall a. Maybe a
Nothing Maybe (LHsDoc GhcPs)
forall a. Maybe a
Nothing) Maybe (XRec GhcPs ModuleName)
Maybe (GenLocated SrcSpanAnnA ModuleName)
forall a. Maybe a
Nothing Maybe (XRec GhcPs [LIE GhcPs])
Maybe (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
forall a. Maybe a
Nothing ((Either String (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
 -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
-> [Either String (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Either String (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
f [Either String (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
xs) [])
    where
        f :: Either String (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
f (Right GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x) = [GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x]
        f (Left String
x) | Just [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
pkg <- String
-> HashMap String [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> Maybe [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup String
x HashMap String [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
packages = [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
pkg
                   | Bool
otherwise = String -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a. HasCallStack => String -> a
error (String -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
-> String -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a b. (a -> b) -> a -> b
$ String
"asScope' failed to do lookup, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x