{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_HADDOCK prune, ignore-exports #-}
module Restyler.Config
( Config(..)
, ConfigError(..)
, configPullRequestReviewer
, loadConfig
, HasConfig(..)
, whenConfig
, whenConfigNonEmpty
, whenConfigJust
, ConfigSource(..)
, loadConfigFrom
, resolveRestylers
, defaultConfigContent
, configPaths
)
where
import Restyler.Prelude
import Control.Monad.Trans.Maybe (MaybeT(..))
import Data.Aeson
import Data.Aeson.Casing
import qualified Data.ByteString.Char8 as C8
import Data.FileEmbed (embedFile)
import Data.Functor.Barbie
import Data.List (isInfixOf)
import qualified Data.List.NonEmpty as NE
import Data.Monoid (Alt(..))
import qualified Data.Set as Set
import Data.Yaml (decodeThrow)
import qualified Data.Yaml as Yaml
import qualified Data.Yaml.Ext as Yaml
import GitHub.Data (IssueLabel, User)
import Restyler.App.Class
import Restyler.Config.ChangedPaths
import Restyler.Config.ExpectedKeys
import Restyler.Config.Glob
import Restyler.Config.RequestReview
import Restyler.Config.Restyler
import Restyler.Config.SketchyList
import Restyler.Config.Statuses
import Restyler.PullRequest
import Restyler.RemoteFile
import Restyler.Restyler
data ConfigF f = ConfigF
{ ConfigF f -> f Bool
cfEnabled :: f Bool
, ConfigF f -> f (SketchyList Glob)
cfExclude :: f (SketchyList Glob)
, ConfigF f -> f ChangedPathsConfig
cfChangedPaths :: f ChangedPathsConfig
, ConfigF f -> f Bool
cfAuto :: f Bool
, ConfigF f -> f (SketchyList RemoteFile)
cfRemoteFiles :: f (SketchyList RemoteFile)
, ConfigF f -> f Bool
cfPullRequests :: f Bool
, :: f Bool
, ConfigF f -> f Statuses
cfStatuses :: f Statuses
, ConfigF f -> f RequestReviewConfig
cfRequestReview :: f RequestReviewConfig
, ConfigF f -> f (SketchyList (Name IssueLabel))
cfLabels :: f (SketchyList (Name IssueLabel))
, ConfigF f -> f (SketchyList (Name IssueLabel))
cfIgnoreLabels :: f (SketchyList (Name IssueLabel))
, ConfigF f -> f String
cfRestylersVersion :: f String
, ConfigF f -> f (SketchyList RestylerOverride)
cfRestylers :: f (SketchyList RestylerOverride)
}
deriving stock (forall x. ConfigF f -> Rep (ConfigF f) x)
-> (forall x. Rep (ConfigF f) x -> ConfigF f)
-> Generic (ConfigF f)
forall x. Rep (ConfigF f) x -> ConfigF f
forall x. ConfigF f -> Rep (ConfigF f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (ConfigF f) x -> ConfigF f
forall (f :: * -> *) x. ConfigF f -> Rep (ConfigF f) x
$cto :: forall (f :: * -> *) x. Rep (ConfigF f) x -> ConfigF f
$cfrom :: forall (f :: * -> *) x. ConfigF f -> Rep (ConfigF f) x
Generic
deriving anyclass ((forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> ConfigF f -> ConfigF g)
-> FunctorB ConfigF
forall k (b :: (k -> *) -> *).
(forall (f :: k -> *) (g :: k -> *).
(forall (a :: k). f a -> g a) -> b f -> b g)
-> FunctorB b
forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> ConfigF f -> ConfigF g
bmap :: (forall a. f a -> g a) -> ConfigF f -> ConfigF g
$cbmap :: forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> ConfigF f -> ConfigF g
FunctorB, FunctorB ConfigF
FunctorB ConfigF =>
(forall (f :: * -> *). (forall a. f a) -> ConfigF f)
-> (forall (f :: * -> *) (g :: * -> *).
ConfigF f -> ConfigF g -> ConfigF (Product f g))
-> ApplicativeB ConfigF
forall k (b :: (k -> *) -> *).
FunctorB b =>
(forall (f :: k -> *). (forall (a :: k). f a) -> b f)
-> (forall (f :: k -> *) (g :: k -> *).
b f -> b g -> b (Product f g))
-> ApplicativeB b
forall (f :: * -> *). (forall a. f a) -> ConfigF f
forall (f :: * -> *) (g :: * -> *).
ConfigF f -> ConfigF g -> ConfigF (Product f g)
bprod :: ConfigF f -> ConfigF g -> ConfigF (Product f g)
$cbprod :: forall (f :: * -> *) (g :: * -> *).
ConfigF f -> ConfigF g -> ConfigF (Product f g)
bpure :: (forall a. f a) -> ConfigF f
$cbpure :: forall (f :: * -> *). (forall a. f a) -> ConfigF f
$cp1ApplicativeB :: FunctorB ConfigF
ApplicativeB, FunctorB ConfigF
FunctorB ConfigF =>
(forall (c :: * -> Constraint) (f :: * -> *).
AllB c ConfigF =>
ConfigF f -> ConfigF (Product (Dict c) f))
-> ConstraintsB ConfigF
forall k (b :: (k -> *) -> *).
FunctorB b =>
(forall (c :: k -> Constraint) (f :: k -> *).
AllB c b =>
b f -> b (Product (Dict c) f))
-> ConstraintsB b
forall (c :: * -> Constraint) (f :: * -> *).
AllB c ConfigF =>
ConfigF f -> ConfigF (Product (Dict c) f)
baddDicts :: ConfigF f -> ConfigF (Product (Dict c) f)
$cbaddDicts :: forall (c :: * -> Constraint) (f :: * -> *).
AllB c ConfigF =>
ConfigF f -> ConfigF (Product (Dict c) f)
$cp1ConstraintsB :: FunctorB ConfigF
ConstraintsB)
emptyConfig :: ConfigF Maybe
emptyConfig :: ConfigF Maybe
emptyConfig = (forall a. Alt Maybe a -> Maybe a)
-> ConfigF (Alt Maybe) -> ConfigF Maybe
forall k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FunctorB b =>
(forall (a :: k). f a -> g a) -> b f -> b g
bmap forall a. Alt Maybe a -> Maybe a
forall k (f :: k -> *) (a :: k). Alt f a -> f a
getAlt ConfigF (Alt Maybe)
forall k (f :: k -> *) (b :: (k -> *) -> *).
(AllBF Monoid f b, ConstraintsB b, ApplicativeB b) =>
b f
bmempty
instance FromJSON (ConfigF Maybe) where
parseJSON :: Value -> Parser (ConfigF Maybe)
parseJSON a :: Value
a@(Array _) = do
Maybe (SketchyList RestylerOverride)
restylers <- Value -> Parser (Maybe (SketchyList RestylerOverride))
forall a. FromJSON a => Value -> Parser a
parseJSON Value
a
ConfigF Maybe -> Parser (ConfigF Maybe)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigF Maybe
emptyConfig { cfRestylers :: Maybe (SketchyList RestylerOverride)
cfRestylers = Maybe (SketchyList RestylerOverride)
restylers }
parseJSON v :: Value
v = Options -> Value -> Parser (ConfigF Maybe)
forall a.
(Generic a, GFromJSON Zero (Rep a), Selectors (Rep a)) =>
Options -> Value -> Parser a
genericParseJSONValidated ((String -> String) -> Options
aesonPrefix String -> String
snakeCase) Value
v
instance FromJSON (ConfigF Identity) where
parseJSON :: Value -> Parser (ConfigF Identity)
parseJSON = Options -> Value -> Parser (ConfigF Identity)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser (ConfigF Identity))
-> Options -> Value -> Parser (ConfigF Identity)
forall a b. (a -> b) -> a -> b
$ (String -> String) -> Options
aesonPrefix String -> String
snakeCase
resolveConfig :: ConfigF Maybe -> ConfigF Identity -> ConfigF Identity
resolveConfig :: ConfigF Maybe -> ConfigF Identity -> ConfigF Identity
resolveConfig = (forall a. Maybe a -> Identity a -> Identity a)
-> ConfigF Maybe -> ConfigF Identity -> ConfigF Identity
forall k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *)
(h :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a -> g a -> h a) -> b f -> b g -> b h
bzipWith forall a. Maybe a -> Identity a -> Identity a
f
where
f :: Maybe a -> Identity a -> Identity a
f :: Maybe a -> Identity a -> Identity a
f ma :: Maybe a
ma ia :: Identity a
ia = Identity a -> (a -> Identity a) -> Maybe a -> Identity a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Identity a
ia a -> Identity a
forall a. a -> Identity a
Identity Maybe a
ma
data Config = Config
{ Config -> Bool
cEnabled :: Bool
, Config -> [Glob]
cExclude :: [Glob]
, Config -> ChangedPathsConfig
cChangedPaths :: ChangedPathsConfig
, Config -> Bool
cAuto :: Bool
, Config -> [RemoteFile]
cRemoteFiles :: [RemoteFile]
, Config -> Bool
cPullRequests :: Bool
, :: Bool
, Config -> Statuses
cStatuses :: Statuses
, Config -> RequestReviewConfig
cRequestReview :: RequestReviewConfig
, Config -> Set (Name IssueLabel)
cLabels :: Set (Name IssueLabel)
, Config -> Set (Name IssueLabel)
cIgnoreLabels :: Set (Name IssueLabel)
, Config -> [Restyler]
cRestylers :: [Restyler]
}
deriving (Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c== :: Config -> Config -> Bool
Eq, Int -> Config -> String -> String
[Config] -> String -> String
Config -> String
(Int -> Config -> String -> String)
-> (Config -> String)
-> ([Config] -> String -> String)
-> Show Config
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Config] -> String -> String
$cshowList :: [Config] -> String -> String
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> String -> String
$cshowsPrec :: Int -> Config -> String -> String
Show, (forall x. Config -> Rep Config x)
-> (forall x. Rep Config x -> Config) -> Generic Config
forall x. Rep Config x -> Config
forall x. Config -> Rep Config x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Config x -> Config
$cfrom :: forall x. Config -> Rep Config x
Generic)
configPullRequestReviewer :: PullRequest -> Config -> Maybe (Name User)
configPullRequestReviewer :: PullRequest -> Config -> Maybe (Name User)
configPullRequestReviewer pr :: PullRequest
pr = PullRequest -> RequestReviewConfig -> Maybe (Name User)
determineReviewer PullRequest
pr (RequestReviewConfig -> Maybe (Name User))
-> (Config -> RequestReviewConfig) -> Config -> Maybe (Name User)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> RequestReviewConfig
cRequestReview
instance ToJSON Config where
toJSON :: Config -> Value
toJSON = Options -> Config -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> Config -> Value) -> Options -> Config -> Value
forall a b. (a -> b) -> a -> b
$ (String -> String) -> Options
aesonPrefix String -> String
snakeCase
toEncoding :: Config -> Encoding
toEncoding = Options -> Config -> Encoding
forall a.
(Generic a, GToJSON Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Options -> Config -> Encoding) -> Options -> Config -> Encoding
forall a b. (a -> b) -> a -> b
$ (String -> String) -> Options
aesonPrefix String -> String
snakeCase
data ConfigError
= ConfigErrorInvalidYaml ByteString Yaml.ParseException
| ConfigErrorInvalidRestylers [String]
| ConfigErrorInvalidRestylersYaml SomeException
deriving Int -> ConfigError -> String -> String
[ConfigError] -> String -> String
ConfigError -> String
(Int -> ConfigError -> String -> String)
-> (ConfigError -> String)
-> ([ConfigError] -> String -> String)
-> Show ConfigError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ConfigError] -> String -> String
$cshowList :: [ConfigError] -> String -> String
show :: ConfigError -> String
$cshow :: ConfigError -> String
showsPrec :: Int -> ConfigError -> String -> String
$cshowsPrec :: Int -> ConfigError -> String -> String
Show
configErrorInvalidYaml :: ByteString -> Yaml.ParseException -> ConfigError
configErrorInvalidYaml :: ByteString -> ParseException -> ConfigError
configErrorInvalidYaml yaml :: ByteString
yaml = ByteString -> ParseException -> ConfigError
ConfigErrorInvalidYaml ByteString
yaml
(ParseException -> ConfigError)
-> (ParseException -> ParseException)
-> ParseException
-> ConfigError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> ParseException -> ParseException
Yaml.modifyYamlProblem String -> String
modify
where
modify :: String -> String
modify msg :: String
msg
| String -> Bool
isCannotStart String
msg Bool -> Bool -> Bool
&& ByteString -> Bool
hasTabIndent ByteString
yaml
= String
msg
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "\n\nThis may be caused by your source file containing tabs."
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "\nYAML forbids tabs for indentation. See https://yaml.org/faq.html."
| Bool
otherwise
= String
msg
isCannotStart :: String -> Bool
isCannotStart = ("character that cannot start any token" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`)
hasTabIndent :: ByteString -> Bool
hasTabIndent = ("\n\t" ByteString -> ByteString -> Bool
`C8.isInfixOf`)
instance Exception ConfigError
loadConfig
:: (HasLogFunc env, HasSystem env, HasDownloadFile env) => RIO env Config
loadConfig :: RIO env Config
loadConfig =
[ConfigSource]
-> (ConfigF Identity -> RIO env [Restyler]) -> RIO env Config
forall env.
HasSystem env =>
[ConfigSource]
-> (ConfigF Identity -> RIO env [Restyler]) -> RIO env Config
loadConfigFrom ((String -> ConfigSource) -> [String] -> [ConfigSource]
forall a b. (a -> b) -> [a] -> [b]
map String -> ConfigSource
ConfigPath [String]
configPaths)
((ConfigF Identity -> RIO env [Restyler]) -> RIO env Config)
-> (ConfigF Identity -> RIO env [Restyler]) -> RIO env Config
forall a b. (a -> b) -> a -> b
$ (SomeException -> ConfigError)
-> RIO env [Restyler] -> RIO env [Restyler]
forall (m :: * -> *) e1 e2 a.
(MonadUnliftIO m, Exception e1, Exception e2) =>
(e1 -> e2) -> m a -> m a
handleTo SomeException -> ConfigError
ConfigErrorInvalidRestylersYaml
(RIO env [Restyler] -> RIO env [Restyler])
-> (ConfigF Identity -> RIO env [Restyler])
-> ConfigF Identity
-> RIO env [Restyler]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RIO env [Restyler]
forall env.
(HasLogFunc env, HasSystem env, HasDownloadFile env) =>
String -> RIO env [Restyler]
getAllRestylersVersioned
(String -> RIO env [Restyler])
-> (ConfigF Identity -> String)
-> ConfigF Identity
-> RIO env [Restyler]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity String -> String
forall a. Identity a -> a
runIdentity
(Identity String -> String)
-> (ConfigF Identity -> Identity String)
-> ConfigF Identity
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigF Identity -> Identity String
forall (f :: * -> *). ConfigF f -> f String
cfRestylersVersion
loadConfigFrom
:: HasSystem env
=> [ConfigSource]
-> (ConfigF Identity -> RIO env [Restyler])
-> RIO env Config
loadConfigFrom :: [ConfigSource]
-> (ConfigF Identity -> RIO env [Restyler]) -> RIO env Config
loadConfigFrom sources :: [ConfigSource]
sources f :: ConfigF Identity -> RIO env [Restyler]
f = do
ConfigF Identity
config <- [ConfigSource] -> RIO env (ConfigF Identity)
forall env.
HasSystem env =>
[ConfigSource] -> RIO env (ConfigF Identity)
loadConfigF [ConfigSource]
sources
[Restyler]
restylers <- ConfigF Identity -> RIO env [Restyler]
f ConfigF Identity
config
ConfigF Identity -> [Restyler] -> RIO env Config
forall env. ConfigF Identity -> [Restyler] -> RIO env Config
resolveRestylers ConfigF Identity
config [Restyler]
restylers
data ConfigSource
= ConfigPath FilePath
| ConfigContent ByteString
readConfigSources
:: HasSystem env => [ConfigSource] -> RIO env (Maybe ByteString)
readConfigSources :: [ConfigSource] -> RIO env (Maybe ByteString)
readConfigSources = MaybeT (RIO env) ByteString -> RIO env (Maybe ByteString)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (RIO env) ByteString -> RIO env (Maybe ByteString))
-> ([ConfigSource] -> MaybeT (RIO env) ByteString)
-> [ConfigSource]
-> RIO env (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MaybeT (RIO env) ByteString] -> MaybeT (RIO env) ByteString
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([MaybeT (RIO env) ByteString] -> MaybeT (RIO env) ByteString)
-> ([ConfigSource] -> [MaybeT (RIO env) ByteString])
-> [ConfigSource]
-> MaybeT (RIO env) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConfigSource -> MaybeT (RIO env) ByteString)
-> [ConfigSource] -> [MaybeT (RIO env) ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RIO env (Maybe ByteString) -> MaybeT (RIO env) ByteString
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (RIO env (Maybe ByteString) -> MaybeT (RIO env) ByteString)
-> (ConfigSource -> RIO env (Maybe ByteString))
-> ConfigSource
-> MaybeT (RIO env) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigSource -> RIO env (Maybe ByteString)
go)
where
go :: ConfigSource -> RIO env (Maybe ByteString)
go = \case
ConfigPath path :: String
path -> do
Bool
exists <- String -> RIO env Bool
forall env. HasSystem env => String -> RIO env Bool
doesFileExist String
path
if Bool
exists then ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> RIO env ByteString -> RIO env (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> RIO env ByteString
forall env. HasSystem env => String -> RIO env ByteString
readFileBS String
path else Maybe ByteString -> RIO env (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing
ConfigContent content :: ByteString
content -> Maybe ByteString -> RIO env (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString -> RIO env (Maybe ByteString))
-> Maybe ByteString -> RIO env (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
content
loadConfigF :: HasSystem env => [ConfigSource] -> RIO env (ConfigF Identity)
loadConfigF :: [ConfigSource] -> RIO env (ConfigF Identity)
loadConfigF sources :: [ConfigSource]
sources =
ConfigF Maybe -> ConfigF Identity -> ConfigF Identity
resolveConfig
(ConfigF Maybe -> ConfigF Identity -> ConfigF Identity)
-> RIO env (ConfigF Maybe)
-> RIO env (ConfigF Identity -> ConfigF Identity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ConfigSource] -> RIO env (ConfigF Maybe)
forall env.
HasSystem env =>
[ConfigSource] -> RIO env (ConfigF Maybe)
loadUserConfigF [ConfigSource]
sources
RIO env (ConfigF Identity -> ConfigF Identity)
-> RIO env (ConfigF Identity) -> RIO env (ConfigF Identity)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> RIO env (ConfigF Identity)
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
ByteString -> m a
decodeThrow ByteString
defaultConfigContent
loadUserConfigF :: HasSystem env => [ConfigSource] -> RIO env (ConfigF Maybe)
loadUserConfigF :: [ConfigSource] -> RIO env (ConfigF Maybe)
loadUserConfigF = RIO env (ConfigF Maybe)
-> (ByteString -> RIO env (ConfigF Maybe))
-> RIO env (Maybe ByteString)
-> RIO env (ConfigF Maybe)
forall (m :: * -> *) b a.
Monad m =>
m b -> (a -> m b) -> m (Maybe a) -> m b
maybeM (ConfigF Maybe -> RIO env (ConfigF Maybe)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigF Maybe
emptyConfig) ByteString -> RIO env (ConfigF Maybe)
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m, FromJSON a) =>
ByteString -> m a
decodeThrow' (RIO env (Maybe ByteString) -> RIO env (ConfigF Maybe))
-> ([ConfigSource] -> RIO env (Maybe ByteString))
-> [ConfigSource]
-> RIO env (ConfigF Maybe)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ConfigSource] -> RIO env (Maybe ByteString)
forall env.
HasSystem env =>
[ConfigSource] -> RIO env (Maybe ByteString)
readConfigSources
decodeThrow' :: (MonadUnliftIO m, MonadThrow m, FromJSON a) => ByteString -> m a
decodeThrow' :: ByteString -> m a
decodeThrow' content :: ByteString
content =
(ParseException -> ConfigError) -> m a -> m a
forall (m :: * -> *) e1 e2 a.
(MonadUnliftIO m, Exception e1, Exception e2) =>
(e1 -> e2) -> m a -> m a
handleTo (ByteString -> ParseException -> ConfigError
configErrorInvalidYaml ByteString
content) (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ ByteString -> m a
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
ByteString -> m a
decodeThrow ByteString
content
resolveRestylers :: ConfigF Identity -> [Restyler] -> RIO env Config
resolveRestylers :: ConfigF Identity -> [Restyler] -> RIO env Config
resolveRestylers ConfigF {..} allRestylers :: [Restyler]
allRestylers = do
[Restyler]
restylers <-
([String] -> RIO env [Restyler])
-> ([Restyler] -> RIO env [Restyler])
-> Either [String] [Restyler]
-> RIO env [Restyler]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ConfigError -> RIO env [Restyler]
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (ConfigError -> RIO env [Restyler])
-> ([String] -> ConfigError) -> [String] -> RIO env [Restyler]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> ConfigError
ConfigErrorInvalidRestylers) [Restyler] -> RIO env [Restyler]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Either [String] [Restyler] -> RIO env [Restyler])
-> Either [String] [Restyler] -> RIO env [Restyler]
forall a b. (a -> b) -> a -> b
$ [Restyler] -> [RestylerOverride] -> Either [String] [Restyler]
overrideRestylers [Restyler]
allRestylers
([RestylerOverride] -> Either [String] [Restyler])
-> [RestylerOverride] -> Either [String] [Restyler]
forall a b. (a -> b) -> a -> b
$ SketchyList RestylerOverride -> [RestylerOverride]
forall a. SketchyList a -> [a]
unSketchy
(SketchyList RestylerOverride -> [RestylerOverride])
-> SketchyList RestylerOverride -> [RestylerOverride]
forall a b. (a -> b) -> a -> b
$ Identity (SketchyList RestylerOverride)
-> SketchyList RestylerOverride
forall a. Identity a -> a
runIdentity Identity (SketchyList RestylerOverride)
cfRestylers
Config -> RIO env Config
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config :: Bool
-> [Glob]
-> ChangedPathsConfig
-> Bool
-> [RemoteFile]
-> Bool
-> Bool
-> Statuses
-> RequestReviewConfig
-> Set (Name IssueLabel)
-> Set (Name IssueLabel)
-> [Restyler]
-> Config
Config
{ cEnabled :: Bool
cEnabled = Identity Bool -> Bool
forall a. Identity a -> a
runIdentity Identity Bool
cfEnabled
, cExclude :: [Glob]
cExclude = SketchyList Glob -> [Glob]
forall a. SketchyList a -> [a]
unSketchy (SketchyList Glob -> [Glob]) -> SketchyList Glob -> [Glob]
forall a b. (a -> b) -> a -> b
$ Identity (SketchyList Glob) -> SketchyList Glob
forall a. Identity a -> a
runIdentity Identity (SketchyList Glob)
cfExclude
, cChangedPaths :: ChangedPathsConfig
cChangedPaths = Identity ChangedPathsConfig -> ChangedPathsConfig
forall a. Identity a -> a
runIdentity Identity ChangedPathsConfig
cfChangedPaths
, cAuto :: Bool
cAuto = Identity Bool -> Bool
forall a. Identity a -> a
runIdentity Identity Bool
cfAuto
, cRemoteFiles :: [RemoteFile]
cRemoteFiles = SketchyList RemoteFile -> [RemoteFile]
forall a. SketchyList a -> [a]
unSketchy (SketchyList RemoteFile -> [RemoteFile])
-> SketchyList RemoteFile -> [RemoteFile]
forall a b. (a -> b) -> a -> b
$ Identity (SketchyList RemoteFile) -> SketchyList RemoteFile
forall a. Identity a -> a
runIdentity Identity (SketchyList RemoteFile)
cfRemoteFiles
, cPullRequests :: Bool
cPullRequests = Identity Bool -> Bool
forall a. Identity a -> a
runIdentity Identity Bool
cfPullRequests
, cComments :: Bool
cComments = Identity Bool -> Bool
forall a. Identity a -> a
runIdentity Identity Bool
cfComments
, cStatuses :: Statuses
cStatuses = Identity Statuses -> Statuses
forall a. Identity a -> a
runIdentity Identity Statuses
cfStatuses
, cRequestReview :: RequestReviewConfig
cRequestReview = Identity RequestReviewConfig -> RequestReviewConfig
forall a. Identity a -> a
runIdentity Identity RequestReviewConfig
cfRequestReview
, cLabels :: Set (Name IssueLabel)
cLabels = [Name IssueLabel] -> Set (Name IssueLabel)
forall a. Ord a => [a] -> Set a
Set.fromList ([Name IssueLabel] -> Set (Name IssueLabel))
-> [Name IssueLabel] -> Set (Name IssueLabel)
forall a b. (a -> b) -> a -> b
$ SketchyList (Name IssueLabel) -> [Name IssueLabel]
forall a. SketchyList a -> [a]
unSketchy (SketchyList (Name IssueLabel) -> [Name IssueLabel])
-> SketchyList (Name IssueLabel) -> [Name IssueLabel]
forall a b. (a -> b) -> a -> b
$ Identity (SketchyList (Name IssueLabel))
-> SketchyList (Name IssueLabel)
forall a. Identity a -> a
runIdentity Identity (SketchyList (Name IssueLabel))
cfLabels
, cIgnoreLabels :: Set (Name IssueLabel)
cIgnoreLabels = [Name IssueLabel] -> Set (Name IssueLabel)
forall a. Ord a => [a] -> Set a
Set.fromList ([Name IssueLabel] -> Set (Name IssueLabel))
-> [Name IssueLabel] -> Set (Name IssueLabel)
forall a b. (a -> b) -> a -> b
$ SketchyList (Name IssueLabel) -> [Name IssueLabel]
forall a. SketchyList a -> [a]
unSketchy (SketchyList (Name IssueLabel) -> [Name IssueLabel])
-> SketchyList (Name IssueLabel) -> [Name IssueLabel]
forall a b. (a -> b) -> a -> b
$ Identity (SketchyList (Name IssueLabel))
-> SketchyList (Name IssueLabel)
forall a. Identity a -> a
runIdentity Identity (SketchyList (Name IssueLabel))
cfIgnoreLabels
, cRestylers :: [Restyler]
cRestylers = [Restyler]
restylers
}
class HasConfig env where
configL :: Lens' env Config
whenConfig :: HasConfig env => (Config -> Bool) -> RIO env () -> RIO env ()
whenConfig :: (Config -> Bool) -> RIO env () -> RIO env ()
whenConfig check :: Config -> Bool
check act :: RIO env ()
act =
(Config -> Maybe ()) -> (() -> RIO env ()) -> RIO env ()
forall env a.
HasConfig env =>
(Config -> Maybe a) -> (a -> RIO env ()) -> RIO env ()
whenConfigJust (Maybe () -> Maybe () -> Bool -> Maybe ()
forall a. a -> a -> Bool -> a
bool Maybe ()
forall a. Maybe a
Nothing (() -> Maybe ()
forall a. a -> Maybe a
Just ()) (Bool -> Maybe ()) -> (Config -> Bool) -> Config -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Bool
check) (RIO env () -> () -> RIO env ()
forall a b. a -> b -> a
const RIO env ()
act)
whenConfigNonEmpty
:: HasConfig env => (Config -> [a]) -> ([a] -> RIO env ()) -> RIO env ()
whenConfigNonEmpty :: (Config -> [a]) -> ([a] -> RIO env ()) -> RIO env ()
whenConfigNonEmpty check :: Config -> [a]
check act :: [a] -> RIO env ()
act =
(Config -> Maybe (NonEmpty a))
-> (NonEmpty a -> RIO env ()) -> RIO env ()
forall env a.
HasConfig env =>
(Config -> Maybe a) -> (a -> RIO env ()) -> RIO env ()
whenConfigJust ([a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([a] -> Maybe (NonEmpty a))
-> (Config -> [a]) -> Config -> Maybe (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> [a]
check) ([a] -> RIO env ()
act ([a] -> RIO env ())
-> (NonEmpty a -> [a]) -> NonEmpty a -> RIO env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NE.toList)
whenConfigJust
:: HasConfig env => (Config -> Maybe a) -> (a -> RIO env ()) -> RIO env ()
whenConfigJust :: (Config -> Maybe a) -> (a -> RIO env ()) -> RIO env ()
whenConfigJust check :: Config -> Maybe a
check act :: a -> RIO env ()
act = (a -> RIO env ()) -> Maybe a -> RIO env ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ a -> RIO env ()
act (Maybe a -> RIO env ())
-> (Config -> Maybe a) -> Config -> RIO env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Maybe a
check (Config -> RIO env ()) -> RIO env Config -> RIO env ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Getting Config env Config -> RIO env Config
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Config env Config
forall env. HasConfig env => Lens' env Config
configL
defaultConfigContent :: ByteString
defaultConfigContent :: ByteString
defaultConfigContent = $(embedFile "config/default.yaml")
configPaths :: [FilePath]
configPaths :: [String]
configPaths =
[ ".restyled.yaml"
, ".restyled.yml"
, ".github/restyled.yaml"
, ".github/restyled.yml"
]