{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase   #-}

-- |
-- Module    : Aura.Build
-- Copyright : (c) Colin Woodbury, 2012 - 2020
-- License   : GPL3
-- Maintainer: Colin Woodbury <colin@fosskers.ca>
--
-- Agnostically builds packages, regardless of original source.

module Aura.Build
  ( installPkgFiles
  , buildPackages
  , srcPkgStore
  , vcsStore
  ) where

import           Aura.Core
import           Aura.IO
import           Aura.Languages
import           Aura.MakePkg
import           Aura.Packages.AUR (clone)
import           Aura.Pacman (pacman)
import           Aura.Settings
import           Aura.Shell (chown)
import           Aura.Types
import           Aura.Utils (edit)
import           Control.Monad.Trans.Except
import           Data.Hashable (hash)
import           RIO
import           RIO.Directory
import           RIO.FilePath
import qualified RIO.List as L
import qualified RIO.NonEmpty as NEL
import           RIO.Partial (fromJust)
import qualified RIO.Set as S
import qualified RIO.Text as T
import           RIO.Time
import           System.Process.Typed

---

-- | There are multiple outcomes to a single call to `makepkg`.
data BuildResult = AllSourced | Built !(NonEmpty PackagePath)

builtPPs :: BuildResult -> Maybe (NonEmpty PackagePath)
builtPPs :: BuildResult -> Maybe (NonEmpty PackagePath)
builtPPs (Built NonEmpty PackagePath
pps) = NonEmpty PackagePath -> Maybe (NonEmpty PackagePath)
forall a. a -> Maybe a
Just NonEmpty PackagePath
pps
builtPPs BuildResult
_           = Maybe (NonEmpty PackagePath)
forall a. Maybe a
Nothing

-- | Storage location for "source" packages built with @--allsource@.
-- Can be overridden in config or with @--allsourcepath@.
srcPkgStore :: FilePath
srcPkgStore :: FilePath
srcPkgStore = FilePath
"/var/cache/aura/src"

-- | Storage/build location for VCS packages like @cool-retroterm-git@. Some of
-- these packages are quite large (e.g. kernels), and so recloning them in their
-- entirety upon each @-Au@ is wasteful.
vcsStore :: FilePath
vcsStore :: FilePath
vcsStore = FilePath
"/var/cache/aura/vcs"

-- | Expects files like: \/var\/cache\/pacman\/pkg\/*.pkg.tar.xz
installPkgFiles :: NonEmpty PackagePath -> RIO Env ()
installPkgFiles :: NonEmpty PackagePath -> RIO Env ()
installPkgFiles NonEmpty PackagePath
files = do
  Settings
ss <- (Env -> Settings) -> RIO Env Settings
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Settings
settings
  IO () -> RIO Env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO Env ()) -> IO () -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ Settings -> IO ()
checkDBLock Settings
ss
  IO () -> RIO Env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO Env ()) -> ([Text] -> IO ()) -> [Text] -> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> [Text] -> IO ()
pacman (Settings -> Environment
envOf Settings
ss) ([Text] -> RIO Env ()) -> [Text] -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ [Text
"-U"] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (PackagePath -> Text) -> [PackagePath] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Text
T.pack (FilePath -> Text)
-> (PackagePath -> FilePath) -> PackagePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackagePath -> FilePath
ppPath) (NonEmpty PackagePath -> [PackagePath]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty PackagePath
files) [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> CommonConfig -> [Text]
forall a. Flagable a => a -> [Text]
asFlag (Settings -> CommonConfig
commonConfigOf Settings
ss)

-- | All building occurs within temp directories, or in a location specified by
-- the user with flags.
buildPackages :: NonEmpty Buildable -> RIO Env [PackagePath]
buildPackages :: NonEmpty Buildable -> RIO Env [PackagePath]
buildPackages NonEmpty Buildable
bs = (Buildable -> RIO Env (Maybe BuildResult))
-> [Buildable] -> RIO Env [BuildResult]
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> [a] -> f [b]
mapMaybeA Buildable -> RIO Env (Maybe BuildResult)
build (NonEmpty Buildable -> [Buildable]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Buildable
bs) RIO Env [BuildResult]
-> ([BuildResult] -> RIO Env [PackagePath])
-> RIO Env [PackagePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  [] -> Failure -> RIO Env [PackagePath]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Failure -> RIO Env [PackagePath])
-> (FailMsg -> Failure) -> FailMsg -> RIO Env [PackagePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailMsg -> Failure
Failure (FailMsg -> RIO Env [PackagePath])
-> FailMsg -> RIO Env [PackagePath]
forall a b. (a -> b) -> a -> b
$ (Language -> Doc AnsiStyle) -> FailMsg
FailMsg Language -> Doc AnsiStyle
buildFail_10
  [BuildResult]
built -> [PackagePath] -> RIO Env [PackagePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([PackagePath] -> RIO Env [PackagePath])
-> ([NonEmpty PackagePath] -> [PackagePath])
-> [NonEmpty PackagePath]
-> RIO Env [PackagePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty PackagePath -> [PackagePath])
-> [NonEmpty PackagePath] -> [PackagePath]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap NonEmpty PackagePath -> [PackagePath]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([NonEmpty PackagePath] -> RIO Env [PackagePath])
-> [NonEmpty PackagePath] -> RIO Env [PackagePath]
forall a b. (a -> b) -> a -> b
$ (BuildResult -> Maybe (NonEmpty PackagePath))
-> [BuildResult] -> [NonEmpty PackagePath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe BuildResult -> Maybe (NonEmpty PackagePath)
builtPPs [BuildResult]
built

-- | Handles the building of Packages. Fails nicely.
-- Assumed: All dependencies are already installed.
build :: Buildable -> RIO Env (Maybe BuildResult)
build :: Buildable -> RIO Env (Maybe BuildResult)
build Buildable
p = do
  Utf8Builder -> RIO Env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO Env ()) -> Utf8Builder -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Building: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (PkgName -> Text
pnName (PkgName -> Text) -> PkgName -> Text
forall a b. (a -> b) -> a -> b
$ Buildable -> PkgName
bName Buildable
p)
  Settings
ss <- (Env -> Settings) -> RIO Env Settings
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Settings
settings
  Settings -> (Language -> Doc AnsiStyle) -> RIO Env ()
forall (m :: * -> *).
MonadIO m =>
Settings -> (Language -> Doc AnsiStyle) -> m ()
notify Settings
ss (PkgName -> Language -> Doc AnsiStyle
buildPackages_1 (PkgName -> Language -> Doc AnsiStyle)
-> PkgName -> Language -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Buildable -> PkgName
bName Buildable
p) RIO Env () -> RIO Env () -> RIO Env ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Handle -> RIO Env ()
forall (m :: * -> *). MonadIO m => Handle -> m ()
hFlush Handle
stdout
  Either Failure BuildResult
result <- Buildable -> RIO Env (Either Failure BuildResult)
build' Buildable
p
  (Failure -> RIO Env (Maybe BuildResult))
-> (BuildResult -> RIO Env (Maybe BuildResult))
-> Either Failure BuildResult
-> RIO Env (Maybe BuildResult)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Failure -> RIO Env (Maybe BuildResult)
forall a. Failure -> RIO Env (Maybe a)
buildFail (Maybe BuildResult -> RIO Env (Maybe BuildResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe BuildResult -> RIO Env (Maybe BuildResult))
-> (BuildResult -> Maybe BuildResult)
-> BuildResult
-> RIO Env (Maybe BuildResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildResult -> Maybe BuildResult
forall a. a -> Maybe a
Just) Either Failure BuildResult
result

-- | Should never throw an IO Exception. In theory all errors will come back via
-- the @Language -> String@ function.
--
-- If the package is a VCS package (i.e. ending in -git, etc.), it will be built
-- and stored in a separate, deterministic location to prevent repeated clonings
-- during subsequent builds.
--
-- If `--allsource` was given, then the package isn't actually built.
-- Instead, a @.src.tar.gz@ file is produced and copied to `srcPkgStore`.
--
-- One `Buildable` can become multiple `PackagePath` due to "split packages".
-- i.e. a single call to `makepkg` can produce multiple related packages.
build' :: Buildable -> RIO Env (Either Failure BuildResult)
build' :: Buildable -> RIO Env (Either Failure BuildResult)
build' Buildable
b = do
  Settings
ss <- (Env -> Settings) -> RIO Env Settings
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Settings
settings
  let !isDevel :: Bool
isDevel = PkgName -> Bool
isDevelPkg (PkgName -> Bool) -> PkgName -> Bool
forall a b. (a -> b) -> a -> b
$ Buildable -> PkgName
bName Buildable
b
      !pth :: FilePath
pth | Bool
isDevel = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
vcsStore (Maybe FilePath -> FilePath)
-> (BuildConfig -> Maybe FilePath) -> BuildConfig -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildConfig -> Maybe FilePath
vcsPathOf (BuildConfig -> FilePath) -> BuildConfig -> FilePath
forall a b. (a -> b) -> a -> b
$ Settings -> BuildConfig
buildConfigOf Settings
ss
           | Bool
otherwise = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
defaultBuildDir (Maybe FilePath -> FilePath)
-> (BuildConfig -> Maybe FilePath) -> BuildConfig -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildConfig -> Maybe FilePath
buildPathOf (BuildConfig -> FilePath) -> BuildConfig -> FilePath
forall a b. (a -> b) -> a -> b
$ Settings -> BuildConfig
buildConfigOf Settings
ss
      !usr :: User
usr = User -> Maybe User -> User
forall a. a -> Maybe a -> a
fromMaybe (Text -> User
User Text
"UNKNOWN") (Maybe User -> User)
-> (BuildConfig -> Maybe User) -> BuildConfig -> User
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildConfig -> Maybe User
buildUserOf (BuildConfig -> User) -> BuildConfig -> User
forall a b. (a -> b) -> a -> b
$ Settings -> BuildConfig
buildConfigOf Settings
ss
  -- Create the build dir with open permissions so as to avoid issues involving git cloning.
  FilePath -> RIO Env ()
createWritableIfMissing FilePath
pth
  -- Move into the final build dir.
  FilePath -> RIO Env ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
setCurrentDirectory FilePath
pth
  FilePath
buildDir <- IO FilePath -> RIO Env FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> RIO Env FilePath)
-> IO FilePath -> RIO Env FilePath
forall a b. (a -> b) -> a -> b
$ Buildable -> IO FilePath
getBuildDir Buildable
b
  FilePath -> RIO Env ()
createWritableIfMissing FilePath
buildDir
  FilePath -> RIO Env ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
setCurrentDirectory FilePath
buildDir
  -- Build the package.
  Either Failure BuildResult
r <- ExceptT Failure (RIO Env) BuildResult
-> RIO Env (Either Failure BuildResult)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Failure (RIO Env) BuildResult
 -> RIO Env (Either Failure BuildResult))
-> ExceptT Failure (RIO Env) BuildResult
-> RIO Env (Either Failure BuildResult)
forall a b. (a -> b) -> a -> b
$ do
    FilePath
bs <- RIO Env (Either Failure FilePath)
-> ExceptT Failure (RIO Env) FilePath
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (RIO Env (Either Failure FilePath)
 -> ExceptT Failure (RIO Env) FilePath)
-> RIO Env (Either Failure FilePath)
-> ExceptT Failure (RIO Env) FilePath
forall a b. (a -> b) -> a -> b
$ do
      let !dir :: FilePath
dir = FilePath
buildDir FilePath -> FilePath -> FilePath
</> Text -> FilePath
T.unpack (PkgName -> Text
pnName (PkgName -> Text) -> PkgName -> Text
forall a b. (a -> b) -> a -> b
$ Buildable -> PkgName
bName Buildable
b)
      Bool
pulled <- FilePath -> RIO Env Bool
forall (m :: * -> *). MonadIO m => FilePath -> m Bool
doesDirectoryExist FilePath
dir
      RIO Env (Either Failure FilePath)
-> RIO Env (Either Failure FilePath)
-> Bool
-> RIO Env (Either Failure FilePath)
forall a. a -> a -> Bool -> a
bool (Buildable -> User -> RIO Env (Either Failure FilePath)
cloneRepo Buildable
b User
usr) (Either Failure FilePath -> RIO Env (Either Failure FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Failure FilePath -> RIO Env (Either Failure FilePath))
-> Either Failure FilePath -> RIO Env (Either Failure FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either Failure FilePath
forall a b. b -> Either a b
Right FilePath
dir) Bool
pulled
    FilePath -> ExceptT Failure (RIO Env) ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
setCurrentDirectory FilePath
bs
    Bool
-> ExceptT Failure (RIO Env) () -> ExceptT Failure (RIO Env) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isDevel (ExceptT Failure (RIO Env) () -> ExceptT Failure (RIO Env) ())
-> (RIO Env (Either Failure ()) -> ExceptT Failure (RIO Env) ())
-> RIO Env (Either Failure ())
-> ExceptT Failure (RIO Env) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RIO Env (Either Failure ()) -> ExceptT Failure (RIO Env) ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (RIO Env (Either Failure ()) -> ExceptT Failure (RIO Env) ())
-> RIO Env (Either Failure ()) -> ExceptT Failure (RIO Env) ()
forall a b. (a -> b) -> a -> b
$ User -> RIO Env (Either Failure ())
pullRepo User
usr
    Utf8Builder -> ExceptT Failure (RIO Env) ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Potential hotediting..."
    IO () -> ExceptT Failure (RIO Env) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT Failure (RIO Env) ())
-> IO () -> ExceptT Failure (RIO Env) ()
forall a b. (a -> b) -> a -> b
$ Settings -> Buildable -> IO ()
overwritePkgbuild Settings
ss Buildable
b
    IO () -> ExceptT Failure (RIO Env) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT Failure (RIO Env) ())
-> IO () -> ExceptT Failure (RIO Env) ()
forall a b. (a -> b) -> a -> b
$ Settings -> IO ()
overwriteInstall Settings
ss
    IO () -> ExceptT Failure (RIO Env) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT Failure (RIO Env) ())
-> IO () -> ExceptT Failure (RIO Env) ()
forall a b. (a -> b) -> a -> b
$ Settings -> IO ()
overwritePatches Settings
ss
    if Makepkg -> Set Makepkg -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Makepkg
AllSource (Set Makepkg -> Bool)
-> (BuildConfig -> Set Makepkg) -> BuildConfig -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildConfig -> Set Makepkg
makepkgFlagsOf (BuildConfig -> Bool) -> BuildConfig -> Bool
forall a b. (a -> b) -> a -> b
$ Settings -> BuildConfig
buildConfigOf Settings
ss
      then do
        let !allsourcePath :: FilePath
allsourcePath = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
srcPkgStore (Maybe FilePath -> FilePath)
-> (BuildConfig -> Maybe FilePath) -> BuildConfig -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildConfig -> Maybe FilePath
allsourcePathOf (BuildConfig -> FilePath) -> BuildConfig -> FilePath
forall a b. (a -> b) -> a -> b
$ Settings -> BuildConfig
buildConfigOf Settings
ss
        IO () -> ExceptT Failure (RIO Env) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (User -> IO [FilePath]
makepkgSource User
usr IO [FilePath] -> ([FilePath] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO FilePath) -> [FilePath] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (FilePath -> FilePath -> IO FilePath
moveToSourcePath FilePath
allsourcePath)) ExceptT Failure (RIO Env) ()
-> BuildResult -> ExceptT Failure (RIO Env) BuildResult
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> BuildResult
AllSourced
      else do
        Utf8Builder -> ExceptT Failure (RIO Env) ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Building package."
        NonEmpty FilePath
pNames <- RIO Env (Either Failure (NonEmpty FilePath))
-> ExceptT Failure (RIO Env) (NonEmpty FilePath)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (RIO Env (Either Failure (NonEmpty FilePath))
 -> ExceptT Failure (RIO Env) (NonEmpty FilePath))
-> (IO (Either Failure (NonEmpty FilePath))
    -> RIO Env (Either Failure (NonEmpty FilePath)))
-> IO (Either Failure (NonEmpty FilePath))
-> ExceptT Failure (RIO Env) (NonEmpty FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either Failure (NonEmpty FilePath))
-> RIO Env (Either Failure (NonEmpty FilePath))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either Failure (NonEmpty FilePath))
 -> ExceptT Failure (RIO Env) (NonEmpty FilePath))
-> IO (Either Failure (NonEmpty FilePath))
-> ExceptT Failure (RIO Env) (NonEmpty FilePath)
forall a b. (a -> b) -> a -> b
$ Settings -> User -> IO (Either Failure (NonEmpty FilePath))
makepkg Settings
ss User
usr
        IO BuildResult -> ExceptT Failure (RIO Env) BuildResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BuildResult -> ExceptT Failure (RIO Env) BuildResult)
-> (IO (NonEmpty PackagePath) -> IO BuildResult)
-> IO (NonEmpty PackagePath)
-> ExceptT Failure (RIO Env) BuildResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty PackagePath -> BuildResult)
-> IO (NonEmpty PackagePath) -> IO BuildResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty PackagePath -> BuildResult
Built (IO (NonEmpty PackagePath)
 -> ExceptT Failure (RIO Env) BuildResult)
-> IO (NonEmpty PackagePath)
-> ExceptT Failure (RIO Env) BuildResult
forall a b. (a -> b) -> a -> b
$ (FilePath -> IO PackagePath)
-> NonEmpty FilePath -> IO (NonEmpty PackagePath)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Settings -> FilePath -> IO PackagePath
moveToCachePath Settings
ss) NonEmpty FilePath
pNames
  Bool -> RIO Env () -> RIO Env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Settings -> BuildSwitch -> Bool
switch Settings
ss BuildSwitch
DeleteBuildDir) (RIO Env () -> RIO Env ()) -> RIO Env () -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ do
    Utf8Builder -> RIO Env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO Env ())
-> (FilePath -> Utf8Builder) -> FilePath -> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Utf8Builder
forall a. IsString a => FilePath -> a
fromString (FilePath -> RIO Env ()) -> FilePath -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Deleting build directory: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
buildDir
    FilePath -> RIO Env ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
removeDirectoryRecursive FilePath
buildDir
  Either Failure BuildResult -> RIO Env (Either Failure BuildResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either Failure BuildResult
r

createWritableIfMissing :: FilePath -> RIO Env ()
createWritableIfMissing :: FilePath -> RIO Env ()
createWritableIfMissing FilePath
pth = do
  Bool
exists <- FilePath -> RIO Env Bool
forall (m :: * -> *). MonadIO m => FilePath -> m Bool
doesDirectoryExist FilePath
pth
  if Bool
exists
    -- This is a migration strategy - it ensures that directories created with
    -- old versions of Aura automatically have their permissions fixed.
    then case FilePath
pth of
      FilePath
"/var/cache/aura/vcs" -> FilePath -> RIO Env ()
setMode FilePath
"755"
      FilePath
"/tmp"                -> FilePath -> RIO Env ()
setMode FilePath
"1777"
      FilePath
_                     -> () -> RIO Env ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    -- The library function `createDirectoryIfMissing` seems to obey umasks when
    -- creating directories, which can cause problem later during the build
    -- processes of git packages. By manually creating the directory with the
    -- expected permissions, we avoid this problem.
    else RIO Env ExitCode -> RIO Env ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RIO Env ExitCode -> RIO Env ())
-> (ProcessConfig () () () -> RIO Env ExitCode)
-> ProcessConfig () () ()
-> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessConfig () () () -> RIO Env ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
runProcess (ProcessConfig () () () -> RIO Env ExitCode)
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> RIO Env ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed (ProcessConfig () () () -> ProcessConfig () () ())
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> ProcessConfig () () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed (ProcessConfig () () () -> RIO Env ())
-> ProcessConfig () () () -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
"mkdir" [FilePath
"-p", FilePath
"-m755", FilePath
pth]
  where
    setMode :: String -> RIO Env ()
    setMode :: FilePath -> RIO Env ()
setMode FilePath
mode = RIO Env ExitCode -> RIO Env ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RIO Env ExitCode -> RIO Env ())
-> (ProcessConfig () () () -> RIO Env ExitCode)
-> ProcessConfig () () ()
-> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessConfig () () () -> RIO Env ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
runProcess (ProcessConfig () () () -> RIO Env ExitCode)
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> RIO Env ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed (ProcessConfig () () () -> ProcessConfig () () ())
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> ProcessConfig () () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed (ProcessConfig () () () -> RIO Env ())
-> ProcessConfig () () () -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
"chmod" [FilePath
mode, FilePath
pth]

-- | A unique directory name (within the greater "parent" build dir) in which to
-- copy sources and actually build a package.
getBuildDir :: Buildable -> IO FilePath
getBuildDir :: Buildable -> IO FilePath
getBuildDir Buildable
b
  | PkgName -> Bool
isDevelPkg (PkgName -> Bool) -> PkgName -> Bool
forall a b. (a -> b) -> a -> b
$ Buildable -> PkgName
bName Buildable
b = PkgName -> IO FilePath
vcsBuildDir (PkgName -> IO FilePath) -> PkgName -> IO FilePath
forall a b. (a -> b) -> a -> b
$ Buildable -> PkgName
bName Buildable
b
  | Bool
otherwise = Buildable -> IO FilePath
randomDirName Buildable
b

vcsBuildDir :: PkgName -> IO FilePath
vcsBuildDir :: PkgName -> IO FilePath
vcsBuildDir (PkgName Text
pn) = do
  FilePath
pwd <- IO FilePath
forall (m :: * -> *). MonadIO m => m FilePath
getCurrentDirectory
  FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
pwd FilePath -> FilePath -> FilePath
</> Text -> FilePath
T.unpack Text
pn

-- | Create a temporary directory with a semi-random name based on
-- the `Buildable` we're working with.
randomDirName :: Buildable -> IO FilePath
randomDirName :: Buildable -> IO FilePath
randomDirName Buildable
b = do
  FilePath
pwd <- IO FilePath
forall (m :: * -> *). MonadIO m => m FilePath
getCurrentDirectory
  UTCTime Day
_ DiffTime
dt <- IO UTCTime
forall (m :: * -> *). MonadIO m => m UTCTime
getCurrentTime
  let nh :: Int
nh = Text -> Int
forall a. Hashable a => a -> Int
hash (Text -> Int) -> (PkgName -> Text) -> PkgName -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgName -> Text
pnName (PkgName -> Int) -> PkgName -> Int
forall a b. (a -> b) -> a -> b
$ Buildable -> PkgName
bName Buildable
b
      vh :: Int
vh = Versioning -> Int
forall a. Hashable a => a -> Int
hash (Versioning -> Int) -> Versioning -> Int
forall a b. (a -> b) -> a -> b
$ Buildable -> Versioning
bVersion Buildable
b
      v :: Int
v  = Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
nh Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vh Int -> Int -> Int
forall a. Num a => a -> a -> a
+ DiffTime -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor DiffTime
dt
      dir :: FilePath
dir = Text -> FilePath
T.unpack (PkgName -> Text
pnName (PkgName -> Text) -> PkgName -> Text
forall a b. (a -> b) -> a -> b
$ Buildable -> PkgName
bName Buildable
b) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
v
  FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
pwd FilePath -> FilePath -> FilePath
</> FilePath
dir

cloneRepo :: Buildable -> User -> RIO Env (Either Failure FilePath)
cloneRepo :: Buildable -> User -> RIO Env (Either Failure FilePath)
cloneRepo Buildable
pkg User
usr = do
  FilePath
currDir <- IO FilePath -> RIO Env FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
forall (m :: * -> *). MonadIO m => m FilePath
getCurrentDirectory
  Utf8Builder -> RIO Env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO Env ()) -> Utf8Builder -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Currently in: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow FilePath
currDir
  Maybe FilePath
scriptsDir <- IO (Maybe FilePath) -> RIO Env (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FilePath) -> RIO Env (Maybe FilePath))
-> IO (Maybe FilePath) -> RIO Env (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ User -> FilePath -> [FilePath] -> IO ()
forall (m :: * -> *).
MonadIO m =>
User -> FilePath -> [FilePath] -> m ()
chown User
usr FilePath
currDir [] IO () -> IO (Maybe FilePath) -> IO (Maybe FilePath)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Buildable -> IO (Maybe FilePath)
clone Buildable
pkg
  Utf8Builder -> RIO Env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"git: Initial cloning complete."
  case Maybe FilePath
scriptsDir of
    Maybe FilePath
Nothing -> Either Failure FilePath -> RIO Env (Either Failure FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Failure FilePath -> RIO Env (Either Failure FilePath))
-> (PkgName -> Either Failure FilePath)
-> PkgName
-> RIO Env (Either Failure FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Failure -> Either Failure FilePath
forall a b. a -> Either a b
Left (Failure -> Either Failure FilePath)
-> (PkgName -> Failure) -> PkgName -> Either Failure FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailMsg -> Failure
Failure (FailMsg -> Failure) -> (PkgName -> FailMsg) -> PkgName -> Failure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Language -> Doc AnsiStyle) -> FailMsg
FailMsg((Language -> Doc AnsiStyle) -> FailMsg)
-> (PkgName -> Language -> Doc AnsiStyle) -> PkgName -> FailMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  PkgName -> Language -> Doc AnsiStyle
buildFail_7 (PkgName -> RIO Env (Either Failure FilePath))
-> PkgName -> RIO Env (Either Failure FilePath)
forall a b. (a -> b) -> a -> b
$ Buildable -> PkgName
bName Buildable
pkg
    Just FilePath
sd -> User -> FilePath -> [FilePath] -> RIO Env ()
forall (m :: * -> *).
MonadIO m =>
User -> FilePath -> [FilePath] -> m ()
chown User
usr FilePath
sd [FilePath
"-R"] RIO Env ()
-> Either Failure FilePath -> RIO Env (Either Failure FilePath)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FilePath -> Either Failure FilePath
forall a b. b -> Either a b
Right FilePath
sd

-- | Assuming that we're already in a VCS-based package's build folder,
-- just pull the latest instead of cloning.
pullRepo :: User -> RIO Env (Either Failure ())
pullRepo :: User -> RIO Env (Either Failure ())
pullRepo User
usr = do
  Utf8Builder -> RIO Env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"git: Clearing worktree. "
  RIO Env ExitCode -> RIO Env ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RIO Env ExitCode -> RIO Env ())
-> (ProcessConfig () () () -> RIO Env ExitCode)
-> ProcessConfig () () ()
-> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessConfig () () () -> RIO Env ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
runProcess (ProcessConfig () () () -> RIO Env ExitCode)
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> RIO Env ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed (ProcessConfig () () () -> ProcessConfig () () ())
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> ProcessConfig () () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed (ProcessConfig () () () -> RIO Env ())
-> ProcessConfig () () () -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
"git" [FilePath
"reset", FilePath
"--hard", FilePath
"HEAD"]
  Utf8Builder -> RIO Env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"git: Pulling repo."
  ExitCode
ec <- ProcessConfig () () () -> RIO Env ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
runProcess (ProcessConfig () () () -> RIO Env ExitCode)
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> RIO Env ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed (ProcessConfig () () () -> ProcessConfig () () ())
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> ProcessConfig () () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed (ProcessConfig () () () -> RIO Env ExitCode)
-> ProcessConfig () () () -> RIO Env ExitCode
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
"git" [FilePath
"pull"]
  case ExitCode
ec of
    ExitFailure Int
_ -> Either Failure () -> RIO Env (Either Failure ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Failure () -> RIO Env (Either Failure ()))
-> (FailMsg -> Either Failure ())
-> FailMsg
-> RIO Env (Either Failure ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Failure -> Either Failure ()
forall a b. a -> Either a b
Left (Failure -> Either Failure ())
-> (FailMsg -> Failure) -> FailMsg -> Either Failure ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailMsg -> Failure
Failure (FailMsg -> RIO Env (Either Failure ()))
-> FailMsg -> RIO Env (Either Failure ())
forall a b. (a -> b) -> a -> b
$ (Language -> Doc AnsiStyle) -> FailMsg
FailMsg Language -> Doc AnsiStyle
buildFail_12
    ExitCode
ExitSuccess   -> IO () -> RIO Env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (User -> FilePath -> [FilePath] -> IO ()
forall (m :: * -> *).
MonadIO m =>
User -> FilePath -> [FilePath] -> m ()
chown User
usr FilePath
"." [FilePath
"-R"]) RIO Env () -> Either Failure () -> RIO Env (Either Failure ())
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> () -> Either Failure ()
forall a b. b -> Either a b
Right ()

-- | Edit the PKGBUILD in-place, if the user wants to.
overwritePkgbuild :: Settings -> Buildable -> IO ()
overwritePkgbuild :: Settings -> Buildable -> IO ()
overwritePkgbuild Settings
ss Buildable
b = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Settings -> BuildSwitch -> Bool
switch Settings
ss BuildSwitch
HotEdit) (IO () -> IO ()) -> (IO () -> IO ()) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  Bool
ans <- Settings -> (Language -> Doc AnsiStyle) -> IO Bool
optionalPrompt Settings
ss (PkgName -> Language -> Doc AnsiStyle
hotEdit_1 (PkgName -> Language -> Doc AnsiStyle)
-> PkgName -> Language -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Buildable -> PkgName
bName Buildable
b)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ans (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
edit (Settings -> FilePath
editorOf Settings
ss) FilePath
"PKGBUILD"

-- | Edit the .install file in-place, if the user wants to and it exists.
overwriteInstall :: Settings -> IO ()
overwriteInstall :: Settings -> IO ()
overwriteInstall Settings
ss = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Settings -> BuildSwitch -> Bool
switch Settings
ss BuildSwitch
HotEdit) (IO () -> IO ()) -> (IO () -> IO ()) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  [FilePath]
files <- IO FilePath
forall (m :: * -> *). MonadIO m => m FilePath
getCurrentDirectory IO FilePath -> (FilePath -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO [FilePath]
forall (m :: * -> *). MonadIO m => FilePath -> m [FilePath]
listDirectory
  case (FilePath -> Bool) -> [FilePath] -> Maybe FilePath
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find ((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".install") (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeFileName) [FilePath]
files of
    Maybe FilePath
Nothing -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just FilePath
_  -> do
      Bool
ans <- Settings -> (Language -> Doc AnsiStyle) -> IO Bool
optionalPrompt Settings
ss Language -> Doc AnsiStyle
hotEdit_2
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ans (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
edit (Settings -> FilePath
editorOf Settings
ss) FilePath
".install"

-- | Edit the all .patch files, if the user wants to and some exist.
overwritePatches :: Settings -> IO ()
overwritePatches :: Settings -> IO ()
overwritePatches Settings
ss = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Settings -> BuildSwitch -> Bool
switch Settings
ss BuildSwitch
HotEdit) (IO () -> IO ()) -> (IO () -> IO ()) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  [FilePath]
files <- IO FilePath
forall (m :: * -> *). MonadIO m => m FilePath
getCurrentDirectory IO FilePath -> (FilePath -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO [FilePath]
forall (m :: * -> *). MonadIO m => FilePath -> m [FilePath]
listDirectory
  let !patches :: [FilePath]
patches = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".patch") (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtension) [FilePath]
files
  (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ FilePath -> IO ()
f [FilePath]
patches
  where
    f :: FilePath -> IO ()
    f :: FilePath -> IO ()
f FilePath
p = do
      Bool
ans <- Settings -> (Language -> Doc AnsiStyle) -> IO Bool
optionalPrompt Settings
ss ((Language -> Doc AnsiStyle) -> IO Bool)
-> (Language -> Doc AnsiStyle) -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> Language -> Doc AnsiStyle
hotEdit_3 FilePath
p
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ans (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
edit (Settings -> FilePath
editorOf Settings
ss) FilePath
p

-- | Inform the user that building failed. Ask them if they want to
-- continue installing previous packages that built successfully.
buildFail :: Failure -> RIO Env (Maybe a)
buildFail :: Failure -> RIO Env (Maybe a)
buildFail Failure
err = do
  Settings
ss <- (Env -> Settings) -> RIO Env Settings
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Settings
settings
  case Failure
err of
    Failure
Silent               -> () -> RIO Env ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Failure (FailMsg Language -> Doc AnsiStyle
fm) -> Settings -> (Language -> Doc AnsiStyle) -> RIO Env ()
forall (m :: * -> *).
MonadIO m =>
Settings -> (Language -> Doc AnsiStyle) -> m ()
scold Settings
ss Language -> Doc AnsiStyle
fm
  Settings
-> (Language -> Doc AnsiStyle)
-> (Language -> Doc AnsiStyle)
-> RIO Env (Maybe a)
-> RIO Env (Maybe a)
forall e a.
Settings
-> (Language -> Doc AnsiStyle)
-> (Language -> Doc AnsiStyle)
-> RIO e a
-> RIO e a
withOkay Settings
ss Language -> Doc AnsiStyle
buildFail_6 Language -> Doc AnsiStyle
buildFail_5 (RIO Env (Maybe a) -> RIO Env (Maybe a))
-> RIO Env (Maybe a) -> RIO Env (Maybe a)
forall a b. (a -> b) -> a -> b
$ Maybe a -> RIO Env (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing

-- | Moves a file to the pacman package cache and returns its location.
moveToCachePath :: Settings -> FilePath -> IO PackagePath
moveToCachePath :: Settings -> FilePath -> IO PackagePath
moveToCachePath Settings
ss FilePath
p = IO ExitCode
copy IO ExitCode -> PackagePath -> IO PackagePath
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe PackagePath -> PackagePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe PackagePath
packagePath FilePath
newName)
  where newName :: FilePath
newName = FilePath
pth FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeFileName FilePath
p
        pth :: FilePath
pth     = (FilePath -> FilePath)
-> (FilePath -> FilePath) -> Either FilePath FilePath -> FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> FilePath
forall a. a -> a
id FilePath -> FilePath
forall a. a -> a
id (Either FilePath FilePath -> FilePath)
-> (CommonConfig -> Either FilePath FilePath)
-> CommonConfig
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonConfig -> Either FilePath FilePath
cachePathOf (CommonConfig -> FilePath) -> CommonConfig -> FilePath
forall a b. (a -> b) -> a -> b
$ Settings -> CommonConfig
commonConfigOf Settings
ss
        copy :: IO ExitCode
copy    = ProcessConfig () () () -> IO ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
runProcess (ProcessConfig () () () -> IO ExitCode)
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> IO ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed (ProcessConfig () () () -> ProcessConfig () () ())
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> ProcessConfig () () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed
                  (ProcessConfig () () () -> IO ExitCode)
-> ProcessConfig () () () -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
"cp" [FilePath
"--reflink=auto", FilePath
p, FilePath
newName]

-- | Moves a file to the aura src package cache and returns its location.
moveToSourcePath :: FilePath -> FilePath -> IO FilePath
moveToSourcePath :: FilePath -> FilePath -> IO FilePath
moveToSourcePath FilePath
allsourcePath FilePath
p = do
  Bool -> FilePath -> IO ()
forall (m :: * -> *). MonadIO m => Bool -> FilePath -> m ()
createDirectoryIfMissing Bool
True FilePath
allsourcePath
  IO ExitCode
copy IO ExitCode -> FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FilePath
newName
  where
    newName :: FilePath
newName = FilePath
allsourcePath FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeFileName FilePath
p
    copy :: IO ExitCode
copy    = ProcessConfig () () () -> IO ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
runProcess (ProcessConfig () () () -> IO ExitCode)
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> IO ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed (ProcessConfig () () () -> ProcessConfig () () ())
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> ProcessConfig () () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed
              (ProcessConfig () () () -> IO ExitCode)
-> ProcessConfig () () () -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
"cp" [FilePath
"--reflink=auto", FilePath
p, FilePath
newName]