module Restyler.App
    ( App(..)
    , StartupApp(..)
    , bootstrapApp
    ) where

import Restyler.Prelude

import Conduit (runResourceT, sinkFile)
import GitHub.Auth
import GitHub.Request
import GitHub.Request.Display
import Network.HTTP.Client.TLS
import Network.HTTP.Simple hiding (Request)
import Restyler.App.Class
import Restyler.App.Error
import Restyler.Config
import Restyler.Git
import Restyler.Logger
import Restyler.Options
import Restyler.PullRequest
import Restyler.RestyledPullRequest
import Restyler.Setup
import qualified RIO.Directory as Directory
import qualified System.Exit as Exit
import qualified System.Process as Process

-- | Environment used for @'RIO'@ actions to load the real @'App'@
data StartupApp = StartupApp
    { StartupApp -> LogFunc
appLogFunc :: LogFunc
    -- ^ Log function built based on @--debug@ and @--color@
    , StartupApp -> Options
appOptions :: Options
    -- ^ Options passed on the command-line
    , StartupApp -> FilePath
appWorkingDirectory :: FilePath
    -- ^ Temporary working directory we've created
    }

instance HasLogFunc StartupApp where
    logFuncL :: (LogFunc -> f LogFunc) -> StartupApp -> f StartupApp
logFuncL = (StartupApp -> LogFunc)
-> (StartupApp -> LogFunc -> StartupApp)
-> Lens' StartupApp LogFunc
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens StartupApp -> LogFunc
appLogFunc ((StartupApp -> LogFunc -> StartupApp)
 -> (LogFunc -> f LogFunc) -> StartupApp -> f StartupApp)
-> (StartupApp -> LogFunc -> StartupApp)
-> (LogFunc -> f LogFunc)
-> StartupApp
-> f StartupApp
forall a b. (a -> b) -> a -> b
$ \x :: StartupApp
x y :: LogFunc
y -> StartupApp
x { appLogFunc :: LogFunc
appLogFunc = LogFunc
y }

instance HasOptions StartupApp where
    optionsL :: (Options -> f Options) -> StartupApp -> f StartupApp
optionsL = (StartupApp -> Options)
-> (StartupApp -> Options -> StartupApp)
-> Lens' StartupApp Options
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens StartupApp -> Options
appOptions ((StartupApp -> Options -> StartupApp)
 -> (Options -> f Options) -> StartupApp -> f StartupApp)
-> (StartupApp -> Options -> StartupApp)
-> (Options -> f Options)
-> StartupApp
-> f StartupApp
forall a b. (a -> b) -> a -> b
$ \x :: StartupApp
x y :: Options
y -> StartupApp
x { appOptions :: Options
appOptions = Options
y }

instance HasWorkingDirectory StartupApp where
    workingDirectoryL :: (FilePath -> f FilePath) -> StartupApp -> f StartupApp
workingDirectoryL =
        (StartupApp -> FilePath)
-> (StartupApp -> FilePath -> StartupApp)
-> Lens' StartupApp FilePath
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens StartupApp -> FilePath
appWorkingDirectory ((StartupApp -> FilePath -> StartupApp)
 -> (FilePath -> f FilePath) -> StartupApp -> f StartupApp)
-> (StartupApp -> FilePath -> StartupApp)
-> (FilePath -> f FilePath)
-> StartupApp
-> f StartupApp
forall a b. (a -> b) -> a -> b
$ \x :: StartupApp
x y :: FilePath
y -> StartupApp
x { appWorkingDirectory :: FilePath
appWorkingDirectory = FilePath
y }

instance HasSystem StartupApp where
    getCurrentDirectory :: RIO StartupApp FilePath
getCurrentDirectory = do
        Utf8Builder -> RIO StartupApp ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug "getCurrentDirectory"
        (IOException -> AppError) -> IO FilePath -> RIO StartupApp FilePath
forall (m :: * -> *) a.
MonadUnliftIO m =>
(IOException -> AppError) -> IO a -> m a
appIO IOException -> AppError
SystemError IO FilePath
forall (m :: * -> *). MonadIO m => m FilePath
Directory.getCurrentDirectory

    setCurrentDirectory :: FilePath -> RIO StartupApp ()
setCurrentDirectory path :: FilePath
path = do
        Utf8Builder -> RIO StartupApp ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO StartupApp ())
-> Utf8Builder -> RIO StartupApp ()
forall a b. (a -> b) -> a -> b
$ "setCurrentDirectory: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow FilePath
path
        (IOException -> AppError) -> IO () -> RIO StartupApp ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(IOException -> AppError) -> IO a -> m a
appIO IOException -> AppError
SystemError (IO () -> RIO StartupApp ()) -> IO () -> RIO StartupApp ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
Directory.setCurrentDirectory FilePath
path

    doesFileExist :: FilePath -> RIO StartupApp Bool
doesFileExist path :: FilePath
path = do
        Utf8Builder -> RIO StartupApp ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO StartupApp ())
-> Utf8Builder -> RIO StartupApp ()
forall a b. (a -> b) -> a -> b
$ "doesFileExist: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow FilePath
path
        (IOException -> AppError) -> IO Bool -> RIO StartupApp Bool
forall (m :: * -> *) a.
MonadUnliftIO m =>
(IOException -> AppError) -> IO a -> m a
appIO IOException -> AppError
SystemError (IO Bool -> RIO StartupApp Bool) -> IO Bool -> RIO StartupApp Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
forall (m :: * -> *). MonadIO m => FilePath -> m Bool
Directory.doesFileExist FilePath
path

    doesDirectoryExist :: FilePath -> RIO StartupApp Bool
doesDirectoryExist path :: FilePath
path = do
        Utf8Builder -> RIO StartupApp ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO StartupApp ())
-> Utf8Builder -> RIO StartupApp ()
forall a b. (a -> b) -> a -> b
$ "doesDirectoryExist: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow FilePath
path
        (IOException -> AppError) -> IO Bool -> RIO StartupApp Bool
forall (m :: * -> *) a.
MonadUnliftIO m =>
(IOException -> AppError) -> IO a -> m a
appIO IOException -> AppError
SystemError (IO Bool -> RIO StartupApp Bool) -> IO Bool -> RIO StartupApp Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
forall (m :: * -> *). MonadIO m => FilePath -> m Bool
Directory.doesDirectoryExist FilePath
path

    isFileExecutable :: FilePath -> RIO StartupApp Bool
isFileExecutable path :: FilePath
path = do
        Utf8Builder -> RIO StartupApp ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO StartupApp ())
-> Utf8Builder -> RIO StartupApp ()
forall a b. (a -> b) -> a -> b
$ "isFileExecutable: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow FilePath
path
        (IOException -> AppError) -> IO Bool -> RIO StartupApp Bool
forall (m :: * -> *) a.
MonadUnliftIO m =>
(IOException -> AppError) -> IO a -> m a
appIO IOException -> AppError
SystemError
            (IO Bool -> RIO StartupApp Bool) -> IO Bool -> RIO StartupApp Bool
forall a b. (a -> b) -> a -> b
$ Permissions -> Bool
Directory.executable
            (Permissions -> Bool) -> IO Permissions -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Permissions
forall (m :: * -> *). MonadIO m => FilePath -> m Permissions
Directory.getPermissions FilePath
path

    listDirectory :: FilePath -> RIO StartupApp [FilePath]
listDirectory path :: FilePath
path = do
        Utf8Builder -> RIO StartupApp ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO StartupApp ())
-> Utf8Builder -> RIO StartupApp ()
forall a b. (a -> b) -> a -> b
$ "listDirectory: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow FilePath
path
        (IOException -> AppError)
-> IO [FilePath] -> RIO StartupApp [FilePath]
forall (m :: * -> *) a.
MonadUnliftIO m =>
(IOException -> AppError) -> IO a -> m a
appIO IOException -> AppError
SystemError (IO [FilePath] -> RIO StartupApp [FilePath])
-> IO [FilePath] -> RIO StartupApp [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
forall (m :: * -> *). MonadIO m => FilePath -> m [FilePath]
Directory.listDirectory FilePath
path

    readFile :: FilePath -> RIO StartupApp Text
readFile path :: FilePath
path = do
        Utf8Builder -> RIO StartupApp ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO StartupApp ())
-> Utf8Builder -> RIO StartupApp ()
forall a b. (a -> b) -> a -> b
$ "readFile: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow FilePath
path
        (IOException -> AppError) -> IO Text -> RIO StartupApp Text
forall (m :: * -> *) a.
MonadUnliftIO m =>
(IOException -> AppError) -> IO a -> m a
appIO IOException -> AppError
SystemError (IO Text -> RIO StartupApp Text) -> IO Text -> RIO StartupApp Text
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Text
forall (m :: * -> *). MonadIO m => FilePath -> m Text
readFileUtf8 FilePath
path

    readFileBS :: FilePath -> RIO StartupApp ByteString
readFileBS path :: FilePath
path = do
        Utf8Builder -> RIO StartupApp ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO StartupApp ())
-> Utf8Builder -> RIO StartupApp ()
forall a b. (a -> b) -> a -> b
$ "readFileBS: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow FilePath
path
        (IOException -> AppError)
-> IO ByteString -> RIO StartupApp ByteString
forall (m :: * -> *) a.
MonadUnliftIO m =>
(IOException -> AppError) -> IO a -> m a
appIO IOException -> AppError
SystemError (IO ByteString -> RIO StartupApp ByteString)
-> IO ByteString -> RIO StartupApp ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
forall (m :: * -> *). MonadIO m => FilePath -> m ByteString
readFileBinary FilePath
path

    writeFile :: FilePath -> Text -> RIO StartupApp ()
writeFile path :: FilePath
path content :: Text
content = do
        Utf8Builder -> RIO StartupApp ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO StartupApp ())
-> Utf8Builder -> RIO StartupApp ()
forall a b. (a -> b) -> a -> b
$ "writeFile: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow FilePath
path
        (IOException -> AppError) -> IO () -> RIO StartupApp ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(IOException -> AppError) -> IO a -> m a
appIO IOException -> AppError
SystemError (IO () -> RIO StartupApp ()) -> IO () -> RIO StartupApp ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> Text -> m ()
writeFileUtf8 FilePath
path Text
content

-- brittany-disable-next-binding

instance HasProcess StartupApp where
    callProcess :: FilePath -> [FilePath] -> RIO StartupApp ()
callProcess cmd :: FilePath
cmd args :: [FilePath]
args = do
        -- N.B. this includes access tokens in log messages when used for
        -- git-clone. That's acceptable because:
        --
        -- - These tokens are ephemeral (5 minutes)
        -- - We generally accept secrets in DEBUG messages
        --
        Utf8Builder -> RIO StartupApp ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO StartupApp ())
-> Utf8Builder -> RIO StartupApp ()
forall a b. (a -> b) -> a -> b
$ "call: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Utf8Builder
forall a. IsString a => FilePath -> a
fromString FilePath
cmd Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> " " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow [FilePath]
args
        (IOException -> AppError) -> IO () -> RIO StartupApp ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(IOException -> AppError) -> IO a -> m a
appIO IOException -> AppError
SystemError (IO () -> RIO StartupApp ()) -> IO () -> RIO StartupApp ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> IO ()
Process.callProcess FilePath
cmd [FilePath]
args

    callProcessExitCode :: FilePath -> [FilePath] -> RIO StartupApp ExitCode
callProcessExitCode cmd :: FilePath
cmd args :: [FilePath]
args = do
        Utf8Builder -> RIO StartupApp ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO StartupApp ())
-> Utf8Builder -> RIO StartupApp ()
forall a b. (a -> b) -> a -> b
$ "call: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Utf8Builder
forall a. IsString a => FilePath -> a
fromString FilePath
cmd Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> " " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow [FilePath]
args
        ExitCode
ec <- (IOException -> AppError) -> IO ExitCode -> RIO StartupApp ExitCode
forall (m :: * -> *) a.
MonadUnliftIO m =>
(IOException -> AppError) -> IO a -> m a
appIO IOException -> AppError
SystemError
            (IO ExitCode -> RIO StartupApp ExitCode)
-> IO ExitCode -> RIO StartupApp ExitCode
forall a b. (a -> b) -> a -> b
$ CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ExitCode)
-> IO ExitCode
forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
Process.withCreateProcess CreateProcess
proc
            ((Maybe Handle
  -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ExitCode)
 -> IO ExitCode)
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ExitCode)
-> IO ExitCode
forall a b. (a -> b) -> a -> b
$ \_ _ _ p :: ProcessHandle
p -> ProcessHandle -> IO ExitCode
Process.waitForProcess ProcessHandle
p
        ExitCode
ec ExitCode -> RIO StartupApp () -> RIO StartupApp ExitCode
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Utf8Builder -> RIO StartupApp ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug ("exit code: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> ExitCode -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow ExitCode
ec)
      where
        proc :: CreateProcess
proc = (FilePath -> [FilePath] -> CreateProcess
Process.proc FilePath
cmd [FilePath]
args) { delegate_ctlc :: Bool
Process.delegate_ctlc = Bool
True }

    readProcess :: FilePath -> [FilePath] -> FilePath -> RIO StartupApp FilePath
readProcess cmd :: FilePath
cmd args :: [FilePath]
args stdin' :: FilePath
stdin' = do
        Utf8Builder -> RIO StartupApp ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO StartupApp ())
-> Utf8Builder -> RIO StartupApp ()
forall a b. (a -> b) -> a -> b
$ "read: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Utf8Builder
forall a. IsString a => FilePath -> a
fromString FilePath
cmd Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> " " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow [FilePath]
args
        FilePath
output <- (IOException -> AppError) -> IO FilePath -> RIO StartupApp FilePath
forall (m :: * -> *) a.
MonadUnliftIO m =>
(IOException -> AppError) -> IO a -> m a
appIO IOException -> AppError
SystemError (IO FilePath -> RIO StartupApp FilePath)
-> IO FilePath -> RIO StartupApp FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath -> IO FilePath
Process.readProcess FilePath
cmd [FilePath]
args FilePath
stdin'
        FilePath
output FilePath -> RIO StartupApp () -> RIO StartupApp FilePath
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Utf8Builder -> RIO StartupApp ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug ("output: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Utf8Builder
forall a. IsString a => FilePath -> a
fromString FilePath
output)

instance HasExit StartupApp where
    exitSuccess :: RIO StartupApp a
exitSuccess = do
        Utf8Builder -> RIO StartupApp ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug "exitSuccess"
        (IOException -> AppError) -> IO a -> RIO StartupApp a
forall (m :: * -> *) a.
MonadUnliftIO m =>
(IOException -> AppError) -> IO a -> m a
appIO IOException -> AppError
SystemError IO a
forall a. IO a
Exit.exitSuccess

instance HasDownloadFile StartupApp where
    downloadFile :: Text -> FilePath -> RIO StartupApp ()
downloadFile url :: Text
url path :: FilePath
path = do
        Utf8Builder -> RIO StartupApp ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO StartupApp ())
-> Utf8Builder -> RIO StartupApp ()
forall a b. (a -> b) -> a -> b
$ "HTTP GET: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
url Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> " => " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow FilePath
path
        (IOException -> AppError) -> IO () -> RIO StartupApp ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(IOException -> AppError) -> IO a -> m a
appIO IOException -> AppError
HttpError (IO () -> RIO StartupApp ()) -> IO () -> RIO StartupApp ()
forall a b. (a -> b) -> a -> b
$ do
            Request
request <- FilePath -> IO Request
forall (m :: * -> *). MonadThrow m => FilePath -> m Request
parseRequestThrow (FilePath -> IO Request) -> FilePath -> IO Request
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
unpack Text
url
            ResourceT IO () -> IO ()
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO () -> IO ()) -> ResourceT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Request
-> (Response () -> ConduitM ByteString Void (ResourceT IO) ())
-> ResourceT IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
Request -> (Response () -> ConduitM ByteString Void m a) -> m a
httpSink Request
request ((Response () -> ConduitM ByteString Void (ResourceT IO) ())
 -> ResourceT IO ())
-> (Response () -> ConduitM ByteString Void (ResourceT IO) ())
-> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ \_ -> FilePath -> ConduitM ByteString Void (ResourceT IO) ()
forall (m :: * -> *) o.
MonadResource m =>
FilePath -> ConduitT ByteString o m ()
sinkFile FilePath
path

instance HasGitHub StartupApp where
    runGitHub :: GenRequest m k a -> RIO StartupApp a
runGitHub req :: GenRequest m k a
req = do
        Utf8Builder -> RIO StartupApp ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO StartupApp ())
-> Utf8Builder -> RIO StartupApp ()
forall a b. (a -> b) -> a -> b
$ "GitHub request: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> DisplayGitHubRequest -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (GenRequest m k a -> DisplayGitHubRequest
forall (m :: MediaType *) (k :: RW) a.
GenRequest m k a -> DisplayGitHubRequest
displayGitHubRequest GenRequest m k a
req)
        Auth
auth <- ByteString -> Auth
OAuth (ByteString -> Auth) -> (Options -> ByteString) -> Options -> Auth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> ByteString) -> (Options -> Text) -> Options -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Text
oAccessToken (Options -> Auth) -> RIO StartupApp Options -> RIO StartupApp Auth
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting Options StartupApp Options -> RIO StartupApp Options
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Options StartupApp Options
forall env. HasOptions env => Lens' env Options
optionsL
        Either Error a
result <- IO (Either Error a) -> RIO StartupApp (Either Error a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either Error a) -> RIO StartupApp (Either Error a))
-> IO (Either Error a) -> RIO StartupApp (Either Error a)
forall a b. (a -> b) -> a -> b
$ do
            Manager
mgr <- IO Manager
getGlobalManager
            Manager -> Auth -> GenRequest m k a -> IO (Either Error a)
forall am (mt :: MediaType *) a (rw :: RW).
(AuthMethod am, ParseResponse mt a) =>
Manager -> am -> GenRequest mt rw a -> IO (Either Error a)
executeRequestWithMgr Manager
mgr Auth
auth GenRequest m k a
req
        (Error -> RIO StartupApp a)
-> (a -> RIO StartupApp a) -> Either Error a -> RIO StartupApp a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (AppError -> RIO StartupApp a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (AppError -> RIO StartupApp a)
-> (Error -> AppError) -> Error -> RIO StartupApp a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisplayGitHubRequest -> Error -> AppError
GitHubError (GenRequest m k a -> DisplayGitHubRequest
forall (m :: MediaType *) (k :: RW) a.
GenRequest m k a -> DisplayGitHubRequest
displayGitHubRequest GenRequest m k a
req)) a -> RIO StartupApp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either Error a
result

appIO :: MonadUnliftIO m => (IOException -> AppError) -> IO a -> m a
appIO :: (IOException -> AppError) -> IO a -> m a
appIO f :: IOException -> AppError
f = (IOException -> AppError) -> m a -> m a
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
(e -> AppError) -> m a -> m a
mapAppError IOException -> AppError
f (m a -> m a) -> (IO a -> m a) -> IO a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-- | Fully booted application environment
data App = App
    { App -> StartupApp
appApp :: StartupApp
    , App -> Config
appConfig :: Config
    -- ^ Configuration loaded from @.restyled.yaml@
    , App -> PullRequest
appPullRequest :: PullRequest
    -- ^ Original Pull Request being restyled
    , App -> Maybe RestyledPullRequest
appRestyledPullRequest :: Maybe RestyledPullRequest
    -- ^ Possible pre-existing Restyle Pull Request
    }

instance HasLogFunc App where
    logFuncL :: (LogFunc -> f LogFunc) -> App -> f App
logFuncL = (StartupApp -> f StartupApp) -> App -> f App
Lens' App StartupApp
appL ((StartupApp -> f StartupApp) -> App -> f App)
-> ((LogFunc -> f LogFunc) -> StartupApp -> f StartupApp)
-> (LogFunc -> f LogFunc)
-> App
-> f App
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogFunc -> f LogFunc) -> StartupApp -> f StartupApp
forall env. HasLogFunc env => Lens' env LogFunc
logFuncL

instance HasOptions App where
    optionsL :: (Options -> f Options) -> App -> f App
optionsL = (StartupApp -> f StartupApp) -> App -> f App
Lens' App StartupApp
appL ((StartupApp -> f StartupApp) -> App -> f App)
-> ((Options -> f Options) -> StartupApp -> f StartupApp)
-> (Options -> f Options)
-> App
-> f App
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Options -> f Options) -> StartupApp -> f StartupApp
forall env. HasOptions env => Lens' env Options
optionsL

instance HasWorkingDirectory App where
    workingDirectoryL :: (FilePath -> f FilePath) -> App -> f App
workingDirectoryL = (StartupApp -> f StartupApp) -> App -> f App
Lens' App StartupApp
appL ((StartupApp -> f StartupApp) -> App -> f App)
-> ((FilePath -> f FilePath) -> StartupApp -> f StartupApp)
-> (FilePath -> f FilePath)
-> App
-> f App
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> f FilePath) -> StartupApp -> f StartupApp
forall env. HasWorkingDirectory env => Lens' env FilePath
workingDirectoryL

instance HasConfig App where
    configL :: (Config -> f Config) -> App -> f App
configL = (App -> Config) -> (App -> Config -> App) -> Lens' App Config
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens App -> Config
appConfig ((App -> Config -> App) -> (Config -> f Config) -> App -> f App)
-> (App -> Config -> App) -> (Config -> f Config) -> App -> f App
forall a b. (a -> b) -> a -> b
$ \x :: App
x y :: Config
y -> App
x { appConfig :: Config
appConfig = Config
y }

instance HasPullRequest App where
    pullRequestL :: (PullRequest -> f PullRequest) -> App -> f App
pullRequestL = (App -> PullRequest)
-> (App -> PullRequest -> App) -> Lens' App PullRequest
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens App -> PullRequest
appPullRequest ((App -> PullRequest -> App)
 -> (PullRequest -> f PullRequest) -> App -> f App)
-> (App -> PullRequest -> App)
-> (PullRequest -> f PullRequest)
-> App
-> f App
forall a b. (a -> b) -> a -> b
$ \x :: App
x y :: PullRequest
y -> App
x { appPullRequest :: PullRequest
appPullRequest = PullRequest
y }

instance HasRestyledPullRequest App where
    restyledPullRequestL :: (Maybe RestyledPullRequest -> f (Maybe RestyledPullRequest))
-> App -> f App
restyledPullRequestL =
        (App -> Maybe RestyledPullRequest)
-> (App -> Maybe RestyledPullRequest -> App)
-> Lens' App (Maybe RestyledPullRequest)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens App -> Maybe RestyledPullRequest
appRestyledPullRequest ((App -> Maybe RestyledPullRequest -> App)
 -> (Maybe RestyledPullRequest -> f (Maybe RestyledPullRequest))
 -> App
 -> f App)
-> (App -> Maybe RestyledPullRequest -> App)
-> (Maybe RestyledPullRequest -> f (Maybe RestyledPullRequest))
-> App
-> f App
forall a b. (a -> b) -> a -> b
$ \x :: App
x y :: Maybe RestyledPullRequest
y -> App
x { appRestyledPullRequest :: Maybe RestyledPullRequest
appRestyledPullRequest = Maybe RestyledPullRequest
y }

instance HasSystem App where
    getCurrentDirectory :: RIO App FilePath
getCurrentDirectory = RIO StartupApp FilePath -> RIO App FilePath
forall a. RIO StartupApp a -> RIO App a
runApp RIO StartupApp FilePath
forall env. HasSystem env => RIO env FilePath
getCurrentDirectory
    setCurrentDirectory :: FilePath -> RIO App ()
setCurrentDirectory = RIO StartupApp () -> RIO App ()
forall a. RIO StartupApp a -> RIO App a
runApp (RIO StartupApp () -> RIO App ())
-> (FilePath -> RIO StartupApp ()) -> FilePath -> RIO App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> RIO StartupApp ()
forall env. HasSystem env => FilePath -> RIO env ()
setCurrentDirectory
    doesFileExist :: FilePath -> RIO App Bool
doesFileExist = RIO StartupApp Bool -> RIO App Bool
forall a. RIO StartupApp a -> RIO App a
runApp (RIO StartupApp Bool -> RIO App Bool)
-> (FilePath -> RIO StartupApp Bool) -> FilePath -> RIO App Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> RIO StartupApp Bool
forall env. HasSystem env => FilePath -> RIO env Bool
doesFileExist
    doesDirectoryExist :: FilePath -> RIO App Bool
doesDirectoryExist = RIO StartupApp Bool -> RIO App Bool
forall a. RIO StartupApp a -> RIO App a
runApp (RIO StartupApp Bool -> RIO App Bool)
-> (FilePath -> RIO StartupApp Bool) -> FilePath -> RIO App Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> RIO StartupApp Bool
forall env. HasSystem env => FilePath -> RIO env Bool
doesDirectoryExist
    isFileExecutable :: FilePath -> RIO App Bool
isFileExecutable = RIO StartupApp Bool -> RIO App Bool
forall a. RIO StartupApp a -> RIO App a
runApp (RIO StartupApp Bool -> RIO App Bool)
-> (FilePath -> RIO StartupApp Bool) -> FilePath -> RIO App Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> RIO StartupApp Bool
forall env. HasSystem env => FilePath -> RIO env Bool
isFileExecutable
    listDirectory :: FilePath -> RIO App [FilePath]
listDirectory = RIO StartupApp [FilePath] -> RIO App [FilePath]
forall a. RIO StartupApp a -> RIO App a
runApp (RIO StartupApp [FilePath] -> RIO App [FilePath])
-> (FilePath -> RIO StartupApp [FilePath])
-> FilePath
-> RIO App [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> RIO StartupApp [FilePath]
forall env. HasSystem env => FilePath -> RIO env [FilePath]
listDirectory
    readFile :: FilePath -> RIO App Text
readFile = RIO StartupApp Text -> RIO App Text
forall a. RIO StartupApp a -> RIO App a
runApp (RIO StartupApp Text -> RIO App Text)
-> (FilePath -> RIO StartupApp Text) -> FilePath -> RIO App Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> RIO StartupApp Text
forall env. HasSystem env => FilePath -> RIO env Text
readFile
    readFileBS :: FilePath -> RIO App ByteString
readFileBS = RIO StartupApp ByteString -> RIO App ByteString
forall a. RIO StartupApp a -> RIO App a
runApp (RIO StartupApp ByteString -> RIO App ByteString)
-> (FilePath -> RIO StartupApp ByteString)
-> FilePath
-> RIO App ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> RIO StartupApp ByteString
forall env. HasSystem env => FilePath -> RIO env ByteString
readFileBS
    writeFile :: FilePath -> Text -> RIO App ()
writeFile x :: FilePath
x = RIO StartupApp () -> RIO App ()
forall a. RIO StartupApp a -> RIO App a
runApp (RIO StartupApp () -> RIO App ())
-> (Text -> RIO StartupApp ()) -> Text -> RIO App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text -> RIO StartupApp ()
forall env. HasSystem env => FilePath -> Text -> RIO env ()
writeFile FilePath
x

instance HasExit App where
    exitSuccess :: RIO App a
exitSuccess = RIO StartupApp a -> RIO App a
forall a. RIO StartupApp a -> RIO App a
runApp RIO StartupApp a
forall env a. HasExit env => RIO env a
exitSuccess

instance HasProcess App where
    callProcess :: FilePath -> [FilePath] -> RIO App ()
callProcess cmd :: FilePath
cmd = RIO StartupApp () -> RIO App ()
forall a. RIO StartupApp a -> RIO App a
runApp (RIO StartupApp () -> RIO App ())
-> ([FilePath] -> RIO StartupApp ()) -> [FilePath] -> RIO App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> RIO StartupApp ()
forall env. HasProcess env => FilePath -> [FilePath] -> RIO env ()
callProcess FilePath
cmd
    callProcessExitCode :: FilePath -> [FilePath] -> RIO App ExitCode
callProcessExitCode cmd :: FilePath
cmd = RIO StartupApp ExitCode -> RIO App ExitCode
forall a. RIO StartupApp a -> RIO App a
runApp (RIO StartupApp ExitCode -> RIO App ExitCode)
-> ([FilePath] -> RIO StartupApp ExitCode)
-> [FilePath]
-> RIO App ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> RIO StartupApp ExitCode
forall env.
HasProcess env =>
FilePath -> [FilePath] -> RIO env ExitCode
callProcessExitCode FilePath
cmd
    readProcess :: FilePath -> [FilePath] -> FilePath -> RIO App FilePath
readProcess cmd :: FilePath
cmd args :: [FilePath]
args = RIO StartupApp FilePath -> RIO App FilePath
forall a. RIO StartupApp a -> RIO App a
runApp (RIO StartupApp FilePath -> RIO App FilePath)
-> (FilePath -> RIO StartupApp FilePath)
-> FilePath
-> RIO App FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> FilePath -> RIO StartupApp FilePath
forall env.
HasProcess env =>
FilePath -> [FilePath] -> FilePath -> RIO env FilePath
readProcess FilePath
cmd [FilePath]
args

instance HasGit App where
    gitPush :: FilePath -> RIO App ()
gitPush branch :: FilePath
branch = FilePath -> [FilePath] -> RIO App ()
forall env. HasProcess env => FilePath -> [FilePath] -> RIO env ()
callProcess "git" ["push", "origin", FilePath
branch]
    gitPushForce :: FilePath -> RIO App ()
gitPushForce branch :: FilePath
branch =
        FilePath -> [FilePath] -> RIO App ()
forall env. HasProcess env => FilePath -> [FilePath] -> RIO env ()
callProcess "git" ["push", "--force-with-lease", "origin", FilePath
branch]
    gitMergeBase :: FilePath -> RIO App (Maybe FilePath)
gitMergeBase branch :: FilePath
branch = do
        FilePath
output <- FilePath -> [FilePath] -> FilePath -> RIO App FilePath
forall env.
HasProcess env =>
FilePath -> [FilePath] -> FilePath -> RIO env FilePath
readProcess "git" ["merge-base", FilePath
branch, "HEAD"] ""
        Maybe FilePath -> RIO App (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> RIO App (Maybe FilePath))
-> Maybe FilePath -> RIO App (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
listToMaybe ([FilePath] -> Maybe FilePath) -> [FilePath] -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
lines FilePath
output
    gitDiffNameOnly :: Maybe FilePath -> RIO App [FilePath]
gitDiffNameOnly mRef :: Maybe FilePath
mRef = do
        let args :: [FilePath]
args = ["diff", "--name-only"] [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> Maybe FilePath -> [FilePath]
forall a. Maybe a -> [a]
maybeToList Maybe FilePath
mRef
        FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> RIO App FilePath -> RIO App [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [FilePath] -> FilePath -> RIO App FilePath
forall env.
HasProcess env =>
FilePath -> [FilePath] -> FilePath -> RIO env FilePath
readProcess "git" [FilePath]
args ""
    gitCommitAll :: FilePath -> RIO App FilePath
gitCommitAll msg :: FilePath
msg = do
        FilePath -> [FilePath] -> RIO App ()
forall env. HasProcess env => FilePath -> [FilePath] -> RIO env ()
callProcess "git" ["commit", "-a", "--message", FilePath
msg]
        (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace (FilePath -> FilePath) -> RIO App FilePath -> RIO App FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [FilePath] -> FilePath -> RIO App FilePath
forall env.
HasProcess env =>
FilePath -> [FilePath] -> FilePath -> RIO env FilePath
readProcess "git" ["rev-parse", "HEAD"] ""
    gitMerge :: FilePath -> RIO App ()
gitMerge branch :: FilePath
branch = FilePath -> [FilePath] -> RIO App ()
forall env. HasProcess env => FilePath -> [FilePath] -> RIO env ()
callProcess "git" ["merge", "--ff-only", FilePath
branch]

instance HasDownloadFile App where
    downloadFile :: Text -> FilePath -> RIO App ()
downloadFile url :: Text
url = RIO StartupApp () -> RIO App ()
forall a. RIO StartupApp a -> RIO App a
runApp (RIO StartupApp () -> RIO App ())
-> (FilePath -> RIO StartupApp ()) -> FilePath -> RIO App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath -> RIO StartupApp ()
forall env. HasDownloadFile env => Text -> FilePath -> RIO env ()
downloadFile Text
url

instance HasGitHub App where
    runGitHub :: GenRequest m k a -> RIO App a
runGitHub = RIO StartupApp a -> RIO App a
forall a. RIO StartupApp a -> RIO App a
runApp (RIO StartupApp a -> RIO App a)
-> (GenRequest m k a -> RIO StartupApp a)
-> GenRequest m k a
-> RIO App a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenRequest m k a -> RIO StartupApp a
forall env (m :: MediaType *) a (k :: RW).
(HasGitHub env, ParseResponse m a) =>
GenRequest m k a -> RIO env a
runGitHub

appL :: Lens' App StartupApp
appL :: (StartupApp -> f StartupApp) -> App -> f App
appL = (App -> StartupApp)
-> (App -> StartupApp -> App) -> Lens' App StartupApp
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens App -> StartupApp
appApp ((App -> StartupApp -> App)
 -> (StartupApp -> f StartupApp) -> App -> f App)
-> (App -> StartupApp -> App)
-> (StartupApp -> f StartupApp)
-> App
-> f App
forall a b. (a -> b) -> a -> b
$ \x :: App
x y :: StartupApp
y -> App
x { appApp :: StartupApp
appApp = StartupApp
y }

runApp :: RIO StartupApp a -> RIO App a
runApp :: RIO StartupApp a -> RIO App a
runApp = (App -> StartupApp) -> RIO StartupApp a -> RIO App a
forall env' env a. (env' -> env) -> RIO env a -> RIO env' a
withRIO App -> StartupApp
appApp

bootstrapApp :: MonadIO m => Options -> FilePath -> m App
bootstrapApp :: Options -> FilePath -> m App
bootstrapApp options :: Options
options path :: FilePath
path = StartupApp -> RIO StartupApp App -> m App
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO StartupApp
app (RIO StartupApp App -> m App) -> RIO StartupApp App -> m App
forall a b. (a -> b) -> a -> b
$ (PullRequest, Maybe RestyledPullRequest, Config) -> App
toApp ((PullRequest, Maybe RestyledPullRequest, Config) -> App)
-> RIO StartupApp (PullRequest, Maybe RestyledPullRequest, Config)
-> RIO StartupApp App
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RIO StartupApp (PullRequest, Maybe RestyledPullRequest, Config)
forall env.
(HasCallStack, HasLogFunc env, HasOptions env,
 HasWorkingDirectory env, HasSystem env, HasExit env,
 HasProcess env, HasDownloadFile env, HasGitHub env) =>
RIO env (PullRequest, Maybe RestyledPullRequest, Config)
restylerSetup
  where
    app :: StartupApp
app = StartupApp :: LogFunc -> Options -> FilePath -> StartupApp
StartupApp
        { appLogFunc :: LogFunc
appLogFunc = Options -> LogFunc
restylerLogFunc Options
options
        , appOptions :: Options
appOptions = Options
options
        , appWorkingDirectory :: FilePath
appWorkingDirectory = FilePath
path
        }

    toApp :: (PullRequest, Maybe RestyledPullRequest, Config) -> App
toApp (pullRequest :: PullRequest
pullRequest, mRestyledPullRequest :: Maybe RestyledPullRequest
mRestyledPullRequest, config :: Config
config) = App :: StartupApp
-> Config -> PullRequest -> Maybe RestyledPullRequest -> App
App
        { appApp :: StartupApp
appApp = StartupApp
app
        , appPullRequest :: PullRequest
appPullRequest = PullRequest
pullRequest
        , appRestyledPullRequest :: Maybe RestyledPullRequest
appRestyledPullRequest = Maybe RestyledPullRequest
mRestyledPullRequest
        , appConfig :: Config
appConfig = Config
config
        }