{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module NixpkgsReview
  ( cacheDir,
    runReport,
  )
where

import Data.Maybe (fromJust)
import Data.Text as T
import qualified File as F
import Language.Haskell.TH.Env (envQ)
import OurPrelude
import Polysemy.Output (Output, output)
import qualified Process as P
import System.Environment.XDG.BaseDir (getUserCacheDir)
import System.Exit (ExitCode (..))
import qualified Utils
import Prelude hiding (log)

binPath :: String
binPath :: String
binPath = Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust ($$(envQ "NIXPKGSREVIEW") :: Maybe String) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/bin"

cacheDir :: IO FilePath
cacheDir :: IO String
cacheDir = String -> IO String
getUserCacheDir String
"nixpkgs-review"

revDir :: FilePath -> Text -> FilePath
revDir :: String -> Text -> String
revDir String
cache Text
commit = String
cache String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/rev-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
commit

run ::
  Members '[F.File, P.Process, Output Text] r =>
  FilePath ->
  Text ->
  Sem r Text
run :: String -> Text -> Sem r Text
run String
cache Text
commit = let timeout :: Text
timeout = Text
"45m" :: Text in do
  -- TODO: probably just skip running nixpkgs-review if the directory
  -- already exists
  Sem r (ExitCode, Text) -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r (ExitCode, Text) -> Sem r ())
-> Sem r (ExitCode, Text) -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    ProcessConfig () () () -> Sem r (ExitCode, Text)
forall (r :: [(* -> *) -> * -> *]) stdin stdoutIgnored
       stderrIgnored.
Members '[Process] r =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> Sem r (ExitCode, Text)
ourReadProcessInterleavedSem (ProcessConfig () () () -> Sem r (ExitCode, Text))
-> ProcessConfig () () () -> Sem r (ExitCode, Text)
forall a b. (a -> b) -> a -> b
$
      String -> [String] -> ProcessConfig () () ()
proc String
"rm" [String
"-rf", String -> Text -> String
revDir String
cache Text
commit]
  (ExitCode
exitCode, Text
_nixpkgsReviewOutput) <-
    ProcessConfig () () () -> Sem r (ExitCode, Text)
forall (r :: [(* -> *) -> * -> *]) stdin stdoutIgnored
       stderrIgnored.
Members '[Process] r =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> Sem r (ExitCode, Text)
ourReadProcessInterleavedSem (ProcessConfig () () () -> Sem r (ExitCode, Text))
-> ProcessConfig () () () -> Sem r (ExitCode, Text)
forall a b. (a -> b) -> a -> b
$
      String -> [String] -> ProcessConfig () () ()
proc String
"timeout" [Text -> String
T.unpack Text
timeout, (String
binPath String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/nixpkgs-review"), String
"rev", Text -> String
T.unpack Text
commit, String
"--no-shell"]
  case ExitCode
exitCode of
    ExitFailure Int
124 -> do
      Text -> Sem r ()
forall o (r :: [(* -> *) -> * -> *]).
MemberWithError (Output o) r =>
o -> Sem r ()
output (Text -> Sem r ()) -> Text -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Text
"[check][nixpkgs-review] took longer than " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
timeout Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" and timed out"
      Text -> Sem r Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Sem r Text) -> Text -> Sem r Text
forall a b. (a -> b) -> a -> b
$ Text
"nixpkgs-review took longer than " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
timeout Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" and timed out"
    ExitCode
_ -> String -> Sem r Text
forall (r :: [(* -> *) -> * -> *]).
MemberWithError File r =>
String -> Sem r Text
F.read (String -> Sem r Text) -> String -> Sem r Text
forall a b. (a -> b) -> a -> b
$ (String -> Text -> String
revDir String
cache Text
commit) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/report.md"

-- Assumes we are already in nixpkgs dir
runReport :: (Text -> IO ()) -> Text -> IO Text
runReport :: (Text -> IO ()) -> Text -> IO Text
runReport Text -> IO ()
log Text
commit = do
  Text -> IO ()
log Text
"[check][nixpkgs-review]"
  String
c <- IO String
cacheDir
  Text
msg <-
    Sem '[Final IO] Text -> IO Text
forall (m :: * -> *) a. Monad m => Sem '[Final m] a -> m a
runFinal
      (Sem '[Final IO] Text -> IO Text)
-> (Sem '[Output Text, Process, File, Embed IO, Final IO] Text
    -> Sem '[Final IO] Text)
-> Sem '[Output Text, Process, File, Embed IO, Final IO] Text
-> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem '[Embed IO, Final IO] Text -> Sem '[Final IO] Text
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(Member (Final m) r, Functor m) =>
Sem (Embed m : r) a -> Sem r a
embedToFinal
      (Sem '[Embed IO, Final IO] Text -> Sem '[Final IO] Text)
-> (Sem '[Output Text, Process, File, Embed IO, Final IO] Text
    -> Sem '[Embed IO, Final IO] Text)
-> Sem '[Output Text, Process, File, Embed IO, Final IO] Text
-> Sem '[Final IO] Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem '[File, Embed IO, Final IO] Text
-> Sem '[Embed IO, Final IO] Text
forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed IO) r =>
Sem (File : r) a -> Sem r a
F.runIO
      (Sem '[File, Embed IO, Final IO] Text
 -> Sem '[Embed IO, Final IO] Text)
-> (Sem '[Output Text, Process, File, Embed IO, Final IO] Text
    -> Sem '[File, Embed IO, Final IO] Text)
-> Sem '[Output Text, Process, File, Embed IO, Final IO] Text
-> Sem '[Embed IO, Final IO] Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem '[Process, File, Embed IO, Final IO] Text
-> Sem '[File, Embed IO, Final IO] Text
forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed IO) r =>
Sem (Process : r) a -> Sem r a
P.runIO
      (Sem '[Process, File, Embed IO, Final IO] Text
 -> Sem '[File, Embed IO, Final IO] Text)
-> (Sem '[Output Text, Process, File, Embed IO, Final IO] Text
    -> Sem '[Process, File, Embed IO, Final IO] Text)
-> Sem '[Output Text, Process, File, Embed IO, Final IO] Text
-> Sem '[File, Embed IO, Final IO] Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> IO ())
-> Sem '[Output Text, Process, File, Embed IO, Final IO] Text
-> Sem '[Process, File, Embed IO, Final IO] Text
forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed IO) r =>
(Text -> IO ()) -> Sem (Output Text : r) a -> Sem r a
Utils.runLog Text -> IO ()
log
      (Sem '[Output Text, Process, File, Embed IO, Final IO] Text
 -> IO Text)
-> Sem '[Output Text, Process, File, Embed IO, Final IO] Text
-> IO Text
forall a b. (a -> b) -> a -> b
$ String
-> Text
-> Sem '[Output Text, Process, File, Embed IO, Final IO] Text
forall (r :: [(* -> *) -> * -> *]).
Members '[File, Process, Output Text] r =>
String -> Text -> Sem r Text
NixpkgsReview.run String
c Text
commit
  Text -> IO ()
log Text
msg
  Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
msg