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

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

import Config.Type
import Data.Either
import Data.Maybe
import Data.List.Extra
import Data.Tuple.Extra
import Control.Monad.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 Data.Generics.Uniplate.DataOnly
import GHC.All
import Fixity
import Extension
import GHC.Unit.Module
import Data.Functor
import Data.Semigroup
import Timing
import Prelude

import GHC.Data.Bag
import GHC.Parser.Lexer
import GHC.Utils.Error hiding (Severity)
import GHC.Utils.Outputable
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

#ifdef HS_YAML

import Data.YAML (Pos)
import Data.YAML.Aeson (encode1Strict, decode1Strict)
import Data.Aeson hiding (encode)
import Data.Aeson.Types (Parser)
import qualified Data.ByteString 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


-- | 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 FilePath
file Maybe FilePath
contents = FilePath -> FilePath -> IO ConfigYaml -> IO ConfigYaml
forall a. FilePath -> FilePath -> IO a -> IO a
timedIO FilePath
"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
        Maybe FilePath
Nothing -> FilePath -> IO (Either ParseException ConfigYaml)
forall a. FromJSON a => FilePath -> IO (Either ParseException a)
decodeFileEither FilePath
file
        Just FilePath
src -> Either ParseException ConfigYaml
-> IO (Either ParseException ConfigYaml)
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
$ 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 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
$ FilePath
"Failed to read YAML configuration file " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n  " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ParseException -> FilePath
forall e. Exception e => e -> FilePath
displayException ParseException
e
        Right ConfigYaml
v -> ConfigYaml -> IO ConfigYaml
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 -> [HsExtendInstances (LImportDecl GhcPs)]
packageModules :: [HsExtendInstances (LImportDecl GhcPs)]
    } 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 (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 -> 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 Value
x = Value -> [(FilePath, Value)] -> Val
Val Value
x [(FilePath
"root", Value
x)]

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

addVal :: String -> Value -> Val -> Val
addVal :: FilePath -> Value -> Val -> Val
addVal FilePath
key Value
v (Val Value
focus [(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 Value
focus [(FilePath, Value)]
path) 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
$
    FilePath
"Error when decoding YAML, " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
msg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
    FilePath
"Along path: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords [FilePath]
steps FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
    FilePath
"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]
++ FilePath
"\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 (\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
        ([FilePath]
steps, [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 ByteString
x = let (ByteString
a,ByteString
b) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
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 FilePath
"" else FilePath
"...")

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 -> FilePath -> Value -> Val -> Val
addVal (Integer -> FilePath
forall a. Show a => a -> FilePath
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 (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 HashMap Text Value
x) = HashMap Text Value -> Parser (HashMap Text Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap Text Value
x
parseObject Val
v = Val -> FilePath -> Parser (HashMap Text Value)
forall a. Val -> FilePath -> Parser a
parseFail Val
v FilePath
"Expected an Object"

parseObject1 :: Val -> Parser (String, Val)
parseObject1 :: Val -> Parser (FilePath, 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 -> 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
        [Text]
_ -> 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
$ FilePath
"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 Text
x) = FilePath -> Parser FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> Parser FilePath) -> FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
x
parseString Val
v = Val -> FilePath -> Parser FilePath
forall a. Val -> FilePath -> Parser a
parseFail Val
v FilePath
"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 -> FilePath -> Parser Int
forall a. Val -> FilePath -> Parser a
parseFail Val
v FilePath
"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

maybeParse :: (Val -> Parser a) -> Maybe Val -> Parser (Maybe a)
maybeParse :: (Val -> Parser a) -> Maybe Val -> Parser (Maybe a)
maybeParse Val -> Parser a
parseValue Maybe Val
Nothing = Maybe a -> Parser (Maybe 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

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

parseField :: String -> Val -> Parser Val
parseField :: FilePath -> Val -> Parser Val
parseField FilePath
s Val
v = do
    Maybe Val
x <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt FilePath
s Val
v
    case Maybe Val
x of
        Maybe Val
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
$ FilePath
"Expected a field named " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
        Just Val
v -> Val -> Parser Val
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v

parseFieldOpt :: String -> Val -> Parser (Maybe Val)
parseFieldOpt :: FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt FilePath
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 (FilePath -> Text
T.pack FilePath
s) HashMap Text Value
mp of
        Maybe Value
Nothing -> Maybe Val -> Parser (Maybe Val)
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 (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
$ FilePath -> Value -> Val -> Val
addVal FilePath
s Value
x Val
v

allowFields :: Val -> [String] -> Parser ()
allowFields :: Val -> [FilePath] -> Parser ()
allowFields Val
v [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
$ FilePath
"Not allowed keys: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords [FilePath]
bad
          FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
", Allowed keys: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords [FilePath]
allow

parseGHC :: (ParseFlags -> String -> ParseResult v) -> Val -> Parser v
parseGHC :: (ParseFlags -> FilePath -> ParseResult v) -> Val -> Parser v
parseGHC ParseFlags -> FilePath -> ParseResult v
parser Val
v = do
    FilePath
x <- Val -> Parser FilePath
parseString Val
v
    case ParseFlags -> FilePath -> ParseResult v
parser ParseFlags
defaultParseFlags{enabledExtensions :: [Extension]
enabledExtensions=[Extension]
configExtensions, disabledExtensions :: [Extension]
disabledExtensions=[]} FilePath
x of
        POk PState
_ v
x -> v -> Parser v
forall (f :: * -> *) a. Applicative f => a -> f a
pure v
x
        PFailed PState
ps ->
          let (WarningMessages
_, WarningMessages
errs) = PState -> DynFlags -> (WarningMessages, WarningMessages)
getMessages PState
ps DynFlags
baseDynFlags
              errMsg :: ErrMsg
errMsg = [ErrMsg] -> ErrMsg
forall a. [a] -> a
head (WarningMessages -> [ErrMsg]
forall a. Bag a -> [a]
bagToList WarningMessages
errs)
              msg :: FilePath
msg = DynFlags -> SDoc -> FilePath
GHC.Utils.Outputable.showSDoc DynFlags
baseDynFlags (SDoc -> FilePath) -> SDoc -> FilePath
forall a b. (a -> b) -> a -> b
$ ErrMsg -> SDoc
GHC.Utils.Error.pprLocErrMsg ErrMsg
errMsg
          in 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
$ FilePath
"Failed to parse " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
msg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
", 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 Value
Null = ConfigYaml -> Parser ConfigYaml
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigYaml
forall a. Monoid a => a
mempty
    parseJSON 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 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
$ \Val
o -> do
        (FilePath
s, Val
v) <- Val -> Parser (FilePath, Val)
parseObject1 Val
o
        case FilePath
s of
            FilePath
"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
            FilePath
"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
            FilePath
"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
            FilePath
"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
            FilePath
"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
            FilePath
_ | 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
            FilePath
_ | Just 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))
            FilePath
_ -> Val -> FilePath -> Parser ConfigItem
forall a. Val -> FilePath -> Parser a
parseFail Val
v FilePath
"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
    FilePath
packageName <- FilePath -> Val -> Parser Val
parseField FilePath
"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
    [HsExtendInstances (LImportDecl GhcPs)]
packageModules <- FilePath -> Val -> Parser Val
parseField FilePath
"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 [HsExtendInstances (LImportDecl GhcPs)])
-> Parser [HsExtendInstances (LImportDecl GhcPs)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Val -> Parser (HsExtendInstances (LImportDecl GhcPs)))
-> [Val] -> Parser [HsExtendInstances (LImportDecl GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((LImportDecl GhcPs -> HsExtendInstances (LImportDecl GhcPs))
-> Parser (LImportDecl GhcPs)
-> Parser (HsExtendInstances (LImportDecl GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LImportDecl GhcPs -> HsExtendInstances (LImportDecl GhcPs)
forall a. a -> HsExtendInstances a
extendInstances (Parser (LImportDecl GhcPs)
 -> Parser (HsExtendInstances (LImportDecl GhcPs)))
-> (Val -> Parser (LImportDecl GhcPs))
-> Val
-> Parser (HsExtendInstances (LImportDecl GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParseFlags -> FilePath -> ParseResult (LImportDecl GhcPs))
-> Val -> Parser (LImportDecl GhcPs)
forall v.
(ParseFlags -> FilePath -> ParseResult v) -> Val -> Parser v
parseGHC ParseFlags -> FilePath -> ParseResult (LImportDecl GhcPs)
parseImportDeclGhcWithMode)
    Val -> [FilePath] -> Parser ()
allowFields Val
v [FilePath
"name",FilePath
"modules"]
    Package -> Parser Package
forall (f :: * -> *) a. Applicative f => a -> f a
pure Package :: FilePath -> [HsExtendInstances (LImportDecl GhcPs)] -> Package
Package{FilePath
[HsExtendInstances (LImportDecl GhcPs)]
packageModules :: [HsExtendInstances (LImportDecl GhcPs)]
packageName :: FilePath
packageModules :: [HsExtendInstances (LImportDecl GhcPs)]
packageName :: FilePath
..}

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 (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 -> FilePath -> ParseResult (LHsDecl GhcPs))
-> Val -> Parser (LHsDecl GhcPs)
forall v.
(ParseFlags -> FilePath -> ParseResult v) -> Val -> Parser v
parseGHC ParseFlags -> FilePath -> ParseResult (LHsDecl GhcPs)
parseDeclGhcWithMode (Val -> Parser (LHsDecl GhcPs))
-> (LHsDecl GhcPs -> Parser [Setting]) -> Val -> Parser [Setting]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> LHsDecl 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 (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 -> FilePath -> Parser [Setting]
forall a. Val -> FilePath -> Parser a
parseFail Val
v FilePath
"Expected fixity declaration"

parseSmell :: Val -> Parser [Setting]
parseSmell :: Val -> Parser [Setting]
parseSmell Val
v = do
  FilePath
smellName <- FilePath -> Val -> Parser Val
parseField FilePath
"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 FilePath
"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 FilePath
"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 (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 :: Val -> FilePath -> Maybe a -> Parser a
require Val
_ FilePath
_ (Just a
a) = a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
      require Val
val FilePath
err Maybe a
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 Val
v = do
    FilePath
groupName <- FilePath -> Val -> Parser Val
parseField FilePath
"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 FilePath
"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 (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) Val -> Parser Bool
parseBool
    [Either FilePath (HsExtendInstances (LImportDecl GhcPs))]
groupImports <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt FilePath
"imports" Val
v Parser (Maybe Val)
-> (Maybe Val
    -> Parser
         [Either FilePath (HsExtendInstances (LImportDecl GhcPs))])
-> Parser [Either FilePath (HsExtendInstances (LImportDecl GhcPs))]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser [Either FilePath (HsExtendInstances (LImportDecl GhcPs))]
-> (Val
    -> Parser
         [Either FilePath (HsExtendInstances (LImportDecl GhcPs))])
-> Maybe Val
-> Parser [Either FilePath (HsExtendInstances (LImportDecl GhcPs))]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Either FilePath (HsExtendInstances (LImportDecl GhcPs))]
-> Parser [Either FilePath (HsExtendInstances (LImportDecl GhcPs))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (Val -> Parser [Val]
parseArray (Val -> Parser [Val])
-> ([Val]
    -> Parser
         [Either FilePath (HsExtendInstances (LImportDecl GhcPs))])
-> Val
-> Parser [Either FilePath (HsExtendInstances (LImportDecl GhcPs))]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Val
 -> Parser
      (Either FilePath (HsExtendInstances (LImportDecl GhcPs))))
-> [Val]
-> Parser [Either FilePath (HsExtendInstances (LImportDecl GhcPs))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Val
-> Parser (Either FilePath (HsExtendInstances (LImportDecl GhcPs)))
parseImport)
    [Either HintRule Classify]
groupRules <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt FilePath
"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 (f :: * -> *) a. Applicative f => a -> f a
pure []) 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 [FilePath
"name",FilePath
"enabled",FilePath
"imports",FilePath
"rules"]
    Group -> Parser Group
forall (f :: * -> *) a. Applicative f => a -> f a
pure Group :: FilePath
-> Bool
-> [Either FilePath (HsExtendInstances (LImportDecl GhcPs))]
-> [Either HintRule Classify]
-> Group
Group{Bool
FilePath
[Either FilePath (HsExtendInstances (LImportDecl GhcPs))]
[Either HintRule Classify]
groupRules :: [Either HintRule Classify]
groupImports :: [Either FilePath (HsExtendInstances (LImportDecl GhcPs))]
groupEnabled :: Bool
groupName :: FilePath
groupRules :: [Either HintRule Classify]
groupImports :: [Either FilePath (HsExtendInstances (LImportDecl GhcPs))]
groupEnabled :: Bool
groupName :: FilePath
..}
    where
        parseImport :: Val
-> Parser (Either FilePath (HsExtendInstances (LImportDecl GhcPs)))
parseImport Val
v = do
            FilePath
x <- Val -> Parser FilePath
parseString Val
v
            case FilePath -> (FilePath, FilePath)
word1 FilePath
x of
                 (FilePath
"package", FilePath
x) -> Either FilePath (HsExtendInstances (LImportDecl GhcPs))
-> Parser (Either FilePath (HsExtendInstances (LImportDecl GhcPs)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (HsExtendInstances (LImportDecl GhcPs))
 -> Parser
      (Either FilePath (HsExtendInstances (LImportDecl GhcPs))))
-> Either FilePath (HsExtendInstances (LImportDecl GhcPs))
-> Parser (Either FilePath (HsExtendInstances (LImportDecl GhcPs)))
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath (HsExtendInstances (LImportDecl GhcPs))
forall a b. a -> Either a b
Left FilePath
x
                 (FilePath, FilePath)
_ -> HsExtendInstances (LImportDecl GhcPs)
-> Either FilePath (HsExtendInstances (LImportDecl GhcPs))
forall a b. b -> Either a b
Right (HsExtendInstances (LImportDecl GhcPs)
 -> Either FilePath (HsExtendInstances (LImportDecl GhcPs)))
-> (LImportDecl GhcPs -> HsExtendInstances (LImportDecl GhcPs))
-> LImportDecl GhcPs
-> Either FilePath (HsExtendInstances (LImportDecl GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LImportDecl GhcPs -> HsExtendInstances (LImportDecl GhcPs)
forall a. a -> HsExtendInstances a
extendInstances (LImportDecl GhcPs
 -> Either FilePath (HsExtendInstances (LImportDecl GhcPs)))
-> Parser (LImportDecl GhcPs)
-> Parser (Either FilePath (HsExtendInstances (LImportDecl GhcPs)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParseFlags -> FilePath -> ParseResult (LImportDecl GhcPs))
-> Val -> Parser (LImportDecl GhcPs)
forall v.
(ParseFlags -> FilePath -> ParseResult v) -> Val -> Parser v
parseGHC ParseFlags -> FilePath -> ParseResult (LImportDecl GhcPs)
parseImportDeclGhcWithMode Val
v

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

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

        Val -> [FilePath] -> Parser ()
allowFields Val
v [FilePath
"lhs",FilePath
"rhs",FilePath
"note",FilePath
"name",FilePath
"side"]
        let hintRuleScope :: Scope
hintRuleScope = Scope
forall a. Monoid a => a
mempty
        [Either HintRule Classify] -> Parser [Either HintRule Classify]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [HintRule -> Either HintRule Classify
forall a b. a -> Either a b
Left HintRule :: Severity
-> FilePath
-> [Note]
-> Scope
-> HsExtendInstances (LHsExpr GhcPs)
-> HsExtendInstances (LHsExpr GhcPs)
-> Maybe (HsExtendInstances (LHsExpr GhcPs))
-> HintRule
HintRule{hintRuleSeverity :: Severity
hintRuleSeverity=Severity
severity,hintRuleLHS :: HsExtendInstances (LHsExpr GhcPs)
hintRuleLHS=LHsExpr GhcPs -> HsExtendInstances (LHsExpr GhcPs)
forall a. a -> HsExtendInstances a
extendInstances LHsExpr GhcPs
lhs,hintRuleRHS :: HsExtendInstances (LHsExpr GhcPs)
hintRuleRHS=LHsExpr GhcPs -> HsExtendInstances (LHsExpr GhcPs)
forall a. a -> HsExtendInstances a
extendInstances LHsExpr GhcPs
rhs, FilePath
[Note]
Maybe (HsExtendInstances (LHsExpr GhcPs))
Scope
hintRuleSide :: Maybe (HsExtendInstances (LHsExpr GhcPs))
hintRuleScope :: Scope
hintRuleNotes :: [Note]
hintRuleName :: FilePath
hintRuleScope :: Scope
hintRuleName :: FilePath
hintRuleSide :: Maybe (HsExtendInstances (LHsExpr GhcPs))
hintRuleNotes :: [Note]
..}]
     else do
        [FilePath]
names <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt FilePath
"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 (f :: * -> *) a. Applicative f => a -> f a
pure []) Val -> Parser [FilePath]
parseArrayString
        [(FilePath, FilePath)]
within <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt FilePath
"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 (f :: * -> *) a. Applicative f => a -> f a
pure [(FilePath
"",FilePath
"")]) (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 (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 -> FilePath -> FilePath -> FilePath -> Classify
Classify Severity
severity FilePath
n FilePath
a FilePath
b | (FilePath
a,FilePath
b) <- [(FilePath, FilePath)]
within, FilePath
n <- [FilePath
"" | [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 Val
v = do
    Maybe Val
def <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt FilePath
"default" Val
v
    case Maybe Val
def of
        Just Val
def -> do
            Bool
b <- Val -> Parser Bool
parseBool Val
def
            Val -> [FilePath] -> Parser ()
allowFields Val
v [FilePath
"default"]
            Restrict -> Parser Restrict
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Restrict -> Parser Restrict) -> Restrict -> Parser Restrict
forall a b. (a -> b) -> a -> b
$ RestrictType
-> Bool
-> [FilePath]
-> [FilePath]
-> [(FilePath, FilePath)]
-> RestrictIdents
-> Maybe FilePath
-> Restrict
Restrict RestrictType
restrictType Bool
b [] [] [] RestrictIdents
NoRestrictIdents Maybe FilePath
forall a. Maybe a
Nothing
        Maybe Val
Nothing -> do
            [FilePath]
restrictName <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt FilePath
"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 (f :: * -> *) a. Applicative f => a -> f a
pure []) Val -> Parser [FilePath]
parseArrayString
            [(FilePath, FilePath)]
restrictWithin <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt FilePath
"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 (f :: * -> *) a. Applicative f => a -> f a
pure [(FilePath
"",FilePath
"")]) (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 FilePath
"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 (f :: * -> *) a. Applicative f => a -> f a
pure []) Val -> Parser [FilePath]
parseArrayString

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

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

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

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


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


asNote :: String -> Note
asNote :: FilePath -> Note
asNote FilePath
"IncreasesLaziness" = Note
IncreasesLaziness
asNote FilePath
"DecreasesLaziness" = Note
DecreasesLaziness
asNote (FilePath -> (FilePath, FilePath)
word1 -> (FilePath
"RemovesError",FilePath
x)) = FilePath -> Note
RemovesError FilePath
x
asNote (FilePath -> (FilePath, FilePath)
word1 -> (FilePath
"ValidInstance",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 -> (FilePath
"RequiresExtension",FilePath
x)) = FilePath -> Note
RequiresExtension FilePath
x
asNote 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 [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 FilePath [LImportDecl GhcPs]
packageMap' = ([LImportDecl GhcPs] -> [LImportDecl GhcPs] -> [LImportDecl GhcPs])
-> [(FilePath, [LImportDecl GhcPs])]
-> HashMap FilePath [LImportDecl GhcPs]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
Map.fromListWith [LImportDecl GhcPs] -> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
forall a. [a] -> [a] -> [a]
(++) [(FilePath
packageName, (HsExtendInstances (LImportDecl GhcPs) -> LImportDecl GhcPs)
-> [HsExtendInstances (LImportDecl GhcPs)] -> [LImportDecl GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsExtendInstances (LImportDecl GhcPs) -> LImportDecl GhcPs
forall a. HsExtendInstances a -> a
unextendInstances [HsExtendInstances (LImportDecl GhcPs)]
packageModules) | Package{FilePath
[HsExtendInstances (LImportDecl GhcPs)]
packageModules :: [HsExtendInstances (LImportDecl GhcPs)]
packageName :: FilePath
packageModules :: Package -> [HsExtendInstances (LImportDecl GhcPs)]
packageName :: Package -> FilePath
..} <- [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 (\Bool
new Bool
old -> Bool
new) [(FilePath
groupName, Bool
groupEnabled) | Group{Bool
FilePath
[Either FilePath (HsExtendInstances (LImportDecl GhcPs))]
[Either HintRule Classify]
groupRules :: [Either HintRule Classify]
groupImports :: [Either FilePath (HsExtendInstances (LImportDecl GhcPs))]
groupEnabled :: Bool
groupName :: FilePath
groupRules :: Group -> [Either HintRule Classify]
groupImports :: Group -> [Either FilePath (HsExtendInstances (LImportDecl GhcPs))]
groupEnabled :: Group -> Bool
groupName :: Group -> FilePath
..} <- [Group]
groups]

        f :: Group -> [Setting]
f Group{Bool
FilePath
[Either FilePath (HsExtendInstances (LImportDecl GhcPs))]
[Either HintRule Classify]
groupRules :: [Either HintRule Classify]
groupImports :: [Either FilePath (HsExtendInstances (LImportDecl GhcPs))]
groupEnabled :: Bool
groupName :: FilePath
groupRules :: Group -> [Either HintRule Classify]
groupImports :: Group -> [Either FilePath (HsExtendInstances (LImportDecl GhcPs))]
groupEnabled :: Group -> Bool
groupName :: Group -> FilePath
..}
            | 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 (\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 [LImportDecl GhcPs]
-> [Either FilePath (LImportDecl GhcPs)] -> Scope
asScope' HashMap FilePath [LImportDecl GhcPs]
packageMap' ((Either FilePath (HsExtendInstances (LImportDecl GhcPs))
 -> Either FilePath (LImportDecl GhcPs))
-> [Either FilePath (HsExtendInstances (LImportDecl GhcPs))]
-> [Either FilePath (LImportDecl GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map ((HsExtendInstances (LImportDecl GhcPs) -> LImportDecl GhcPs)
-> Either FilePath (HsExtendInstances (LImportDecl GhcPs))
-> Either FilePath (LImportDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsExtendInstances (LImportDecl GhcPs) -> LImportDecl GhcPs
forall a. HsExtendInstances a -> a
unextendInstances) [Either FilePath (HsExtendInstances (LImportDecl GhcPs))]
groupImports)

asScope' :: Map.HashMap String [LImportDecl GhcPs] -> [Either String (LImportDecl GhcPs)] -> Scope
asScope' :: HashMap FilePath [LImportDecl GhcPs]
-> [Either FilePath (LImportDecl GhcPs)] -> Scope
asScope' HashMap FilePath [LImportDecl GhcPs]
packages [Either FilePath (LImportDecl GhcPs)]
xs = HsModule -> Scope
scopeCreate (LayoutInfo
-> Maybe (Located ModuleName)
-> Maybe (Located [LIE GhcPs])
-> [LImportDecl GhcPs]
-> [LHsDecl GhcPs]
-> Maybe (Located WarningTxt)
-> Maybe LHsDocString
-> HsModule
HsModule LayoutInfo
NoLayoutInfo Maybe (Located ModuleName)
forall a. Maybe a
Nothing Maybe (Located [LIE GhcPs])
forall a. Maybe a
Nothing ((Either FilePath (LImportDecl GhcPs) -> [LImportDecl GhcPs])
-> [Either FilePath (LImportDecl GhcPs)] -> [LImportDecl GhcPs]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Either FilePath (LImportDecl GhcPs) -> [LImportDecl GhcPs]
f [Either FilePath (LImportDecl GhcPs)]
xs) [] Maybe (Located WarningTxt)
forall a. Maybe a
Nothing Maybe LHsDocString
forall a. Maybe a
Nothing)
    where
        f :: Either FilePath (LImportDecl GhcPs) -> [LImportDecl GhcPs]
f (Right LImportDecl GhcPs
x) = [LImportDecl GhcPs
x]
        f (Left FilePath
x) | Just [LImportDecl GhcPs]
pkg <- FilePath
-> HashMap FilePath [LImportDecl GhcPs]
-> Maybe [LImportDecl GhcPs]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup FilePath
x HashMap FilePath [LImportDecl GhcPs]
packages = [LImportDecl GhcPs]
pkg
                   | Bool
otherwise = FilePath -> [LImportDecl GhcPs]
forall a. HasCallStack => FilePath -> a
error (FilePath -> [LImportDecl GhcPs])
-> FilePath -> [LImportDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ FilePath
"asScope' failed to do lookup, " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x