{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

module ImportStylePlugin.Config where

import Control.Applicative ((<|>))
import Data.Aeson (FromJSON (..), FromJSONKey, Value (..), withObject, (.:))
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import Data.String (IsString)
import GHC.Generics (Generic)

-- | Report either error or warning during compilation
data Severity = Error | Warning
  deriving ((forall x. Severity -> Rep Severity x)
-> (forall x. Rep Severity x -> Severity) -> Generic Severity
forall x. Rep Severity x -> Severity
forall x. Severity -> Rep Severity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Severity -> Rep Severity x
from :: forall x. Severity -> Rep Severity x
$cto :: forall x. Rep Severity x -> Severity
to :: forall x. Rep Severity x -> Severity
Generic, Maybe Severity
Value -> Parser [Severity]
Value -> Parser Severity
(Value -> Parser Severity)
-> (Value -> Parser [Severity])
-> Maybe Severity
-> FromJSON Severity
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Severity
parseJSON :: Value -> Parser Severity
$cparseJSONList :: Value -> Parser [Severity]
parseJSONList :: Value -> Parser [Severity]
$comittedField :: Maybe Severity
omittedField :: Maybe Severity
FromJSON, Int -> Severity -> ShowS
[Severity] -> ShowS
Severity -> String
(Int -> Severity -> ShowS)
-> (Severity -> String) -> ([Severity] -> ShowS) -> Show Severity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Severity -> ShowS
showsPrec :: Int -> Severity -> ShowS
$cshow :: Severity -> String
show :: Severity -> String
$cshowList :: [Severity] -> ShowS
showList :: [Severity] -> ShowS
Show)

data Qualification = Required | Forbidden
  deriving ((forall x. Qualification -> Rep Qualification x)
-> (forall x. Rep Qualification x -> Qualification)
-> Generic Qualification
forall x. Rep Qualification x -> Qualification
forall x. Qualification -> Rep Qualification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Qualification -> Rep Qualification x
from :: forall x. Qualification -> Rep Qualification x
$cto :: forall x. Rep Qualification x -> Qualification
to :: forall x. Rep Qualification x -> Qualification
Generic, Maybe Qualification
Value -> Parser [Qualification]
Value -> Parser Qualification
(Value -> Parser Qualification)
-> (Value -> Parser [Qualification])
-> Maybe Qualification
-> FromJSON Qualification
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Qualification
parseJSON :: Value -> Parser Qualification
$cparseJSONList :: Value -> Parser [Qualification]
parseJSONList :: Value -> Parser [Qualification]
$comittedField :: Maybe Qualification
omittedField :: Maybe Qualification
FromJSON, Int -> Qualification -> ShowS
[Qualification] -> ShowS
Qualification -> String
(Int -> Qualification -> ShowS)
-> (Qualification -> String)
-> ([Qualification] -> ShowS)
-> Show Qualification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Qualification -> ShowS
showsPrec :: Int -> Qualification -> ShowS
$cshow :: Qualification -> String
show :: Qualification -> String
$cshowList :: [Qualification] -> ShowS
showList :: [Qualification] -> ShowS
Show)

data ModuleAliases = Exactly (Set String) | OrOmitted (Set String)
  deriving (Int -> ModuleAliases -> ShowS
[ModuleAliases] -> ShowS
ModuleAliases -> String
(Int -> ModuleAliases -> ShowS)
-> (ModuleAliases -> String)
-> ([ModuleAliases] -> ShowS)
-> Show ModuleAliases
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModuleAliases -> ShowS
showsPrec :: Int -> ModuleAliases -> ShowS
$cshow :: ModuleAliases -> String
show :: ModuleAliases -> String
$cshowList :: [ModuleAliases] -> ShowS
showList :: [ModuleAliases] -> ShowS
Show)

data NamesList = BlackList (Set String) | WhiteList (Set String)
  deriving (Int -> NamesList -> ShowS
[NamesList] -> ShowS
NamesList -> String
(Int -> NamesList -> ShowS)
-> (NamesList -> String)
-> ([NamesList] -> ShowS)
-> Show NamesList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NamesList -> ShowS
showsPrec :: Int -> NamesList -> ShowS
$cshow :: NamesList -> String
show :: NamesList -> String
$cshowList :: [NamesList] -> ShowS
showList :: [NamesList] -> ShowS
Show)

data ImportRule = ImportRule
  { ImportRule -> Maybe Qualification
qualification :: Maybe Qualification
  -- ^ @'Nothing'@ means "don\'t care"
  , ImportRule -> Maybe ModuleAliases
aliases :: Maybe ModuleAliases
  -- ^ @'Nothing'@ means "don\'t care"
  , ImportRule -> Maybe NamesList
importedNames :: Maybe NamesList
  -- ^ @'Nothing'@ means "don\'t care"
  }
  deriving ((forall x. ImportRule -> Rep ImportRule x)
-> (forall x. Rep ImportRule x -> ImportRule) -> Generic ImportRule
forall x. Rep ImportRule x -> ImportRule
forall x. ImportRule -> Rep ImportRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ImportRule -> Rep ImportRule x
from :: forall x. ImportRule -> Rep ImportRule x
$cto :: forall x. Rep ImportRule x -> ImportRule
to :: forall x. Rep ImportRule x -> ImportRule
Generic, Maybe ImportRule
Value -> Parser [ImportRule]
Value -> Parser ImportRule
(Value -> Parser ImportRule)
-> (Value -> Parser [ImportRule])
-> Maybe ImportRule
-> FromJSON ImportRule
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ImportRule
parseJSON :: Value -> Parser ImportRule
$cparseJSONList :: Value -> Parser [ImportRule]
parseJSONList :: Value -> Parser [ImportRule]
$comittedField :: Maybe ImportRule
omittedField :: Maybe ImportRule
FromJSON, Int -> ImportRule -> ShowS
[ImportRule] -> ShowS
ImportRule -> String
(Int -> ImportRule -> ShowS)
-> (ImportRule -> String)
-> ([ImportRule] -> ShowS)
-> Show ImportRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImportRule -> ShowS
showsPrec :: Int -> ImportRule -> ShowS
$cshow :: ImportRule -> String
show :: ImportRule -> String
$cshowList :: [ImportRule] -> ShowS
showList :: [ImportRule] -> ShowS
Show)

data QualificationStyle = Post | Pre
  deriving ((forall x. QualificationStyle -> Rep QualificationStyle x)
-> (forall x. Rep QualificationStyle x -> QualificationStyle)
-> Generic QualificationStyle
forall x. Rep QualificationStyle x -> QualificationStyle
forall x. QualificationStyle -> Rep QualificationStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. QualificationStyle -> Rep QualificationStyle x
from :: forall x. QualificationStyle -> Rep QualificationStyle x
$cto :: forall x. Rep QualificationStyle x -> QualificationStyle
to :: forall x. Rep QualificationStyle x -> QualificationStyle
Generic, Maybe QualificationStyle
Value -> Parser [QualificationStyle]
Value -> Parser QualificationStyle
(Value -> Parser QualificationStyle)
-> (Value -> Parser [QualificationStyle])
-> Maybe QualificationStyle
-> FromJSON QualificationStyle
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser QualificationStyle
parseJSON :: Value -> Parser QualificationStyle
$cparseJSONList :: Value -> Parser [QualificationStyle]
parseJSONList :: Value -> Parser [QualificationStyle]
$comittedField :: Maybe QualificationStyle
omittedField :: Maybe QualificationStyle
FromJSON, Int -> QualificationStyle -> ShowS
[QualificationStyle] -> ShowS
QualificationStyle -> String
(Int -> QualificationStyle -> ShowS)
-> (QualificationStyle -> String)
-> ([QualificationStyle] -> ShowS)
-> Show QualificationStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QualificationStyle -> ShowS
showsPrec :: Int -> QualificationStyle -> ShowS
$cshow :: QualificationStyle -> String
show :: QualificationStyle -> String
$cshowList :: [QualificationStyle] -> ShowS
showList :: [QualificationStyle] -> ShowS
Show)

data ImportRules = ImportRules
  { ImportRules -> [ImportRule]
rules :: [ImportRule]
  , ImportRules -> Severity
severity :: Severity
  }
  deriving ((forall x. ImportRules -> Rep ImportRules x)
-> (forall x. Rep ImportRules x -> ImportRules)
-> Generic ImportRules
forall x. Rep ImportRules x -> ImportRules
forall x. ImportRules -> Rep ImportRules x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ImportRules -> Rep ImportRules x
from :: forall x. ImportRules -> Rep ImportRules x
$cto :: forall x. Rep ImportRules x -> ImportRules
to :: forall x. Rep ImportRules x -> ImportRules
Generic, Maybe ImportRules
Value -> Parser [ImportRules]
Value -> Parser ImportRules
(Value -> Parser ImportRules)
-> (Value -> Parser [ImportRules])
-> Maybe ImportRules
-> FromJSON ImportRules
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ImportRules
parseJSON :: Value -> Parser ImportRules
$cparseJSONList :: Value -> Parser [ImportRules]
parseJSONList :: Value -> Parser [ImportRules]
$comittedField :: Maybe ImportRules
omittedField :: Maybe ImportRules
FromJSON, Int -> ImportRules -> ShowS
[ImportRules] -> ShowS
ImportRules -> String
(Int -> ImportRules -> ShowS)
-> (ImportRules -> String)
-> ([ImportRules] -> ShowS)
-> Show ImportRules
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImportRules -> ShowS
showsPrec :: Int -> ImportRules -> ShowS
$cshow :: ImportRules -> String
show :: ImportRules -> String
$cshowList :: [ImportRules] -> ShowS
showList :: [ImportRules] -> ShowS
Show)

data Ban = Ban
  { Ban -> Severity
severity :: Severity
  , Ban -> String
why :: String
  -- ^ ban reason
  }
  deriving ((forall x. Ban -> Rep Ban x)
-> (forall x. Rep Ban x -> Ban) -> Generic Ban
forall x. Rep Ban x -> Ban
forall x. Ban -> Rep Ban x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Ban -> Rep Ban x
from :: forall x. Ban -> Rep Ban x
$cto :: forall x. Rep Ban x -> Ban
to :: forall x. Rep Ban x -> Ban
Generic, Maybe Ban
Value -> Parser [Ban]
Value -> Parser Ban
(Value -> Parser Ban)
-> (Value -> Parser [Ban]) -> Maybe Ban -> FromJSON Ban
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Ban
parseJSON :: Value -> Parser Ban
$cparseJSONList :: Value -> Parser [Ban]
parseJSONList :: Value -> Parser [Ban]
$comittedField :: Maybe Ban
omittedField :: Maybe Ban
FromJSON, Int -> Ban -> ShowS
[Ban] -> ShowS
Ban -> String
(Int -> Ban -> ShowS)
-> (Ban -> String) -> ([Ban] -> ShowS) -> Show Ban
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ban -> ShowS
showsPrec :: Int -> Ban -> ShowS
$cshow :: Ban -> String
show :: Ban -> String
$cshowList :: [Ban] -> ShowS
showList :: [Ban] -> ShowS
Show)

data ImportsStyle
  = ImportsStyle
  { ImportsStyle -> Maybe QualificationStyle
qualificationStyle :: Maybe QualificationStyle
  -- ^ @'Nothing'@ means "don\'t care"
  , ImportsStyle -> Map ModuleName Ban
bannedModules :: Map.Map ModuleName Ban
  , ImportsStyle -> Map ModuleName ImportRules
importRules :: Map.Map ModuleName ImportRules
  }
  deriving ((forall x. ImportsStyle -> Rep ImportsStyle x)
-> (forall x. Rep ImportsStyle x -> ImportsStyle)
-> Generic ImportsStyle
forall x. Rep ImportsStyle x -> ImportsStyle
forall x. ImportsStyle -> Rep ImportsStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ImportsStyle -> Rep ImportsStyle x
from :: forall x. ImportsStyle -> Rep ImportsStyle x
$cto :: forall x. Rep ImportsStyle x -> ImportsStyle
to :: forall x. Rep ImportsStyle x -> ImportsStyle
Generic, Maybe ImportsStyle
Value -> Parser [ImportsStyle]
Value -> Parser ImportsStyle
(Value -> Parser ImportsStyle)
-> (Value -> Parser [ImportsStyle])
-> Maybe ImportsStyle
-> FromJSON ImportsStyle
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ImportsStyle
parseJSON :: Value -> Parser ImportsStyle
$cparseJSONList :: Value -> Parser [ImportsStyle]
parseJSONList :: Value -> Parser [ImportsStyle]
$comittedField :: Maybe ImportsStyle
omittedField :: Maybe ImportsStyle
FromJSON, Int -> ImportsStyle -> ShowS
[ImportsStyle] -> ShowS
ImportsStyle -> String
(Int -> ImportsStyle -> ShowS)
-> (ImportsStyle -> String)
-> ([ImportsStyle] -> ShowS)
-> Show ImportsStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImportsStyle -> ShowS
showsPrec :: Int -> ImportsStyle -> ShowS
$cshow :: ImportsStyle -> String
show :: ImportsStyle -> String
$cshowList :: [ImportsStyle] -> ShowS
showList :: [ImportsStyle] -> ShowS
Show)

newtype ModuleName = ModuleName String
  deriving (ModuleName -> ModuleName -> Bool
(ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> Bool) -> Eq ModuleName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModuleName -> ModuleName -> Bool
== :: ModuleName -> ModuleName -> Bool
$c/= :: ModuleName -> ModuleName -> Bool
/= :: ModuleName -> ModuleName -> Bool
Eq, Eq ModuleName
Eq ModuleName =>
(ModuleName -> ModuleName -> Ordering)
-> (ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> ModuleName)
-> (ModuleName -> ModuleName -> ModuleName)
-> Ord ModuleName
ModuleName -> ModuleName -> Bool
ModuleName -> ModuleName -> Ordering
ModuleName -> ModuleName -> ModuleName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ModuleName -> ModuleName -> Ordering
compare :: ModuleName -> ModuleName -> Ordering
$c< :: ModuleName -> ModuleName -> Bool
< :: ModuleName -> ModuleName -> Bool
$c<= :: ModuleName -> ModuleName -> Bool
<= :: ModuleName -> ModuleName -> Bool
$c> :: ModuleName -> ModuleName -> Bool
> :: ModuleName -> ModuleName -> Bool
$c>= :: ModuleName -> ModuleName -> Bool
>= :: ModuleName -> ModuleName -> Bool
$cmax :: ModuleName -> ModuleName -> ModuleName
max :: ModuleName -> ModuleName -> ModuleName
$cmin :: ModuleName -> ModuleName -> ModuleName
min :: ModuleName -> ModuleName -> ModuleName
Ord)
  deriving newtype (FromJSONKeyFunction [ModuleName]
FromJSONKeyFunction ModuleName
FromJSONKeyFunction ModuleName
-> FromJSONKeyFunction [ModuleName] -> FromJSONKey ModuleName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction ModuleName
fromJSONKey :: FromJSONKeyFunction ModuleName
$cfromJSONKeyList :: FromJSONKeyFunction [ModuleName]
fromJSONKeyList :: FromJSONKeyFunction [ModuleName]
FromJSONKey, String -> ModuleName
(String -> ModuleName) -> IsString ModuleName
forall a. (String -> a) -> IsString a
$cfromString :: String -> ModuleName
fromString :: String -> ModuleName
IsString, Int -> ModuleName -> ShowS
[ModuleName] -> ShowS
ModuleName -> String
(Int -> ModuleName -> ShowS)
-> (ModuleName -> String)
-> ([ModuleName] -> ShowS)
-> Show ModuleName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModuleName -> ShowS
showsPrec :: Int -> ModuleName -> ShowS
$cshow :: ModuleName -> String
show :: ModuleName -> String
$cshowList :: [ModuleName] -> ShowS
showList :: [ModuleName] -> ShowS
Show)

instance FromJSON NamesList where
  parseJSON :: Value -> Parser NamesList
parseJSON = String -> (Object -> Parser NamesList) -> Value -> Parser NamesList
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NamesList" \Object
o ->
    Set String -> NamesList
BlackList (Set String -> NamesList)
-> Parser (Set String) -> Parser NamesList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Set String)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"blacklist" Parser NamesList -> Parser NamesList -> Parser NamesList
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Set String -> NamesList
WhiteList (Set String -> NamesList)
-> Parser (Set String) -> Parser NamesList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Set String)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"whitelist"

instance FromJSON ModuleAliases where
  parseJSON :: Value -> Parser ModuleAliases
parseJSON (Object Object
o) = Set String -> ModuleAliases
Exactly (Set String -> ModuleAliases)
-> Parser (Set String) -> Parser ModuleAliases
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Set String)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"exactly"
  parseJSON Value
o = Set String -> ModuleAliases
OrOmitted (Set String -> ModuleAliases)
-> Parser (Set String) -> Parser ModuleAliases
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Set String)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
o