{-# LANGUAGE OverloadedStrings, ViewPatterns, RecordWildCards, GeneralizedNewtypeDeriving, TupleSections #-}
module Config.Yaml(
ConfigYaml,
readFileConfigYaml,
settingsFromConfigYaml
) where
import Config.Type
import Data.Yaml
import Data.Either
import Data.Maybe
import Data.List.Extra
import Data.Tuple.Extra
import Control.Monad.Extra
import Control.Exception.Extra
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Data.ByteString.Char8 as BS
import qualified Data.HashMap.Strict as Map
import HSE.All hiding (Rule, String)
import Data.Functor
import Data.Semigroup
import Timing
import Util
import Prelude
import qualified Lexer as GHC
import qualified ErrUtils
import qualified Outputable
import qualified HsSyn
import GHC.Util (baseDynFlags, Scope',scopeCreate')
import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances
readFileConfigYaml :: FilePath -> Maybe String -> IO ConfigYaml
readFileConfigYaml :: FilePath -> Maybe FilePath -> IO ConfigYaml
readFileConfigYaml file :: FilePath
file contents :: Maybe FilePath
contents = FilePath -> FilePath -> IO ConfigYaml -> IO ConfigYaml
forall a. FilePath -> FilePath -> IO a -> IO a
timedIO "Config" FilePath
file (IO ConfigYaml -> IO ConfigYaml) -> IO ConfigYaml -> IO ConfigYaml
forall a b. (a -> b) -> a -> b
$ do
Either ParseException ConfigYaml
val <- case Maybe FilePath
contents of
Nothing -> FilePath -> IO (Either ParseException ConfigYaml)
forall a. FromJSON a => FilePath -> IO (Either ParseException a)
decodeFileEither FilePath
file
Just src :: FilePath
src -> Either ParseException ConfigYaml
-> IO (Either ParseException ConfigYaml)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseException ConfigYaml
-> IO (Either ParseException ConfigYaml))
-> Either ParseException ConfigYaml
-> IO (Either ParseException ConfigYaml)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ParseException ConfigYaml
forall a. FromJSON a => ByteString -> Either ParseException a
decodeEither' (ByteString -> Either ParseException ConfigYaml)
-> ByteString -> Either ParseException ConfigYaml
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString
BS.pack FilePath
src
case Either ParseException ConfigYaml
val of
Left e :: ParseException
e -> FilePath -> IO ConfigYaml
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO ConfigYaml) -> FilePath -> IO ConfigYaml
forall a b. (a -> b) -> a -> b
$ "Failed to read YAML configuration file " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "\n " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ParseException -> FilePath
forall e. Exception e => e -> FilePath
displayException ParseException
e
Right v :: ConfigYaml
v -> ConfigYaml -> IO ConfigYaml
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigYaml
v
newtype ConfigYaml = ConfigYaml [ConfigItem] deriving (b -> ConfigYaml -> ConfigYaml
NonEmpty ConfigYaml -> ConfigYaml
ConfigYaml -> ConfigYaml -> ConfigYaml
(ConfigYaml -> ConfigYaml -> ConfigYaml)
-> (NonEmpty ConfigYaml -> ConfigYaml)
-> (forall b. Integral b => b -> ConfigYaml -> ConfigYaml)
-> Semigroup ConfigYaml
forall b. Integral b => b -> ConfigYaml -> ConfigYaml
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> ConfigYaml -> ConfigYaml
$cstimes :: forall b. Integral b => b -> ConfigYaml -> ConfigYaml
sconcat :: NonEmpty ConfigYaml -> ConfigYaml
$csconcat :: NonEmpty ConfigYaml -> ConfigYaml
<> :: ConfigYaml -> ConfigYaml -> ConfigYaml
$c<> :: ConfigYaml -> ConfigYaml -> ConfigYaml
Semigroup,Semigroup ConfigYaml
ConfigYaml
Semigroup ConfigYaml =>
ConfigYaml
-> (ConfigYaml -> ConfigYaml -> ConfigYaml)
-> ([ConfigYaml] -> ConfigYaml)
-> Monoid ConfigYaml
[ConfigYaml] -> ConfigYaml
ConfigYaml -> ConfigYaml -> ConfigYaml
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [ConfigYaml] -> ConfigYaml
$cmconcat :: [ConfigYaml] -> ConfigYaml
mappend :: ConfigYaml -> ConfigYaml -> ConfigYaml
$cmappend :: ConfigYaml -> ConfigYaml -> ConfigYaml
mempty :: ConfigYaml
$cmempty :: ConfigYaml
$cp1Monoid :: Semigroup ConfigYaml
Monoid,Int -> ConfigYaml -> FilePath -> FilePath
[ConfigYaml] -> FilePath -> FilePath
ConfigYaml -> FilePath
(Int -> ConfigYaml -> FilePath -> FilePath)
-> (ConfigYaml -> FilePath)
-> ([ConfigYaml] -> FilePath -> FilePath)
-> Show ConfigYaml
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [ConfigYaml] -> FilePath -> FilePath
$cshowList :: [ConfigYaml] -> FilePath -> FilePath
show :: ConfigYaml -> FilePath
$cshow :: ConfigYaml -> FilePath
showsPrec :: Int -> ConfigYaml -> FilePath -> FilePath
$cshowsPrec :: Int -> ConfigYaml -> FilePath -> FilePath
Show)
data ConfigItem
= ConfigPackage Package
| ConfigGroup Group
| ConfigSetting [Setting]
deriving Int -> ConfigItem -> FilePath -> FilePath
[ConfigItem] -> FilePath -> FilePath
ConfigItem -> FilePath
(Int -> ConfigItem -> FilePath -> FilePath)
-> (ConfigItem -> FilePath)
-> ([ConfigItem] -> FilePath -> FilePath)
-> Show ConfigItem
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [ConfigItem] -> FilePath -> FilePath
$cshowList :: [ConfigItem] -> FilePath -> FilePath
show :: ConfigItem -> FilePath
$cshow :: ConfigItem -> FilePath
showsPrec :: Int -> ConfigItem -> FilePath -> FilePath
$cshowsPrec :: Int -> ConfigItem -> FilePath -> FilePath
Show
data Package = Package
{Package -> FilePath
packageName :: String
,Package -> [ImportDecl S]
packageModules :: [ImportDecl S]
,Package -> [HsExtendInstances (LImportDecl GhcPs)]
packageGhcModules :: [HsExtendInstances (HsSyn.LImportDecl HsSyn.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 (ImportDecl S)]
groupImports :: [Either String (ImportDecl S)]
,Group -> [Either FilePath (HsExtendInstances (LImportDecl GhcPs))]
groupGhcImports :: [Either String (HsExtendInstances (HsSyn.LImportDecl HsSyn.GhcPs))]
,Group -> [Either HintRule Classify]
groupRules :: [Either HintRule Classify]
} 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
data Val = Val
Value
[(String, Value)]
newVal :: Value -> Val
newVal :: Value -> Val
newVal x :: Value
x = Value -> [(FilePath, Value)] -> Val
Val Value
x [("root", Value
x)]
getVal :: Val -> Value
getVal :: Val -> Value
getVal (Val x :: Value
x _) = Value
x
addVal :: String -> Value -> Val -> Val
addVal :: FilePath -> Value -> Val -> Val
addVal key :: FilePath
key v :: Value
v (Val focus :: Value
focus path :: [(FilePath, Value)]
path) = Value -> [(FilePath, Value)] -> Val
Val Value
v ([(FilePath, Value)] -> Val) -> [(FilePath, Value)] -> Val
forall a b. (a -> b) -> a -> b
$ (FilePath
key,Value
v) (FilePath, Value) -> [(FilePath, Value)] -> [(FilePath, Value)]
forall a. a -> [a] -> [a]
: [(FilePath, Value)]
path
parseFail :: Val -> String -> Parser a
parseFail :: Val -> FilePath -> Parser a
parseFail (Val focus :: Value
focus path :: [(FilePath, Value)]
path) msg :: FilePath
msg = FilePath -> Parser a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Parser a) -> FilePath -> Parser a
forall a b. (a -> b) -> a -> b
$
"Error when decoding YAML, " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
msg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
"Along path: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords [FilePath]
steps FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
"When at: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst (FilePath -> (FilePath, FilePath)
word1 (FilePath -> (FilePath, FilePath))
-> FilePath -> (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ Value -> FilePath
forall a. Show a => a -> FilePath
show Value
focus) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
ByteString -> FilePath
dotDot (ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
focus) (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> Maybe ByteString
forall a. [a] -> Maybe a
listToMaybe ([ByteString] -> Maybe ByteString)
-> [ByteString] -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\x :: ByteString
x -> ByteString -> Int
BS.length ByteString
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 250) ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ (Value -> ByteString) -> [Value] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode [Value]
contexts)
where
(steps :: [FilePath]
steps, contexts :: [Value]
contexts) = [(FilePath, Value)] -> ([FilePath], [Value])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(FilePath, Value)] -> ([FilePath], [Value]))
-> [(FilePath, Value)] -> ([FilePath], [Value])
forall a b. (a -> b) -> a -> b
$ [(FilePath, Value)] -> [(FilePath, Value)]
forall a. [a] -> [a]
reverse [(FilePath, Value)]
path
dotDot :: ByteString -> FilePath
dotDot x :: ByteString
x = let (a :: ByteString
a,b :: ByteString
b) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt 250 ByteString
x in ByteString -> FilePath
BS.unpack ByteString
a FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (if ByteString -> Bool
BS.null ByteString
b then "" else "...")
parseArray :: Val -> Parser [Val]
parseArray :: Val -> Parser [Val]
parseArray v :: Val
v@(Val -> Value
getVal -> Array xs :: Array
xs) = (Val -> Parser [Val]) -> [Val] -> Parser [Val]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM Val -> Parser [Val]
parseArray ([Val] -> Parser [Val]) -> [Val] -> Parser [Val]
forall a b. (a -> b) -> a -> b
$ (Integer -> Value -> Val) -> [Integer] -> [Value] -> [Val]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\i :: Integer
i x :: Value
x -> FilePath -> Value -> Val -> Val
addVal (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
i) Value
x Val
v) [0..] ([Value] -> [Val]) -> [Value] -> [Val]
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
xs
parseArray v :: Val
v = [Val] -> Parser [Val]
forall (m :: * -> *) a. Monad m => a -> m a
return [Val
v]
parseObject :: Val -> Parser (Map.HashMap T.Text Value)
parseObject :: Val -> Parser (HashMap Text Value)
parseObject (Val -> Value
getVal -> Object x :: HashMap Text Value
x) = HashMap Text Value -> Parser (HashMap Text Value)
forall (m :: * -> *) a. Monad m => a -> m a
return HashMap Text Value
x
parseObject v :: Val
v = Val -> FilePath -> Parser (HashMap Text Value)
forall a. Val -> FilePath -> Parser a
parseFail Val
v "Expected an Object"
parseObject1 :: Val -> Parser (String, Val)
parseObject1 :: Val -> Parser (FilePath, Val)
parseObject1 v :: Val
v = do
HashMap Text Value
mp <- Val -> Parser (HashMap Text Value)
parseObject Val
v
case HashMap Text Value -> [Text]
forall k v. HashMap k v -> [k]
Map.keys HashMap Text Value
mp of
[Text -> FilePath
T.unpack -> FilePath
s] -> (FilePath
s,) (Val -> (FilePath, Val)) -> Parser Val -> Parser (FilePath, Val)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Val -> Parser Val
parseField FilePath
s Val
v
_ -> Val -> FilePath -> Parser (FilePath, Val)
forall a. Val -> FilePath -> Parser a
parseFail Val
v (FilePath -> Parser (FilePath, Val))
-> FilePath -> Parser (FilePath, Val)
forall a b. (a -> b) -> a -> b
$ "Expected exactly one key but got " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (HashMap Text Value -> Int
forall k v. HashMap k v -> Int
Map.size HashMap Text Value
mp)
parseString :: Val -> Parser String
parseString :: Val -> Parser FilePath
parseString (Val -> Value
getVal -> String x :: Text
x) = FilePath -> Parser FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Parser FilePath) -> FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
x
parseString v :: Val
v = Val -> FilePath -> Parser FilePath
forall a. Val -> FilePath -> Parser a
parseFail Val
v "Expected a String"
parseInt :: Val -> Parser Int
parseInt :: Val -> Parser Int
parseInt (Val -> Value
getVal -> s :: Value
s@Number{}) = Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON Value
s
parseInt v :: Val
v = Val -> FilePath -> Parser Int
forall a. Val -> FilePath -> Parser a
parseFail Val
v "Expected an Int"
parseArrayString :: Val -> Parser [String]
parseArrayString :: Val -> Parser [FilePath]
parseArrayString = Val -> Parser [Val]
parseArray (Val -> Parser [Val])
-> ([Val] -> Parser [FilePath]) -> Val -> Parser [FilePath]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Val -> Parser FilePath) -> [Val] -> Parser [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Val -> Parser FilePath
parseString
maybeParse :: (Val -> Parser a) -> Maybe Val -> Parser (Maybe a)
maybeParse :: (Val -> Parser a) -> Maybe Val -> Parser (Maybe a)
maybeParse parseValue :: Val -> Parser a
parseValue Nothing = Maybe a -> Parser (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
maybeParse parseValue :: Val -> Parser a
parseValue (Just value :: 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 b :: Bool
b) = Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
b
parseBool v :: Val
v = Val -> FilePath -> Parser Bool
forall a. Val -> FilePath -> Parser a
parseFail Val
v "Expected a Bool"
parseField :: String -> Val -> Parser Val
parseField :: FilePath -> Val -> Parser Val
parseField s :: FilePath
s v :: Val
v = do
Maybe Val
x <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt FilePath
s Val
v
case Maybe Val
x of
Nothing -> Val -> FilePath -> Parser Val
forall a. Val -> FilePath -> Parser a
parseFail Val
v (FilePath -> Parser Val) -> FilePath -> Parser Val
forall a b. (a -> b) -> a -> b
$ "Expected a field named " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
Just v :: Val
v -> Val -> Parser Val
forall (m :: * -> *) a. Monad m => a -> m a
return Val
v
parseFieldOpt :: String -> Val -> Parser (Maybe Val)
parseFieldOpt :: FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt s :: FilePath
s v :: Val
v = do
HashMap Text Value
mp <- Val -> Parser (HashMap Text Value)
parseObject Val
v
case Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (FilePath -> Text
T.pack FilePath
s) HashMap Text Value
mp of
Nothing -> Maybe Val -> Parser (Maybe Val)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Val
forall a. Maybe a
Nothing
Just x :: Value
x -> Maybe Val -> Parser (Maybe Val)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Val -> Parser (Maybe Val))
-> Maybe Val -> Parser (Maybe Val)
forall a b. (a -> b) -> a -> b
$ Val -> Maybe Val
forall a. a -> Maybe a
Just (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ FilePath -> Value -> Val -> Val
addVal FilePath
s Value
x Val
v
allowFields :: Val -> [String] -> Parser ()
allowFields :: Val -> [FilePath] -> Parser ()
allowFields v :: Val
v allow :: [FilePath]
allow = do
HashMap Text Value
mp <- Val -> Parser (HashMap Text Value)
parseObject Val
v
let bad :: [FilePath]
bad = (Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
T.unpack (HashMap Text Value -> [Text]
forall k v. HashMap k v -> [k]
Map.keys HashMap Text Value
mp) [FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath]
allow
Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([FilePath]
bad [FilePath] -> [FilePath] -> Bool
forall a. Eq a => a -> a -> Bool
/= []) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
Val -> FilePath -> Parser ()
forall a. Val -> FilePath -> Parser a
parseFail Val
v (FilePath -> Parser ()) -> FilePath -> Parser ()
forall a b. (a -> b) -> a -> b
$ "Not allowed keys: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords [FilePath]
bad
parseHSE :: (ParseMode -> String -> ParseResult v) -> Val -> Parser v
parseHSE :: (ParseMode -> FilePath -> ParseResult v) -> Val -> Parser v
parseHSE parser :: ParseMode -> FilePath -> ParseResult v
parser v :: Val
v = do
FilePath
x <- Val -> Parser FilePath
parseString Val
v
case ParseMode -> FilePath -> ParseResult v
parser ParseMode
defaultParseMode{extensions :: [Extension]
extensions=[Extension]
configExtensions} FilePath
x of
ParseOk x :: v
x -> v -> Parser v
forall (m :: * -> *) a. Monad m => a -> m a
return v
x
ParseFailed loc :: SrcLoc
loc s :: FilePath
s ->
Val -> FilePath -> Parser v
forall a. Val -> FilePath -> Parser a
parseFail Val
v (FilePath -> Parser v) -> FilePath -> Parser v
forall a b. (a -> b) -> a -> b
$ "Failed to parse " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ", when parsing:\n " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x
parseGHC :: (ParseMode -> String -> GHC.ParseResult v) -> Val -> Parser v
parseGHC :: (ParseMode -> FilePath -> ParseResult v) -> Val -> Parser v
parseGHC parser :: ParseMode -> FilePath -> ParseResult v
parser v :: Val
v = do
FilePath
x <- Val -> Parser FilePath
parseString Val
v
case ParseMode -> FilePath -> ParseResult v
parser ParseMode
defaultParseMode{extensions :: [Extension]
extensions=[Extension]
configExtensions} FilePath
x of
GHC.POk _ x :: v
x -> v -> Parser v
forall (m :: * -> *) a. Monad m => a -> m a
return v
x
GHC.PFailed _ loc :: SrcSpan
loc err :: MsgDoc
err ->
let msg :: FilePath
msg = DynFlags -> MsgDoc -> FilePath
Outputable.showSDoc DynFlags
baseDynFlags (MsgDoc -> FilePath) -> MsgDoc -> FilePath
forall a b. (a -> b) -> a -> b
$
ErrMsg -> MsgDoc
ErrUtils.pprLocErrMsg (DynFlags -> SrcSpan -> MsgDoc -> ErrMsg
ErrUtils.mkPlainErrMsg DynFlags
baseDynFlags SrcSpan
loc MsgDoc
err)
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
$ "Failed to parse " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
msg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ", when parsing:\n " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x
instance FromJSON ConfigYaml where
parseJSON :: Value -> Parser ConfigYaml
parseJSON Null = ConfigYaml -> Parser ConfigYaml
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigYaml
forall a. Monoid a => a
mempty
parseJSON x :: Value
x = Val -> Parser ConfigYaml
parseConfigYaml (Val -> Parser ConfigYaml) -> Val -> Parser ConfigYaml
forall a b. (a -> b) -> a -> b
$ Value -> Val
newVal Value
x
parseConfigYaml :: Val -> Parser ConfigYaml
parseConfigYaml :: Val -> Parser ConfigYaml
parseConfigYaml v :: Val
v = do
[Val]
vs <- Val -> Parser [Val]
parseArray Val
v
([ConfigItem] -> ConfigYaml)
-> Parser [ConfigItem] -> Parser ConfigYaml
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ConfigItem] -> ConfigYaml
ConfigYaml (Parser [ConfigItem] -> Parser ConfigYaml)
-> Parser [ConfigItem] -> Parser ConfigYaml
forall a b. (a -> b) -> a -> b
$ [Val] -> (Val -> Parser ConfigItem) -> Parser [ConfigItem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Val]
vs ((Val -> Parser ConfigItem) -> Parser [ConfigItem])
-> (Val -> Parser ConfigItem) -> Parser [ConfigItem]
forall a b. (a -> b) -> a -> b
$ \o :: Val
o -> do
(s :: FilePath
s, v :: Val
v) <- Val -> Parser (FilePath, Val)
parseObject1 Val
o
case FilePath
s of
"package" -> Package -> ConfigItem
ConfigPackage (Package -> ConfigItem) -> Parser Package -> Parser ConfigItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Val -> Parser Package
parsePackage Val
v
"group" -> Group -> ConfigItem
ConfigGroup (Group -> ConfigItem) -> Parser Group -> Parser ConfigItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Val -> Parser Group
parseGroup Val
v
"arguments" -> [Setting] -> ConfigItem
ConfigSetting ([Setting] -> ConfigItem)
-> ([FilePath] -> [Setting]) -> [FilePath] -> ConfigItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Setting) -> [FilePath] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Setting
SettingArgument ([FilePath] -> ConfigItem)
-> Parser [FilePath] -> Parser ConfigItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Val -> Parser [FilePath]
parseArrayString Val
v
"fixity" -> [Setting] -> ConfigItem
ConfigSetting ([Setting] -> ConfigItem) -> Parser [Setting] -> Parser ConfigItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Val -> Parser [Setting]
parseFixity Val
v
"smell" -> [Setting] -> ConfigItem
ConfigSetting ([Setting] -> ConfigItem) -> Parser [Setting] -> Parser ConfigItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Val -> Parser [Setting]
parseSmell Val
v
_ | Maybe Severity -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Severity -> Bool) -> Maybe Severity -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe Severity
getSeverity FilePath
s -> Group -> ConfigItem
ConfigGroup (Group -> ConfigItem)
-> ([Either HintRule Classify] -> Group)
-> [Either HintRule Classify]
-> ConfigItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either HintRule Classify] -> Group
ruleToGroup ([Either HintRule Classify] -> ConfigItem)
-> Parser [Either HintRule Classify] -> Parser ConfigItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Val -> Parser [Either HintRule Classify]
parseRule Val
o
_ | Just r :: RestrictType
r <- FilePath -> Maybe RestrictType
getRestrictType FilePath
s -> [Setting] -> ConfigItem
ConfigSetting ([Setting] -> ConfigItem)
-> ([Restrict] -> [Setting]) -> [Restrict] -> ConfigItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Restrict -> Setting) -> [Restrict] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Restrict -> Setting
SettingRestrict ([Restrict] -> ConfigItem)
-> Parser [Restrict] -> Parser ConfigItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Val -> Parser [Val]
parseArray Val
v Parser [Val] -> ([Val] -> Parser [Restrict]) -> Parser [Restrict]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Val -> Parser Restrict) -> [Val] -> Parser [Restrict]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (RestrictType -> Val -> Parser Restrict
parseRestrict RestrictType
r))
_ -> Val -> FilePath -> Parser ConfigItem
forall a. Val -> FilePath -> Parser a
parseFail Val
v "Expecting an object with a 'package' or 'group' key, a hint or a restriction"
parsePackage :: Val -> Parser Package
parsePackage :: Val -> Parser Package
parsePackage v :: Val
v = do
FilePath
packageName <- FilePath -> Val -> Parser Val
parseField "name" Val
v Parser Val -> (Val -> Parser FilePath) -> Parser FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Val -> Parser FilePath
parseString
[ImportDecl S]
packageModules <- FilePath -> Val -> Parser Val
parseField "modules" Val
v Parser Val -> (Val -> Parser [Val]) -> Parser [Val]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Val -> Parser [Val]
parseArray Parser [Val]
-> ([Val] -> Parser [ImportDecl S]) -> Parser [ImportDecl S]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Val -> Parser (ImportDecl S)) -> [Val] -> Parser [ImportDecl S]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ParseMode -> FilePath -> ParseResult (ImportDecl S))
-> Val -> Parser (ImportDecl S)
forall v.
(ParseMode -> FilePath -> ParseResult v) -> Val -> Parser v
parseHSE ParseMode -> FilePath -> ParseResult (ImportDecl S)
parseImportDeclWithMode)
[HsExtendInstances (LImportDecl GhcPs)]
packageGhcModules <- FilePath -> Val -> Parser Val
parseField "modules" Val
v Parser Val -> (Val -> Parser [Val]) -> Parser [Val]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Val -> Parser [Val]
parseArray Parser [Val]
-> ([Val] -> Parser [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
<$> (ParseMode -> FilePath -> ParseResult (LImportDecl GhcPs))
-> Val -> Parser (LImportDecl GhcPs)
forall v.
(ParseMode -> FilePath -> ParseResult v) -> Val -> Parser v
parseGHC ParseMode -> FilePath -> ParseResult (LImportDecl GhcPs)
parseImportDeclGhcWithMode)
Val -> [FilePath] -> Parser ()
allowFields Val
v ["name","modules"]
Package -> Parser Package
forall (m :: * -> *) a. Monad m => a -> m a
return Package :: FilePath
-> [ImportDecl S]
-> [HsExtendInstances (LImportDecl GhcPs)]
-> Package
Package{..}
parseFixity :: Val -> Parser [Setting]
parseFixity :: Val -> Parser [Setting]
parseFixity v :: Val
v = Val -> Parser [Val]
parseArray Val
v Parser [Val] -> ([Val] -> Parser [Setting]) -> Parser [Setting]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Val -> Parser [Setting]) -> [Val] -> Parser [Setting]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM ((ParseMode -> FilePath -> ParseResult (Decl S))
-> Val -> Parser (Decl S)
forall v.
(ParseMode -> FilePath -> ParseResult v) -> Val -> Parser v
parseHSE ParseMode -> FilePath -> ParseResult (Decl S)
parseDeclWithMode (Val -> Parser (Decl S))
-> (Decl S -> Parser [Setting]) -> Val -> Parser [Setting]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Decl S -> Parser [Setting]
forall a. Decl a -> Parser [Setting]
f)
where
f :: Decl a -> Parser [Setting]
f x :: Decl a
x@InfixDecl{} = [Setting] -> Parser [Setting]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Setting] -> Parser [Setting]) -> [Setting] -> Parser [Setting]
forall a b. (a -> b) -> a -> b
$ (Fixity -> Setting) -> [Fixity] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Fixity -> Setting
Infix ([Fixity] -> [Setting]) -> [Fixity] -> [Setting]
forall a b. (a -> b) -> a -> b
$ Decl a -> [Fixity]
forall a. Decl a -> [Fixity]
getFixity Decl a
x
f _ = Val -> FilePath -> Parser [Setting]
forall a. Val -> FilePath -> Parser a
parseFail Val
v "Expected fixity declaration"
parseSmell :: Val -> Parser [Setting]
parseSmell :: Val -> Parser [Setting]
parseSmell v :: Val
v = do
FilePath
smellName <- FilePath -> Val -> Parser Val
parseField "type" Val
v Parser Val -> (Val -> Parser FilePath) -> Parser FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Val -> Parser FilePath
parseString
SmellType
smellType <- Val -> FilePath -> Maybe SmellType -> Parser SmellType
forall a. Val -> FilePath -> Maybe a -> Parser a
require Val
v "Expected SmellType" (Maybe SmellType -> Parser SmellType)
-> Maybe SmellType -> Parser SmellType
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe SmellType
getSmellType FilePath
smellName
Int
smellLimit <- FilePath -> Val -> Parser Val
parseField "limit" Val
v Parser Val -> (Val -> Parser Int) -> Parser Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Val -> Parser Int
parseInt
[Setting] -> Parser [Setting]
forall (m :: * -> *) a. Monad m => a -> m a
return [SmellType -> Int -> Setting
SettingSmell SmellType
smellType Int
smellLimit]
where
require :: Val -> String -> Maybe a -> Parser a
require :: Val -> FilePath -> Maybe a -> Parser a
require _ _ (Just a :: a
a) = a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
require val :: Val
val err :: FilePath
err Nothing = Val -> FilePath -> Parser a
forall a. Val -> FilePath -> Parser a
parseFail Val
val FilePath
err
parseGroup :: Val -> Parser Group
parseGroup :: Val -> Parser Group
parseGroup v :: Val
v = do
FilePath
groupName <- FilePath -> Val -> Parser Val
parseField "name" Val
v Parser Val -> (Val -> Parser FilePath) -> Parser FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Val -> Parser FilePath
parseString
Bool
groupEnabled <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "enabled" Val
v Parser (Maybe Val) -> (Maybe Val -> Parser Bool) -> Parser Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser Bool -> (Val -> Parser Bool) -> Maybe Val -> Parser Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) Val -> Parser Bool
parseBool
[Either FilePath (ImportDecl S)]
groupImports <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "imports" Val
v Parser (Maybe Val)
-> (Maybe Val -> Parser [Either FilePath (ImportDecl S)])
-> Parser [Either FilePath (ImportDecl S)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser [Either FilePath (ImportDecl S)]
-> (Val -> Parser [Either FilePath (ImportDecl S)])
-> Maybe Val
-> Parser [Either FilePath (ImportDecl S)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Either FilePath (ImportDecl S)]
-> Parser [Either FilePath (ImportDecl S)]
forall (m :: * -> *) a. Monad m => a -> m a
return []) (Val -> Parser [Val]
parseArray (Val -> Parser [Val])
-> ([Val] -> Parser [Either FilePath (ImportDecl S)])
-> Val
-> Parser [Either FilePath (ImportDecl S)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Val -> Parser (Either FilePath (ImportDecl S)))
-> [Val] -> Parser [Either FilePath (ImportDecl S)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Val -> Parser (Either FilePath (ImportDecl S))
parseImport)
[Either FilePath (HsExtendInstances (LImportDecl GhcPs))]
groupGhcImports <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "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 (m :: * -> *) a. Monad m => a -> m a
return []) (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)))
parseImportGHC)
[Either HintRule Classify]
groupRules <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "rules" Val
v Parser (Maybe Val) -> (Maybe Val -> Parser [Val]) -> Parser [Val]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser [Val] -> (Val -> Parser [Val]) -> Maybe Val -> Parser [Val]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Val] -> Parser [Val]
forall (m :: * -> *) a. Monad m => a -> m a
return []) Val -> Parser [Val]
parseArray Parser [Val]
-> ([Val] -> Parser [Either HintRule Classify])
-> Parser [Either HintRule Classify]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Val -> Parser [Either HintRule Classify])
-> [Val] -> Parser [Either HintRule Classify]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM Val -> Parser [Either HintRule Classify]
parseRule
Val -> [FilePath] -> Parser ()
allowFields Val
v ["name","enabled","imports","rules"]
Group -> Parser Group
forall (m :: * -> *) a. Monad m => a -> m a
return Group :: FilePath
-> Bool
-> [Either FilePath (ImportDecl S)]
-> [Either FilePath (HsExtendInstances (LImportDecl GhcPs))]
-> [Either HintRule Classify]
-> Group
Group{..}
where
parseImport :: Val -> Parser (Either FilePath (ImportDecl S))
parseImport v :: Val
v = do
FilePath
x <- Val -> Parser FilePath
parseString Val
v
case FilePath -> (FilePath, FilePath)
word1 FilePath
x of
("package", x :: FilePath
x) -> Either FilePath (ImportDecl S)
-> Parser (Either FilePath (ImportDecl S))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath (ImportDecl S)
-> Parser (Either FilePath (ImportDecl S)))
-> Either FilePath (ImportDecl S)
-> Parser (Either FilePath (ImportDecl S))
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath (ImportDecl S)
forall a b. a -> Either a b
Left FilePath
x
_ -> ImportDecl S -> Either FilePath (ImportDecl S)
forall a b. b -> Either a b
Right (ImportDecl S -> Either FilePath (ImportDecl S))
-> Parser (ImportDecl S) -> Parser (Either FilePath (ImportDecl S))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParseMode -> FilePath -> ParseResult (ImportDecl S))
-> Val -> Parser (ImportDecl S)
forall v.
(ParseMode -> FilePath -> ParseResult v) -> Val -> Parser v
parseHSE ParseMode -> FilePath -> ParseResult (ImportDecl S)
parseImportDeclWithMode Val
v
parseImportGHC :: Val
-> Parser (Either FilePath (HsExtendInstances (LImportDecl GhcPs)))
parseImportGHC v :: Val
v = do
FilePath
x <- Val -> Parser FilePath
parseString Val
v
case FilePath -> (FilePath, FilePath)
word1 FilePath
x of
("package", x :: FilePath
x) -> Either FilePath (HsExtendInstances (LImportDecl GhcPs))
-> Parser (Either FilePath (HsExtendInstances (LImportDecl GhcPs)))
forall (m :: * -> *) a. Monad m => a -> m a
return (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
_ -> 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
<$> (ParseMode -> FilePath -> ParseResult (LImportDecl GhcPs))
-> Val -> Parser (LImportDecl GhcPs)
forall v.
(ParseMode -> FilePath -> ParseResult v) -> Val -> Parser v
parseGHC ParseMode -> FilePath -> ParseResult (LImportDecl GhcPs)
parseImportDeclGhcWithMode Val
v
ruleToGroup :: [Either HintRule Classify] -> Group
ruleToGroup :: [Either HintRule Classify] -> Group
ruleToGroup = FilePath
-> Bool
-> [Either FilePath (ImportDecl S)]
-> [Either FilePath (HsExtendInstances (LImportDecl GhcPs))]
-> [Either HintRule Classify]
-> Group
Group "" Bool
True [] []
parseRule :: Val -> Parser [Either HintRule Classify]
parseRule :: Val -> Parser [Either HintRule Classify]
parseRule v :: Val
v = do
(severity :: Severity
severity, v :: Val
v) <- Val -> Parser (Severity, Val)
parseSeverityKey Val
v
Bool
isRule <- Maybe Val -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Val -> Bool) -> Parser (Maybe Val) -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "lhs" Val
v
if Bool
isRule then do
Exp S
hintRuleLHS <- FilePath -> Val -> Parser Val
parseField "lhs" Val
v Parser Val -> (Val -> Parser (Exp S)) -> Parser (Exp S)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ParseMode -> FilePath -> ParseResult (Exp S))
-> Val -> Parser (Exp S)
forall v.
(ParseMode -> FilePath -> ParseResult v) -> Val -> Parser v
parseHSE ParseMode -> FilePath -> ParseResult (Exp S)
parseExpWithMode
Exp S
hintRuleRHS <- FilePath -> Val -> Parser Val
parseField "rhs" Val
v Parser Val -> (Val -> Parser (Exp S)) -> Parser (Exp S)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ParseMode -> FilePath -> ParseResult (Exp S))
-> Val -> Parser (Exp S)
forall v.
(ParseMode -> FilePath -> ParseResult v) -> Val -> Parser v
parseHSE ParseMode -> FilePath -> ParseResult (Exp S)
parseExpWithMode
[Note]
hintRuleNotes <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "note" Val
v Parser (Maybe Val) -> (Maybe Val -> Parser [Note]) -> Parser [Note]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser [Note]
-> (Val -> Parser [Note]) -> Maybe Val -> Parser [Note]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Note] -> Parser [Note]
forall (m :: * -> *) a. Monad m => a -> m a
return []) (([FilePath] -> [Note]) -> Parser [FilePath] -> Parser [Note]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> Note) -> [FilePath] -> [Note]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Note
asNote) (Parser [FilePath] -> Parser [Note])
-> (Val -> Parser [FilePath]) -> Val -> Parser [Note]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val -> Parser [FilePath]
parseArrayString)
FilePath
hintRuleName <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "name" Val
v Parser (Maybe Val)
-> (Maybe Val -> Parser FilePath) -> Parser FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser FilePath
-> (Val -> Parser FilePath) -> Maybe Val -> Parser FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> Parser FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Parser FilePath) -> FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ Exp S -> Exp S -> FilePath
guessName Exp S
hintRuleLHS Exp S
hintRuleRHS) Val -> Parser FilePath
parseString
Maybe (Exp S)
hintRuleSide <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "side" Val
v Parser (Maybe Val)
-> (Maybe Val -> Parser (Maybe (Exp S))) -> Parser (Maybe (Exp S))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser (Maybe (Exp S))
-> (Val -> Parser (Maybe (Exp S)))
-> Maybe Val
-> Parser (Maybe (Exp S))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (Exp S) -> Parser (Maybe (Exp S))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Exp S)
forall a. Maybe a
Nothing) ((Exp S -> Maybe (Exp S))
-> Parser (Exp S) -> Parser (Maybe (Exp S))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp S -> Maybe (Exp S)
forall a. a -> Maybe a
Just (Parser (Exp S) -> Parser (Maybe (Exp S)))
-> (Val -> Parser (Exp S)) -> Val -> Parser (Maybe (Exp S))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseMode -> FilePath -> ParseResult (Exp S))
-> Val -> Parser (Exp S)
forall v.
(ParseMode -> FilePath -> ParseResult v) -> Val -> Parser v
parseHSE ParseMode -> FilePath -> ParseResult (Exp S)
parseExpWithMode)
HsExtendInstances (LHsExpr GhcPs)
hintRuleGhcLHS <- FilePath -> Val -> Parser Val
parseField "lhs" Val
v Parser Val
-> (Val -> Parser (HsExtendInstances (LHsExpr GhcPs)))
-> Parser (HsExtendInstances (LHsExpr GhcPs))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (LHsExpr GhcPs -> HsExtendInstances (LHsExpr GhcPs))
-> Parser (LHsExpr GhcPs)
-> Parser (HsExtendInstances (LHsExpr GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LHsExpr GhcPs -> HsExtendInstances (LHsExpr GhcPs)
forall a. a -> HsExtendInstances a
extendInstances (Parser (LHsExpr GhcPs)
-> Parser (HsExtendInstances (LHsExpr GhcPs)))
-> (Val -> Parser (LHsExpr GhcPs))
-> Val
-> Parser (HsExtendInstances (LHsExpr GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseMode -> FilePath -> ParseResult (LHsExpr GhcPs))
-> Val -> Parser (LHsExpr GhcPs)
forall v.
(ParseMode -> FilePath -> ParseResult v) -> Val -> Parser v
parseGHC ParseMode -> FilePath -> ParseResult (LHsExpr GhcPs)
parseExpGhcWithMode
HsExtendInstances (LHsExpr GhcPs)
hintRuleGhcRHS <- FilePath -> Val -> Parser Val
parseField "rhs" Val
v Parser Val
-> (Val -> Parser (HsExtendInstances (LHsExpr GhcPs)))
-> Parser (HsExtendInstances (LHsExpr GhcPs))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (LHsExpr GhcPs -> HsExtendInstances (LHsExpr GhcPs))
-> Parser (LHsExpr GhcPs)
-> Parser (HsExtendInstances (LHsExpr GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LHsExpr GhcPs -> HsExtendInstances (LHsExpr GhcPs)
forall a. a -> HsExtendInstances a
extendInstances (Parser (LHsExpr GhcPs)
-> Parser (HsExtendInstances (LHsExpr GhcPs)))
-> (Val -> Parser (LHsExpr GhcPs))
-> Val
-> Parser (HsExtendInstances (LHsExpr GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseMode -> FilePath -> ParseResult (LHsExpr GhcPs))
-> Val -> Parser (LHsExpr GhcPs)
forall v.
(ParseMode -> FilePath -> ParseResult v) -> Val -> Parser v
parseGHC ParseMode -> FilePath -> ParseResult (LHsExpr GhcPs)
parseExpGhcWithMode
Maybe (HsExtendInstances (LHsExpr GhcPs))
hintRuleGhcSide <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "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 (m :: * -> *) a. Monad m => a -> m a
return 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
. (ParseMode -> FilePath -> ParseResult (LHsExpr GhcPs))
-> Val -> Parser (LHsExpr GhcPs)
forall v.
(ParseMode -> FilePath -> ParseResult v) -> Val -> Parser v
parseGHC ParseMode -> FilePath -> ParseResult (LHsExpr GhcPs)
parseExpGhcWithMode)
Val -> [FilePath] -> Parser ()
allowFields Val
v ["lhs","rhs","note","name","side"]
let hintRuleScope :: Scope
hintRuleScope = Scope
forall a. Monoid a => a
mempty :: Scope
let hintRuleGhcScope :: HsExtendInstances Scope'
hintRuleGhcScope = Scope' -> HsExtendInstances Scope'
forall a. a -> HsExtendInstances a
extendInstances Scope'
forall a. Monoid a => a
mempty :: HsExtendInstances Scope'
[Either HintRule Classify] -> Parser [Either HintRule Classify]
forall (m :: * -> *) a. Monad m => a -> m a
return [HintRule -> Either HintRule Classify
forall a b. a -> Either a b
Left HintRule :: Severity
-> FilePath
-> Scope
-> Exp S
-> Exp S
-> Maybe (Exp S)
-> [Note]
-> HsExtendInstances Scope'
-> HsExtendInstances (LHsExpr GhcPs)
-> HsExtendInstances (LHsExpr GhcPs)
-> Maybe (HsExtendInstances (LHsExpr GhcPs))
-> HintRule
HintRule{hintRuleSeverity :: Severity
hintRuleSeverity=Severity
severity, ..}]
else do
[FilePath]
names <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "name" Val
v Parser (Maybe Val)
-> (Maybe Val -> Parser [FilePath]) -> Parser [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser [FilePath]
-> (Val -> Parser [FilePath]) -> Maybe Val -> Parser [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([FilePath] -> Parser [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []) Val -> Parser [FilePath]
parseArrayString
[(FilePath, FilePath)]
within <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "within" Val
v Parser (Maybe Val)
-> (Maybe Val -> Parser [(FilePath, FilePath)])
-> Parser [(FilePath, FilePath)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser [(FilePath, FilePath)]
-> (Val -> Parser [(FilePath, FilePath)])
-> Maybe Val
-> Parser [(FilePath, FilePath)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([(FilePath, FilePath)] -> Parser [(FilePath, FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return [("","")]) (Val -> Parser [Val]
parseArray (Val -> Parser [Val])
-> ([Val] -> Parser [(FilePath, FilePath)])
-> Val
-> Parser [(FilePath, FilePath)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Val -> Parser [(FilePath, FilePath)])
-> [Val] -> Parser [(FilePath, FilePath)]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM Val -> Parser [(FilePath, FilePath)]
parseWithin)
[Either HintRule Classify] -> Parser [Either HintRule Classify]
forall (m :: * -> *) a. Monad m => a -> m a
return [Classify -> Either HintRule Classify
forall a b. b -> Either a b
Right (Classify -> Either HintRule Classify)
-> Classify -> Either HintRule Classify
forall a b. (a -> b) -> a -> b
$ Severity -> FilePath -> FilePath -> FilePath -> Classify
Classify Severity
severity FilePath
n FilePath
a FilePath
b | (a :: FilePath
a,b :: FilePath
b) <- [(FilePath, FilePath)]
within, FilePath
n <- ["" | [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
names] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
names]
parseRestrict :: RestrictType -> Val -> Parser Restrict
parseRestrict :: RestrictType -> Val -> Parser Restrict
parseRestrict restrictType :: RestrictType
restrictType v :: Val
v = do
Maybe Val
def <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "default" Val
v
case Maybe Val
def of
Just def :: Val
def -> do
Bool
b <- Val -> Parser Bool
parseBool Val
def
Val -> [FilePath] -> Parser ()
allowFields Val
v ["default"]
Restrict -> Parser Restrict
forall (m :: * -> *) a. Monad m => a -> m a
return (Restrict -> Parser Restrict) -> Restrict -> Parser Restrict
forall a b. (a -> b) -> a -> b
$ RestrictType
-> Bool
-> [FilePath]
-> [FilePath]
-> [(FilePath, FilePath)]
-> [FilePath]
-> Maybe FilePath
-> Restrict
Restrict RestrictType
restrictType Bool
b [] [] [] [] Maybe FilePath
forall a. Maybe a
Nothing
Nothing -> do
[FilePath]
restrictName <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "name" Val
v Parser (Maybe Val)
-> (Maybe Val -> Parser [FilePath]) -> Parser [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser [FilePath]
-> (Val -> Parser [FilePath]) -> Maybe Val -> Parser [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([FilePath] -> Parser [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []) Val -> Parser [FilePath]
parseArrayString
[(FilePath, FilePath)]
restrictWithin <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "within" Val
v Parser (Maybe Val)
-> (Maybe Val -> Parser [(FilePath, FilePath)])
-> Parser [(FilePath, FilePath)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser [(FilePath, FilePath)]
-> (Val -> Parser [(FilePath, FilePath)])
-> Maybe Val
-> Parser [(FilePath, FilePath)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([(FilePath, FilePath)] -> Parser [(FilePath, FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return [("","")]) (Val -> Parser [Val]
parseArray (Val -> Parser [Val])
-> ([Val] -> Parser [(FilePath, FilePath)])
-> Val
-> Parser [(FilePath, FilePath)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Val -> Parser [(FilePath, FilePath)])
-> [Val] -> Parser [(FilePath, FilePath)]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM Val -> Parser [(FilePath, FilePath)]
parseWithin)
[FilePath]
restrictAs <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "as" Val
v Parser (Maybe Val)
-> (Maybe Val -> Parser [FilePath]) -> Parser [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser [FilePath]
-> (Val -> Parser [FilePath]) -> Maybe Val -> Parser [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([FilePath] -> Parser [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []) Val -> Parser [FilePath]
parseArrayString
[FilePath]
restrictBadIdents <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "badidents" 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 FilePath
restrictMessage <- FilePath -> Val -> Parser (Maybe Val)
parseFieldOpt "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
$ ["as" | RestrictType
restrictType RestrictType -> RestrictType -> Bool
forall a. Eq a => a -> a -> Bool
== RestrictType
RestrictModule] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ["badidents", "name", "within", "message"]
Restrict -> Parser Restrict
forall (m :: * -> *) a. Monad m => a -> m a
return Restrict :: RestrictType
-> Bool
-> [FilePath]
-> [FilePath]
-> [(FilePath, FilePath)]
-> [FilePath]
-> Maybe FilePath
-> Restrict
Restrict{restrictDefault :: Bool
restrictDefault=Bool
True,..}
parseWithin :: Val -> Parser [(String, String)]
parseWithin :: Val -> Parser [(FilePath, FilePath)]
parseWithin v :: Val
v = do
Exp S
x <- (ParseMode -> FilePath -> ParseResult (Exp S))
-> Val -> Parser (Exp S)
forall v.
(ParseMode -> FilePath -> ParseResult v) -> Val -> Parser v
parseHSE ParseMode -> FilePath -> ParseResult (Exp S)
parseExpWithMode Val
v
case Exp S
x of
Var _ (UnQual _ name :: Name S
name) -> [(FilePath, FilePath)] -> Parser [(FilePath, FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return [("",Name S -> FilePath
forall a. Named a => a -> FilePath
fromNamed Name S
name)]
Var _ (Qual _ (ModuleName _ mod :: FilePath
mod) name :: Name S
name) -> [(FilePath, FilePath)] -> Parser [(FilePath, FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath
mod, Name S -> FilePath
forall a. Named a => a -> FilePath
fromNamed Name S
name)]
Con _ (UnQual _ name :: Name S
name) -> [(FilePath, FilePath)] -> Parser [(FilePath, FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Name S -> FilePath
forall a. Named a => a -> FilePath
fromNamed Name S
name,""),("",Name S -> FilePath
forall a. Named a => a -> FilePath
fromNamed Name S
name)]
Con _ (Qual _ (ModuleName _ mod :: FilePath
mod) name :: Name S
name) -> [(FilePath, FilePath)] -> Parser [(FilePath, FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath
mod FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Name S -> FilePath
forall a. Named a => a -> FilePath
fromNamed Name S
name,""),(FilePath
mod,Name S -> FilePath
forall a. Named a => a -> FilePath
fromNamed Name S
name)]
_ -> Val -> FilePath -> Parser [(FilePath, FilePath)]
forall a. Val -> FilePath -> Parser a
parseFail Val
v "Bad classification rule"
parseSeverityKey :: Val -> Parser (Severity, Val)
parseSeverityKey :: Val -> Parser (Severity, Val)
parseSeverityKey v :: Val
v = do
(s :: FilePath
s, v :: Val
v) <- Val -> Parser (FilePath, Val)
parseObject1 Val
v
case FilePath -> Maybe Severity
getSeverity FilePath
s of
Just sev :: Severity
sev -> (Severity, Val) -> Parser (Severity, Val)
forall (m :: * -> *) a. Monad m => a -> m a
return (Severity
sev, Val
v)
_ -> Val -> FilePath -> Parser (Severity, Val)
forall a. Val -> FilePath -> Parser a
parseFail Val
v (FilePath -> Parser (Severity, Val))
-> FilePath -> Parser (Severity, Val)
forall a b. (a -> b) -> a -> b
$ "Key should be a severity (e.g. warn/error/suggest) but got " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
guessName :: Exp_ -> Exp_ -> String
guessName :: Exp S -> Exp S -> FilePath
guessName lhs :: Exp S
lhs rhs :: Exp S
rhs
| n :: FilePath
n:_ <- [FilePath]
rs [FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath]
ls = "Use " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
n
| n :: FilePath
n:_ <- [FilePath]
ls [FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath]
rs = "Redundant " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
n
| Bool
otherwise = FilePath
defaultHintName
where
(ls :: [FilePath]
ls, rs :: [FilePath]
rs) = (Exp S -> [FilePath]) -> (Exp S, Exp S) -> ([FilePath], [FilePath])
forall a b. (a -> b) -> (a, a) -> (b, b)
both Exp S -> [FilePath]
f (Exp S
lhs, Exp S
rhs)
f :: Exp S -> [FilePath]
f = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
isUnifyVar) ([FilePath] -> [FilePath])
-> (Exp S -> [FilePath]) -> Exp S -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name S -> FilePath) -> [Name S] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: Name S
x -> Name S -> FilePath
forall a. Named a => a -> FilePath
fromNamed (Name S
x :: Name S)) ([Name S] -> [FilePath])
-> (Exp S -> [Name S]) -> Exp S -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp S -> [Name S]
forall x (f :: * -> *). (Data x, Data (f S)) => x -> [f S]
childrenS
asNote :: String -> Note
asNote :: FilePath -> Note
asNote "IncreasesLaziness" = Note
IncreasesLaziness
asNote "DecreasesLaziness" = Note
DecreasesLaziness
asNote (FilePath -> (FilePath, FilePath)
word1 -> ("RemovesError",x :: FilePath
x)) = FilePath -> Note
RemovesError FilePath
x
asNote (FilePath -> (FilePath, FilePath)
word1 -> ("ValidInstance",x :: FilePath
x)) = (FilePath -> FilePath -> Note) -> (FilePath, FilePath) -> Note
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FilePath -> FilePath -> Note
ValidInstance ((FilePath, FilePath) -> Note) -> (FilePath, FilePath) -> Note
forall a b. (a -> b) -> a -> b
$ FilePath -> (FilePath, FilePath)
word1 FilePath
x
asNote (FilePath -> (FilePath, FilePath)
word1 -> ("RequiresExtension",x :: FilePath
x)) = FilePath -> Note
RequiresExtension FilePath
x
asNote x :: FilePath
x = FilePath -> Note
Note FilePath
x
settingsFromConfigYaml :: [ConfigYaml] -> [Setting]
settingsFromConfigYaml :: [ConfigYaml] -> [Setting]
settingsFromConfigYaml ([ConfigYaml] -> ConfigYaml
forall a. Monoid a => [a] -> a
mconcat -> ConfigYaml configs :: [ConfigItem]
configs) = [Setting]
settings [Setting] -> [Setting] -> [Setting]
forall a. [a] -> [a] -> [a]
++ (Group -> [Setting]) -> [Group] -> [Setting]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Group -> [Setting]
f [Group]
groups
where
packages :: [Package]
packages = [Package
x | ConfigPackage x :: Package
x <- [ConfigItem]
configs]
groups :: [Group]
groups = [Group
x | ConfigGroup x :: Group
x <- [ConfigItem]
configs]
settings :: [Setting]
settings = [[Setting]] -> [Setting]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Setting]
x | ConfigSetting x :: [Setting]
x <- [ConfigItem]
configs]
packageMap :: HashMap FilePath [ImportDecl S]
packageMap = ([ImportDecl S] -> [ImportDecl S] -> [ImportDecl S])
-> [(FilePath, [ImportDecl S])] -> HashMap FilePath [ImportDecl S]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
Map.fromListWith [ImportDecl S] -> [ImportDecl S] -> [ImportDecl S]
forall a. [a] -> [a] -> [a]
(++) [(FilePath
packageName, [ImportDecl S]
packageModules) | Package{..} <- [Package]
packages]
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)]
packageGhcModules) | Package{..} <- [Package]
packages]
groupMap :: HashMap FilePath Bool
groupMap = (Bool -> Bool -> Bool)
-> [(FilePath, Bool)] -> HashMap FilePath Bool
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
Map.fromListWith (\new :: Bool
new old :: Bool
old -> Bool
new) [(FilePath
groupName, Bool
groupEnabled) | Group{..} <- [Group]
groups]
f :: Group -> [Setting]
f Group{..}
| FilePath -> HashMap FilePath Bool -> Maybe Bool
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup FilePath
groupName HashMap FilePath Bool
groupMap Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False = []
| Bool
otherwise = (Either HintRule Classify -> Setting)
-> [Either HintRule Classify] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map ((HintRule -> Setting)
-> (Classify -> Setting) -> Either HintRule Classify -> Setting
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\r :: HintRule
r -> HintRule -> Setting
SettingMatchExp HintRule
r{hintRuleScope :: Scope
hintRuleScope=Scope
scope,hintRuleGhcScope :: HsExtendInstances Scope'
hintRuleGhcScope=HsExtendInstances Scope'
scope'}) Classify -> Setting
SettingClassify) [Either HintRule Classify]
groupRules
where
scope :: Scope
scope = HashMap FilePath [ImportDecl S]
-> [Either FilePath (ImportDecl S)] -> Scope
asScope HashMap FilePath [ImportDecl S]
packageMap [Either FilePath (ImportDecl S)]
groupImports
scope' :: HsExtendInstances Scope'
scope'= HashMap FilePath [LImportDecl GhcPs]
-> [Either FilePath (LImportDecl GhcPs)]
-> HsExtendInstances 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))]
groupGhcImports)
asScope :: Map.HashMap String [ImportDecl S] -> [Either String (ImportDecl S)] -> Scope
asScope :: HashMap FilePath [ImportDecl S]
-> [Either FilePath (ImportDecl S)] -> Scope
asScope packages :: HashMap FilePath [ImportDecl S]
packages xs :: [Either FilePath (ImportDecl S)]
xs = Module S -> Scope
scopeCreate (Module S -> Scope) -> Module S -> Scope
forall a b. (a -> b) -> a -> b
$ S
-> Maybe (ModuleHead S)
-> [ModulePragma S]
-> [ImportDecl S]
-> [Decl S]
-> Module S
forall l.
l
-> Maybe (ModuleHead l)
-> [ModulePragma l]
-> [ImportDecl l]
-> [Decl l]
-> Module l
Module S
an Maybe (ModuleHead S)
forall a. Maybe a
Nothing [] ((Either FilePath (ImportDecl S) -> [ImportDecl S])
-> [Either FilePath (ImportDecl S)] -> [ImportDecl S]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Either FilePath (ImportDecl S) -> [ImportDecl S]
f [Either FilePath (ImportDecl S)]
xs) []
where
f :: Either FilePath (ImportDecl S) -> [ImportDecl S]
f (Right x :: ImportDecl S
x) = [ImportDecl S
x]
f (Left x :: FilePath
x) | Just pkg :: [ImportDecl S]
pkg <- FilePath -> HashMap FilePath [ImportDecl S] -> Maybe [ImportDecl S]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup FilePath
x HashMap FilePath [ImportDecl S]
packages = [ImportDecl S]
pkg
| Bool
otherwise = FilePath -> [ImportDecl S]
forall a. HasCallStack => FilePath -> a
error (FilePath -> [ImportDecl S]) -> FilePath -> [ImportDecl S]
forall a b. (a -> b) -> a -> b
$ "asScope failed to do lookup, " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x
asScope' :: Map.HashMap String [HsSyn.LImportDecl HsSyn.GhcPs] -> [Either String (HsSyn.LImportDecl HsSyn.GhcPs)] -> HsExtendInstances Scope'
asScope' :: HashMap FilePath [LImportDecl GhcPs]
-> [Either FilePath (LImportDecl GhcPs)]
-> HsExtendInstances Scope'
asScope' packages :: HashMap FilePath [LImportDecl GhcPs]
packages xs :: [Either FilePath (LImportDecl GhcPs)]
xs = Scope' -> HsExtendInstances Scope'
forall a. a -> HsExtendInstances a
HsExtendInstances (Scope' -> HsExtendInstances Scope')
-> Scope' -> HsExtendInstances Scope'
forall a b. (a -> b) -> a -> b
$ HsModule GhcPs -> Scope'
scopeCreate' (Maybe (Located ModuleName)
-> Maybe (Located [LIE GhcPs])
-> [LImportDecl GhcPs]
-> [LHsDecl GhcPs]
-> Maybe (Located WarningTxt)
-> Maybe LHsDocString
-> HsModule GhcPs
forall pass.
Maybe (Located ModuleName)
-> Maybe (Located [LIE pass])
-> [LImportDecl pass]
-> [LHsDecl pass]
-> Maybe (Located WarningTxt)
-> Maybe LHsDocString
-> HsModule pass
HsSyn.HsModule 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 x :: LImportDecl GhcPs
x) = [LImportDecl GhcPs
x]
f (Left x :: FilePath
x) | Just pkg :: [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
$ "asScope' failed to do lookup, " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x