{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_HADDOCK prune, ignore-exports #-}

-- | Handling of @.restyled.yaml@ content and behavior driven there-by
--
-- __Implementation note__: This is a playground. I'm doing lots of HKD stuff
-- here that I would not normally subject my collaborators to.
--
-- 1. We only do this stuff here, and
-- 2. It should stay encapsulated away from the rest of the system
--
-- References:
--
-- - <https://reasonablypolymorphic.com/blog/higher-kinded-data/>
-- - <https://chrispenner.ca/posts/hkd-options>
-- - <https://hackage.haskell.org/package/barbies>
--
module Restyler.Config
    ( Config(..)
    , ConfigError(..)
    , configPullRequestReviewer
    , loadConfig
    , HasConfig(..)
    , whenConfig
    , whenConfigNonEmpty
    , whenConfigJust

    -- * Exported for use in tests
    , 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

-- | A polymorphic representation of @'Config'@
--
-- 1. The @f@ parameter can dictate if attributes are required (@'Identity'@) or
--    optional (@'Maybe'@), or optional with override semantics (@'Last'@)
--
-- 2. Any list keys use @'SketchyList'@ so users can type a single scalar
--    element or a list of many elements.
--
-- 3. The @Restylers@ attribute is a (sketchy) list of @'ConfigRestyler'@, which
--    is a function to apply to the later-fetched list of all Restylers.
--
-- See the various @resolve@ functions for how to get a real @'Config'@ out of
-- this beast.
--
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
    , ConfigF f -> f Bool
cfComments :: 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)

-- | An empty @'ConfigF'@ of all @'Nothing'@s
--
-- N.B. the choice of @'getAlt'@ is somewhat arbitrary. We just need a @Maybe@
-- wrapper @f a@ where @getX mempty@ is @Nothing@, but without a @Monoid a@
-- constraint.
--
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

-- | Fill out one @'ConfigF'@ from another
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

-- | Fully resolved configuration
--
-- This is what we work with throughout the system.
--
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
    , Config -> Bool
cComments :: 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]
    -- ^ TODO: @'NonEmpty'@
    --
    -- It's true, but what's the benefit?
    --
    }
    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)

-- | If so configured, return the @'User'@ from whom to request review
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

-- | Load a fully-inflated @'Config'@
--
-- Read any @.restyled.yaml@, fill it out from defaults, grab the versioned set
-- of restylers data, and apply the configured choices and overrides.
--
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

-- | Load configuration if present and apply defaults
--
-- Returns @'ConfigF' 'Identity'@ because defaulting has populated all fields.
--
-- May throw any @'ConfigError'@. May through raw @'Yaml.ParseException'@s if
-- there is a programmer error in our static default configuration YAML.
--
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'@, but wrapping YAML parse errors to @'ConfigError'@
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

-- | Populate @'cRestylers'@ using the versioned restylers data
--
-- May throw @'ConfigErrorInvalidRestylers'@.
--
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"
    ]