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

-- |
-- Module    : Aura.Install
-- Copyright : (c) Colin Woodbury, 2012 - 2020
-- License   : GPL3
-- Maintainer: Colin Woodbury <colin@fosskers.ca>
--
-- Layer for AUR package installation.
-- Backend for `Aura.Commands.A`.

module Aura.Install
  ( install
  , displayPkgDeps
  ) where

import           Aura.Build
import           Aura.Cache (Cache(..), cacheContents)
import           Aura.Colour
import           Aura.Core
import           Aura.Dependencies (resolveDeps)
import           Aura.IO
import           Aura.Languages
import           Aura.Packages.AUR (aurLookup)
import           Aura.Pacman (pacman, pacmanSuccess)
import           Aura.Pkgbuild.Records
import           Aura.Security
import           Aura.Settings
import           Aura.Types
import           Aura.Utils
import           Control.Scheduler (Comp(..), traverseConcurrently)
import           Data.Text.Prettyprint.Doc
import           Data.Text.Prettyprint.Doc.Render.Terminal
import           RIO
import           RIO.Directory (setCurrentDirectory)
import           RIO.FilePath (takeFileName)
import qualified RIO.List as L
import qualified RIO.Map as M
import qualified RIO.NonEmpty as NEL
import qualified RIO.Set as S
import           Text.Printf (printf)

---

-- | High level 'install' command. Handles installing dependencies.
install :: NonEmpty PkgName -> RIO Env ()
install :: NonEmpty PkgName -> RIO Env ()
install NonEmpty PkgName
pkgs = do
  Settings
ss <- (Env -> Settings) -> RIO Env Settings
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Settings
settings
  if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Settings -> BuildSwitch -> Bool
switch Settings
ss BuildSwitch
DeleteMakeDeps
    then NonEmpty PkgName -> RIO Env ()
install' NonEmpty PkgName
pkgs
    else do -- `-a` was used.
      Set PkgName
orphansBefore <- IO (Set PkgName) -> RIO Env (Set PkgName)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Set PkgName) -> RIO Env (Set PkgName))
-> (Environment -> IO (Set PkgName))
-> Environment
-> RIO Env (Set PkgName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> IO (Set PkgName)
orphans (Environment -> RIO Env (Set PkgName))
-> Environment -> RIO Env (Set PkgName)
forall a b. (a -> b) -> a -> b
$ Settings -> Environment
envOf Settings
ss
      NonEmpty PkgName -> RIO Env ()
install' NonEmpty PkgName
pkgs
      Set PkgName
orphansAfter <- IO (Set PkgName) -> RIO Env (Set PkgName)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Set PkgName) -> RIO Env (Set PkgName))
-> (Environment -> IO (Set PkgName))
-> Environment
-> RIO Env (Set PkgName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> IO (Set PkgName)
orphans (Environment -> RIO Env (Set PkgName))
-> Environment -> RIO Env (Set PkgName)
forall a b. (a -> b) -> a -> b
$ Settings -> Environment
envOf Settings
ss
      let makeDeps :: Maybe (NonEmpty PkgName)
makeDeps = Set PkgName -> Maybe (NonEmpty PkgName)
forall a. Set a -> Maybe (NonEmpty a)
nes (Set PkgName -> Maybe (NonEmpty PkgName))
-> Set PkgName -> Maybe (NonEmpty PkgName)
forall a b. (a -> b) -> a -> b
$ Set PkgName
orphansAfter Set PkgName -> Set PkgName -> Set PkgName
forall a. Ord a => Set a -> Set a -> Set a
S.\\ Set PkgName
orphansBefore
      (NonEmpty PkgName -> RIO Env ())
-> Maybe (NonEmpty PkgName) -> RIO Env ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\NonEmpty PkgName
mds -> IO () -> RIO Env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Settings -> (Language -> Doc AnsiStyle) -> IO ()
forall (m :: * -> *).
MonadIO m =>
Settings -> (Language -> Doc AnsiStyle) -> m ()
notify Settings
ss Language -> Doc AnsiStyle
removeMakeDepsAfter_1) RIO Env () -> RIO Env () -> RIO Env ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> NonEmpty PkgName -> RIO Env ()
removePkgs NonEmpty PkgName
mds) Maybe (NonEmpty PkgName)
makeDeps

install' :: NonEmpty PkgName -> RIO Env ()
install' :: NonEmpty PkgName -> RIO Env ()
install' NonEmpty PkgName
pkgs = do
  Repository
rpstry   <- (Env -> Repository) -> RIO Env Repository
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Repository
repository
  Settings
ss       <- (Env -> Settings) -> RIO Env Settings
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Settings
settings
  let !env :: Environment
env = Settings -> Environment
envOf Settings
ss
  Set PkgName
unneeded <- RIO Env (Set PkgName)
-> RIO Env (Set PkgName) -> Bool -> RIO Env (Set PkgName)
forall a. a -> a -> Bool -> a
bool
              (Set PkgName -> RIO Env (Set PkgName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set PkgName
forall a. Set a
S.empty)
              ([PkgName] -> Set PkgName
forall a. Ord a => [a] -> Set a
S.fromList ([PkgName] -> Set PkgName)
-> ([Maybe PkgName] -> [PkgName]) -> [Maybe PkgName] -> Set PkgName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe PkgName] -> [PkgName]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe PkgName] -> Set PkgName)
-> RIO Env [Maybe PkgName] -> RIO Env (Set PkgName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Maybe PkgName] -> RIO Env [Maybe PkgName]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Comp
-> (PkgName -> IO (Maybe PkgName))
-> [PkgName]
-> IO [Maybe PkgName]
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
Comp -> (a -> m b) -> t a -> m (t b)
traverseConcurrently Comp
Par' (Environment -> PkgName -> IO (Maybe PkgName)
isInstalled Environment
env) ([PkgName] -> IO [Maybe PkgName])
-> [PkgName] -> IO [Maybe PkgName]
forall a b. (a -> b) -> a -> b
$ NonEmpty PkgName -> [PkgName]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty PkgName
pkgs))
              (Bool -> RIO Env (Set PkgName)) -> Bool -> RIO Env (Set PkgName)
forall a b. (a -> b) -> a -> b
$ Settings -> CommonSwitch -> Bool
shared Settings
ss CommonSwitch
NeededOnly
  let !pkgs' :: Set PkgName
pkgs' = [PkgName] -> Set PkgName
forall a. Ord a => [a] -> Set a
S.fromList ([PkgName] -> Set PkgName) -> [PkgName] -> Set PkgName
forall a b. (a -> b) -> a -> b
$ NonEmpty PkgName -> [PkgName]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty PkgName
pkgs
  if Settings -> CommonSwitch -> Bool
shared Settings
ss CommonSwitch
NeededOnly Bool -> Bool -> Bool
&& Set PkgName
unneeded Set PkgName -> Set PkgName -> Bool
forall a. Eq a => a -> a -> Bool
== Set PkgName
pkgs'
    then Settings -> (Language -> Doc AnsiStyle) -> RIO Env ()
forall (m :: * -> *).
MonadIO m =>
Settings -> (Language -> Doc AnsiStyle) -> m ()
warn Settings
ss Language -> Doc AnsiStyle
install_2
    else do
      let (Set PkgName
ignored, Set PkgName
notIgnored) = (PkgName -> Bool) -> Set PkgName -> (Set PkgName, Set PkgName)
forall a. (a -> Bool) -> Set a -> (Set a, Set a)
S.partition (PkgName -> Set PkgName -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Settings -> Set PkgName
ignoresOf Settings
ss) Set PkgName
pkgs'
      Set PkgName
installAnyway <- Set PkgName -> RIO Env (Set PkgName)
confirmIgnored Set PkgName
ignored
      case Set PkgName -> Maybe (NonEmpty PkgName)
forall a. Set a -> Maybe (NonEmpty a)
nes (Set PkgName -> Maybe (NonEmpty PkgName))
-> Set PkgName -> Maybe (NonEmpty PkgName)
forall a b. (a -> b) -> a -> b
$ (Set PkgName
notIgnored Set PkgName -> Set PkgName -> Set PkgName
forall a. Semigroup a => a -> a -> a
<> Set PkgName
installAnyway) Set PkgName -> Set PkgName -> Set PkgName
forall a. Ord a => Set a -> Set a -> Set a
S.\\ Set PkgName
unneeded of
        Maybe (NonEmpty PkgName)
Nothing        -> Settings -> (Language -> Doc AnsiStyle) -> RIO Env ()
forall (m :: * -> *).
MonadIO m =>
Settings -> (Language -> Doc AnsiStyle) -> m ()
warn Settings
ss Language -> Doc AnsiStyle
install_2
        Just NonEmpty PkgName
toInstall -> do
          (NonEmpty PkgName -> RIO Env ())
-> Maybe (NonEmpty PkgName) -> RIO Env ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Doc AnsiStyle -> Doc AnsiStyle)
-> (Language -> Doc AnsiStyle) -> NonEmpty PkgName -> RIO Env ()
report Doc AnsiStyle -> Doc AnsiStyle
yellow Language -> Doc AnsiStyle
reportUnneededPackages_1) (Maybe (NonEmpty PkgName) -> RIO Env ())
-> ([PkgName] -> Maybe (NonEmpty PkgName))
-> [PkgName]
-> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PkgName] -> Maybe (NonEmpty PkgName)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty
            ([PkgName] -> RIO Env ()) -> [PkgName] -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ Set PkgName -> [PkgName]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set PkgName
unneeded
          (Set PkgName
nons, Set Buildable
toBuild) <- Failure
-> RIO Env (Maybe (Set PkgName, Set Buildable))
-> RIO Env (Set PkgName, Set Buildable)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> m (Maybe a) -> m a
liftMaybeM (FailMsg -> Failure
Failure (FailMsg -> Failure) -> FailMsg -> Failure
forall a b. (a -> b) -> a -> b
$ (Language -> Doc AnsiStyle) -> FailMsg
FailMsg Language -> Doc AnsiStyle
connectFailure_1) (RIO Env (Maybe (Set PkgName, Set Buildable))
 -> RIO Env (Set PkgName, Set Buildable))
-> (IO (Maybe (Set PkgName, Set Buildable))
    -> RIO Env (Maybe (Set PkgName, Set Buildable)))
-> IO (Maybe (Set PkgName, Set Buildable))
-> RIO Env (Set PkgName, Set Buildable)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe (Set PkgName, Set Buildable))
-> RIO Env (Maybe (Set PkgName, Set Buildable))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
            (IO (Maybe (Set PkgName, Set Buildable))
 -> RIO Env (Set PkgName, Set Buildable))
-> IO (Maybe (Set PkgName, Set Buildable))
-> RIO Env (Set PkgName, Set Buildable)
forall a b. (a -> b) -> a -> b
$ Manager
-> NonEmpty PkgName -> IO (Maybe (Set PkgName, Set Buildable))
aurLookup (Settings -> Manager
managerOf Settings
ss) NonEmpty PkgName
toInstall
          Set Buildable -> RIO Env ()
pkgbuildDiffs Set Buildable
toBuild
          (NonEmpty PkgName -> RIO Env ())
-> Maybe (NonEmpty PkgName) -> RIO Env ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Doc AnsiStyle -> Doc AnsiStyle)
-> (Language -> Doc AnsiStyle) -> NonEmpty PkgName -> RIO Env ()
report Doc AnsiStyle -> Doc AnsiStyle
red Language -> Doc AnsiStyle
reportNonPackages_1) (Maybe (NonEmpty PkgName) -> RIO Env ())
-> ([PkgName] -> Maybe (NonEmpty PkgName))
-> [PkgName]
-> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PkgName] -> Maybe (NonEmpty PkgName)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty ([PkgName] -> RIO Env ()) -> [PkgName] -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ Set PkgName -> [PkgName]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set PkgName
nons
          let !explicits :: Set Buildable
explicits = Set Buildable -> Set Buildable -> Bool -> Set Buildable
forall a. a -> a -> Bool -> a
bool ((Buildable -> Buildable) -> Set Buildable -> Set Buildable
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (\Buildable
b -> Buildable
b { bIsExplicit :: Bool
bIsExplicit = Bool
True }) Set Buildable
toBuild) Set Buildable
toBuild
                (Bool -> Set Buildable) -> Bool -> Set Buildable
forall a b. (a -> b) -> a -> b
$ Settings -> BuildSwitch -> Bool
switch Settings
ss BuildSwitch
AsDeps
          case Set Buildable -> Maybe (NonEmpty Buildable)
forall a. Set a -> Maybe (NonEmpty a)
nes Set Buildable
explicits of
            Maybe (NonEmpty Buildable)
Nothing       -> Failure -> RIO Env ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Failure -> RIO Env ())
-> (FailMsg -> Failure) -> FailMsg -> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailMsg -> Failure
Failure (FailMsg -> RIO Env ()) -> FailMsg -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ (Language -> Doc AnsiStyle) -> FailMsg
FailMsg Language -> Doc AnsiStyle
install_2
            Just NonEmpty Buildable
toBuild' -> do
              Settings -> (Language -> Doc AnsiStyle) -> RIO Env ()
forall (m :: * -> *).
MonadIO m =>
Settings -> (Language -> Doc AnsiStyle) -> m ()
notify Settings
ss Language -> Doc AnsiStyle
install_5 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
              NonEmpty (NonEmpty Package)
allPkgs <- if Settings -> BuildSwitch -> Bool
switch Settings
ss BuildSwitch
SkipDepCheck
                           then NonEmpty (NonEmpty Package)
-> RIO Env (NonEmpty (NonEmpty Package))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty (NonEmpty Package)
 -> RIO Env (NonEmpty (NonEmpty Package)))
-> (NonEmpty Package -> NonEmpty (NonEmpty Package))
-> NonEmpty Package
-> RIO Env (NonEmpty (NonEmpty Package))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty Package
-> [NonEmpty Package] -> NonEmpty (NonEmpty Package)
forall a. a -> [a] -> NonEmpty a
:| []) (NonEmpty Package -> RIO Env (NonEmpty (NonEmpty Package)))
-> NonEmpty Package -> RIO Env (NonEmpty (NonEmpty Package))
forall a b. (a -> b) -> a -> b
$ (Buildable -> Package) -> NonEmpty Buildable -> NonEmpty Package
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NEL.map Buildable -> Package
FromAUR NonEmpty Buildable
toBuild'
                           else Repository
-> NonEmpty Buildable -> RIO Env (NonEmpty (NonEmpty Package))
depsToInstall Repository
rpstry NonEmpty Buildable
toBuild'
              let ([Prebuilt]
repoPkgs, [NonEmpty Buildable]
buildPkgs) = ([NonEmpty Buildable] -> [NonEmpty Buildable])
-> ([Prebuilt], [NonEmpty Buildable])
-> ([Prebuilt], [NonEmpty Buildable])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [NonEmpty Buildable] -> [NonEmpty Buildable]
uniquePkgBase (([Prebuilt], [NonEmpty Buildable])
 -> ([Prebuilt], [NonEmpty Buildable]))
-> ([Prebuilt], [NonEmpty Buildable])
-> ([Prebuilt], [NonEmpty Buildable])
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty Package) -> ([Prebuilt], [NonEmpty Buildable])
partitionPkgs NonEmpty (NonEmpty Package)
allPkgs
              Bool -> RIO Env () -> RIO Env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Settings -> BuildSwitch -> Bool
switch Settings
ss BuildSwitch
NoPkgbuildCheck)
                (RIO Env () -> RIO Env ()) -> RIO Env () -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ (NonEmpty Buildable -> RIO Env ())
-> [NonEmpty Buildable] -> RIO Env ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Buildable -> RIO Env ()) -> NonEmpty Buildable -> RIO Env ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Buildable -> RIO Env ()
analysePkgbuild) [NonEmpty Buildable]
buildPkgs
              [Prebuilt] -> [NonEmpty Buildable] -> RIO Env ()
reportPkgsToInstall [Prebuilt]
repoPkgs [NonEmpty Buildable]
buildPkgs
              Bool -> RIO Env () -> RIO Env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Settings -> BuildSwitch -> Bool
switch Settings
ss BuildSwitch
DryRun) (RIO Env () -> RIO Env ())
-> (RIO Env () -> RIO Env ()) -> RIO Env () -> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings
-> (Language -> Doc AnsiStyle)
-> (Language -> Doc AnsiStyle)
-> RIO Env ()
-> RIO Env ()
forall e a.
Settings
-> (Language -> Doc AnsiStyle)
-> (Language -> Doc AnsiStyle)
-> RIO e a
-> RIO e a
withOkay Settings
ss Language -> Doc AnsiStyle
install_3 Language -> Doc AnsiStyle
install_4 (RIO Env () -> RIO Env ()) -> RIO Env () -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ do
                (NonEmpty Prebuilt -> RIO Env ())
-> Maybe (NonEmpty Prebuilt) -> RIO Env ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ NonEmpty Prebuilt -> RIO Env ()
repoInstall (Maybe (NonEmpty Prebuilt) -> RIO Env ())
-> Maybe (NonEmpty Prebuilt) -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ [Prebuilt] -> Maybe (NonEmpty Prebuilt)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty [Prebuilt]
repoPkgs
                let !mbuildPkgs :: Maybe (NonEmpty (NonEmpty Buildable))
mbuildPkgs = [NonEmpty Buildable] -> Maybe (NonEmpty (NonEmpty Buildable))
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty [NonEmpty Buildable]
buildPkgs
                (NonEmpty (NonEmpty Buildable) -> RIO Env ())
-> Maybe (NonEmpty (NonEmpty Buildable)) -> RIO Env ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IO () -> RIO Env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO Env ())
-> (NonEmpty (NonEmpty Buildable) -> IO ())
-> NonEmpty (NonEmpty Buildable)
-> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Buildable -> IO ()
storePkgbuilds (NonEmpty Buildable -> IO ())
-> (NonEmpty (NonEmpty Buildable) -> NonEmpty Buildable)
-> NonEmpty (NonEmpty Buildable)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (NonEmpty Buildable) -> NonEmpty Buildable
forall m. Semigroup m => NonEmpty m -> m
fold1) Maybe (NonEmpty (NonEmpty Buildable))
mbuildPkgs
                (NonEmpty (NonEmpty Buildable) -> RIO Env ())
-> Maybe (NonEmpty (NonEmpty Buildable)) -> RIO Env ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ NonEmpty (NonEmpty Buildable) -> RIO Env ()
buildAndInstall Maybe (NonEmpty (NonEmpty Buildable))
mbuildPkgs

-- | Give anything that was installed as a dependency the /Install Reason/ of
-- "Installed as a dependency for another package".
annotateDeps :: Environment -> NonEmpty Buildable -> IO ()
annotateDeps :: Environment -> NonEmpty Buildable -> IO ()
annotateDeps Environment
env NonEmpty Buildable
bs = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Buildable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Buildable]
bs') (IO () -> IO ()) -> ([Text] -> IO ()) -> [Text] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> ([Text] -> IO Bool) -> [Text] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> [Text] -> IO Bool
pacmanSuccess Environment
env
  ([Text] -> IO ()) -> [Text] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Text
"-D", Text
"--asdeps"] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [PkgName] -> [Text]
forall a. Flagable a => a -> [Text]
asFlag ((Buildable -> PkgName) -> [Buildable] -> [PkgName]
forall a b. (a -> b) -> [a] -> [b]
map Buildable -> PkgName
bName [Buildable]
bs')
  where
    bs' :: [Buildable]
    bs' :: [Buildable]
bs' = (Buildable -> Bool) -> NonEmpty Buildable -> [Buildable]
forall a. (a -> Bool) -> NonEmpty a -> [a]
NEL.filter (Bool -> Bool
not (Bool -> Bool) -> (Buildable -> Bool) -> Buildable -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buildable -> Bool
bIsExplicit) NonEmpty Buildable
bs

-- | Reduce a list of candidate packages to build, such that there is only one
-- instance of each "Package Base". This will ensure that split packages will
-- only be built once each. Precedence is given to packages that actually
-- match the base name (e.g. llvm50 vs llvm50-libs).
uniquePkgBase :: [NonEmpty Buildable] -> [NonEmpty Buildable]
uniquePkgBase :: [NonEmpty Buildable] -> [NonEmpty Buildable]
uniquePkgBase [NonEmpty Buildable]
bs = (NonEmpty Buildable -> Maybe (NonEmpty Buildable))
-> [NonEmpty Buildable] -> [NonEmpty Buildable]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe NonEmpty Buildable -> Maybe (NonEmpty Buildable)
g [NonEmpty Buildable]
bs
  where
    bs' :: [Buildable]
    bs' :: [Buildable]
bs' = (NonEmpty Buildable -> [Buildable])
-> [NonEmpty Buildable] -> [Buildable]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap NonEmpty Buildable -> [Buildable]
forall a. NonEmpty a -> [a]
NEL.toList [NonEmpty Buildable]
bs

    g :: NonEmpty Buildable -> Maybe (NonEmpty Buildable)
    g :: NonEmpty Buildable -> Maybe (NonEmpty Buildable)
g = [Buildable] -> Maybe (NonEmpty Buildable)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty ([Buildable] -> Maybe (NonEmpty Buildable))
-> (NonEmpty Buildable -> [Buildable])
-> NonEmpty Buildable
-> Maybe (NonEmpty Buildable)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Buildable] -> [Buildable]
forall a. Ord a => [a] -> [a]
nubOrd ([Buildable] -> [Buildable])
-> (NonEmpty Buildable -> [Buildable])
-> NonEmpty Buildable
-> [Buildable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buildable -> Bool) -> NonEmpty Buildable -> [Buildable]
forall a. (a -> Bool) -> NonEmpty a -> [a]
NEL.filter (\Buildable
b -> Buildable -> PkgName
bName Buildable
b PkgName -> Set PkgName -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set PkgName
goods)

    f :: Buildable -> Buildable -> Buildable
    f :: Buildable -> Buildable -> Buildable
f Buildable
a Buildable
b | Buildable -> PkgName
bName Buildable
a PkgName -> PkgName -> Bool
forall a. Eq a => a -> a -> Bool
== Buildable -> PkgName
bBase Buildable
a = Buildable
a
          | Buildable -> PkgName
bName Buildable
b PkgName -> PkgName -> Bool
forall a. Eq a => a -> a -> Bool
== Buildable -> PkgName
bBase Buildable
b = Buildable
b
          | Bool
otherwise = Buildable
a

    goods :: Set PkgName
    goods :: Set PkgName
goods = [PkgName] -> Set PkgName
forall a. Ord a => [a] -> Set a
S.fromList ([PkgName] -> Set PkgName)
-> ([(PkgName, Buildable)] -> [PkgName])
-> [(PkgName, Buildable)]
-> Set PkgName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buildable -> PkgName) -> [Buildable] -> [PkgName]
forall a b. (a -> b) -> [a] -> [b]
map Buildable -> PkgName
bName ([Buildable] -> [PkgName])
-> ([(PkgName, Buildable)] -> [Buildable])
-> [(PkgName, Buildable)]
-> [PkgName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map PkgName Buildable -> [Buildable]
forall k a. Map k a -> [a]
M.elems (Map PkgName Buildable -> [Buildable])
-> ([(PkgName, Buildable)] -> Map PkgName Buildable)
-> [(PkgName, Buildable)]
-> [Buildable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buildable -> Buildable -> Buildable)
-> [(PkgName, Buildable)] -> Map PkgName Buildable
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith Buildable -> Buildable -> Buildable
f ([(PkgName, Buildable)] -> Set PkgName)
-> [(PkgName, Buildable)] -> Set PkgName
forall a b. (a -> b) -> a -> b
$ (Buildable -> (PkgName, Buildable))
-> [Buildable] -> [(PkgName, Buildable)]
forall a b. (a -> b) -> [a] -> [b]
map (Buildable -> PkgName
bBase (Buildable -> PkgName)
-> (Buildable -> Buildable) -> Buildable -> (PkgName, Buildable)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Buildable -> Buildable
forall a. a -> a
id) [Buildable]
bs'

confirmIgnored :: Set PkgName -> RIO Env (Set PkgName)
confirmIgnored :: Set PkgName -> RIO Env (Set PkgName)
confirmIgnored (Set PkgName -> [PkgName]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList -> [PkgName]
ps) = do
  Settings
ss <- (Env -> Settings) -> RIO Env Settings
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Settings
settings
  [PkgName] -> Set PkgName
forall a. Ord a => [a] -> Set a
S.fromList ([PkgName] -> Set PkgName)
-> RIO Env [PkgName] -> RIO Env (Set PkgName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PkgName -> RIO Env Bool) -> [PkgName] -> RIO Env [PkgName]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (IO Bool -> RIO Env Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> RIO Env Bool)
-> (PkgName -> IO Bool) -> PkgName -> RIO Env Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings -> (Language -> Doc AnsiStyle) -> IO Bool
optionalPrompt Settings
ss ((Language -> Doc AnsiStyle) -> IO Bool)
-> (PkgName -> Language -> Doc AnsiStyle) -> PkgName -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgName -> Language -> Doc AnsiStyle
confirmIgnored_1) [PkgName]
ps

-- | The nested `NonEmpty`s represent the package "hierarchy", namely, what can
-- be built/installed before what.
depsToInstall :: Repository -> NonEmpty Buildable -> RIO Env (NonEmpty (NonEmpty Package))
depsToInstall :: Repository
-> NonEmpty Buildable -> RIO Env (NonEmpty (NonEmpty Package))
depsToInstall Repository
repo NonEmpty Buildable
bs = Repository
-> NonEmpty Package -> RIO Env (NonEmpty (NonEmpty Package))
resolveDeps Repository
repo (NonEmpty Package -> RIO Env (NonEmpty (NonEmpty Package)))
-> NonEmpty Package -> RIO Env (NonEmpty (NonEmpty Package))
forall a b. (a -> b) -> a -> b
$ (Buildable -> Package) -> NonEmpty Buildable -> NonEmpty Package
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NEL.map Buildable -> Package
FromAUR NonEmpty Buildable
bs

repoInstall :: NonEmpty Prebuilt -> RIO Env ()
repoInstall :: NonEmpty Prebuilt -> RIO Env ()
repoInstall NonEmpty Prebuilt
ps = do
  Settings
ss <- (Env -> Settings) -> RIO Env Settings
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Settings
settings
  let !pacOpts :: [Text]
pacOpts = CommonConfig -> [Text]
forall a. Flagable a => a -> [Text]
asFlag (CommonConfig -> [Text]) -> CommonConfig -> [Text]
forall a b. (a -> b) -> a -> b
$ Settings -> CommonConfig
commonConfigOf 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
"-S", Text
"--asdeps"] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
pacOpts [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> NonEmpty PkgName -> [Text]
forall a. Flagable a => a -> [Text]
asFlag ((Prebuilt -> PkgName) -> NonEmpty Prebuilt -> NonEmpty PkgName
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NEL.map Prebuilt -> PkgName
pName NonEmpty Prebuilt
ps)

-- | Try to build and install all packages. Requested packages that already have
-- a version in the cache will not be rebuilt unless `--force` was passed.
buildAndInstall :: NonEmpty (NonEmpty Buildable) -> RIO Env ()
buildAndInstall :: NonEmpty (NonEmpty Buildable) -> RIO Env ()
buildAndInstall NonEmpty (NonEmpty Buildable)
bss = do
  Settings
ss <- (Env -> Settings) -> RIO Env Settings
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Settings
settings
  let !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
      !allsource :: Bool
allsource = 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
  Cache
cache <- IO Cache -> RIO Env Cache
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Cache -> RIO Env Cache) -> IO Cache -> RIO Env Cache
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Cache
cacheContents FilePath
pth
  Bool -> RIO Env () -> RIO Env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
allsource (RIO Env () -> RIO Env ()) -> RIO Env () -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ Settings -> (Language -> Doc AnsiStyle) -> RIO Env ()
forall (m :: * -> *).
MonadIO m =>
Settings -> (Language -> Doc AnsiStyle) -> m ()
notify Settings
ss Language -> Doc AnsiStyle
buildPackages_2
  (NonEmpty Buildable -> RIO Env ())
-> NonEmpty (NonEmpty Buildable) -> RIO Env ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Settings -> Cache -> NonEmpty Buildable -> RIO Env ()
f Settings
ss Cache
cache) NonEmpty (NonEmpty Buildable)
bss
  Bool -> RIO Env () -> RIO Env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
allsource (RIO Env () -> RIO Env ()) -> RIO Env () -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ 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
    Settings -> (Language -> Doc AnsiStyle) -> RIO Env ()
forall (m :: * -> *).
MonadIO m =>
Settings -> (Language -> Doc AnsiStyle) -> m ()
notify Settings
ss ((Language -> Doc AnsiStyle) -> RIO Env ())
-> (Language -> Doc AnsiStyle) -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Language -> Doc AnsiStyle
buildPackages_3 FilePath
allsourcePath
  where
    -- TODO There is a weird edge case (which might be impossible anyway) where
    -- `built` and the `traverse_` line below don't run, but `annotateDeps` is
    -- called anyway. There is definitely a better way to manage the `NonEmpty`s
    -- here.
    f :: Settings -> Cache -> NonEmpty Buildable -> RIO Env ()
    f :: Settings -> Cache -> NonEmpty Buildable -> RIO Env ()
f Settings
ss Cache
cache NonEmpty Buildable
bs = do
      let ([Buildable]
ps, [PackagePath]
cached) = (Buildable -> Either Buildable PackagePath)
-> [Buildable] -> ([Buildable], [PackagePath])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
fmapEither (Settings -> Cache -> Buildable -> Either Buildable PackagePath
g Settings
ss Cache
cache) ([Buildable] -> ([Buildable], [PackagePath]))
-> [Buildable] -> ([Buildable], [PackagePath])
forall a b. (a -> b) -> a -> b
$ NonEmpty Buildable -> [Buildable]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Buildable
bs
      Bool -> RIO Env () -> RIO Env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Settings -> BuildSwitch -> Bool
switch Settings
ss BuildSwitch
HotEdit Bool -> Bool -> Bool
&& Bool -> Bool
not ([PackagePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackagePath]
cached)) (RIO Env () -> RIO Env ()) -> RIO Env () -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ do
        Settings -> (Language -> Doc AnsiStyle) -> RIO Env ()
forall (m :: * -> *).
MonadIO m =>
Settings -> (Language -> Doc AnsiStyle) -> m ()
warn Settings
ss Language -> Doc AnsiStyle
buildPackages_4
        (PackagePath -> RIO Env ()) -> [PackagePath] -> RIO Env ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IO () -> RIO Env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO Env ())
-> (PackagePath -> IO ()) -> PackagePath -> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> IO ()
forall r. PrintfType r => FilePath -> r
printf FilePath
"  - %s\n" (FilePath -> IO ())
-> (PackagePath -> FilePath) -> PackagePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeFileName (FilePath -> FilePath)
-> (PackagePath -> FilePath) -> PackagePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackagePath -> FilePath
ppPath) [PackagePath]
cached
        Settings -> (Language -> Doc AnsiStyle) -> RIO Env ()
forall (m :: * -> *).
MonadIO m =>
Settings -> (Language -> Doc AnsiStyle) -> m ()
warn Settings
ss Language -> Doc AnsiStyle
buildPackages_5
      Maybe [PackagePath]
built <- (NonEmpty Buildable -> RIO Env [PackagePath])
-> Maybe (NonEmpty Buildable) -> RIO Env (Maybe [PackagePath])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse NonEmpty Buildable -> RIO Env [PackagePath]
buildPackages (Maybe (NonEmpty Buildable) -> RIO Env (Maybe [PackagePath]))
-> Maybe (NonEmpty Buildable) -> RIO Env (Maybe [PackagePath])
forall a b. (a -> b) -> a -> b
$ [Buildable] -> Maybe (NonEmpty Buildable)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty [Buildable]
ps
      (NonEmpty PackagePath -> RIO Env ())
-> Maybe (NonEmpty PackagePath) -> RIO Env ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ NonEmpty PackagePath -> RIO Env ()
installPkgFiles (Maybe (NonEmpty PackagePath) -> RIO Env ())
-> Maybe (NonEmpty PackagePath) -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ (Maybe [PackagePath]
built Maybe [PackagePath] -> Maybe [PackagePath] -> Maybe [PackagePath]
forall a. Semigroup a => a -> a -> a
<> [PackagePath] -> Maybe [PackagePath]
forall a. a -> Maybe a
Just [PackagePath]
cached) Maybe [PackagePath]
-> ([PackagePath] -> Maybe (NonEmpty PackagePath))
-> Maybe (NonEmpty PackagePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [PackagePath] -> Maybe (NonEmpty PackagePath)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty
      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
$ Environment -> NonEmpty Buildable -> IO ()
annotateDeps (Settings -> Environment
envOf Settings
ss) NonEmpty Buildable
bs

    -- | If we used @--force@, then take the package as-is. Otherwise, try
    -- to look it up in the package cache. If we find a match, we don't
    -- need to build it.
    g :: Settings -> Cache -> Buildable -> Either Buildable PackagePath
    g :: Settings -> Cache -> Buildable -> Either Buildable PackagePath
g Settings
ss (Cache Map SimplePkg PackagePath
cache) Buildable
b = case Buildable -> SimplePkg
bToSP Buildable
b SimplePkg -> Map SimplePkg PackagePath -> Maybe PackagePath
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map SimplePkg PackagePath
cache of
      Just PackagePath
pp | Bool -> Bool
not (Settings -> BuildSwitch -> Bool
switch Settings
ss BuildSwitch
ForceBuilding) -> PackagePath -> Either Buildable PackagePath
forall a b. b -> Either a b
Right PackagePath
pp
      Maybe PackagePath
_                                       -> Buildable -> Either Buildable PackagePath
forall a b. a -> Either a b
Left Buildable
b


------------
-- REPORTING
------------
-- | Display dependencies. The result of @-Ad@.
displayPkgDeps :: NonEmpty PkgName -> RIO Env ()
displayPkgDeps :: NonEmpty PkgName -> RIO Env ()
displayPkgDeps NonEmpty PkgName
ps = do
  Utf8Builder -> RIO Env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"-Ad: Checking dependencies."
  Repository
rpstry <- (Env -> Repository) -> RIO Env Repository
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Repository
repository
  Settings
ss <- (Env -> Settings) -> RIO Env Settings
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Settings
settings

  let f :: NonEmpty Buildable -> RIO Env ()
      f :: NonEmpty Buildable -> RIO Env ()
f = Repository
-> NonEmpty Buildable -> RIO Env (NonEmpty (NonEmpty Package))
depsToInstall Repository
rpstry (NonEmpty Buildable -> RIO Env (NonEmpty (NonEmpty Package)))
-> (NonEmpty (NonEmpty Package) -> RIO Env ())
-> NonEmpty Buildable
-> RIO Env ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Bool -> ([Prebuilt], [NonEmpty Buildable]) -> RIO Env ()
reportDeps (Settings -> BuildSwitch -> Bool
switch Settings
ss BuildSwitch
LowVerbosity) (([Prebuilt], [NonEmpty Buildable]) -> RIO Env ())
-> (NonEmpty (NonEmpty Package)
    -> ([Prebuilt], [NonEmpty Buildable]))
-> NonEmpty (NonEmpty Package)
-> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (NonEmpty Package) -> ([Prebuilt], [NonEmpty Buildable])
partitionPkgs

  IO (Maybe (Set PkgName, Set Buildable))
-> RIO Env (Maybe (Set PkgName, Set Buildable))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Manager
-> NonEmpty PkgName -> IO (Maybe (Set PkgName, Set Buildable))
aurLookup (Settings -> Manager
managerOf Settings
ss) NonEmpty PkgName
ps) RIO Env (Maybe (Set PkgName, Set Buildable))
-> (Maybe (Set PkgName, Set Buildable) -> RIO Env ()) -> RIO Env ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (Set PkgName, Set Buildable)
Nothing -> do
      Utf8Builder -> RIO Env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"-Ad: Receiving `Nothing` from `aurLookup`."
      Failure -> RIO Env ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Failure -> RIO Env ())
-> (FailMsg -> Failure) -> FailMsg -> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailMsg -> Failure
Failure (FailMsg -> RIO Env ()) -> FailMsg -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ (Language -> Doc AnsiStyle) -> FailMsg
FailMsg Language -> Doc AnsiStyle
connectFailure_1
    Just (Set PkgName
_, Set Buildable
goods) -> do
      Utf8Builder -> RIO Env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"-Ad: Initial AUR lookup successful."
      (NonEmpty Buildable -> RIO Env ())
-> Maybe (NonEmpty Buildable) -> RIO Env ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ NonEmpty Buildable -> RIO Env ()
f (Maybe (NonEmpty Buildable) -> RIO Env ())
-> Maybe (NonEmpty Buildable) -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ Set Buildable -> Maybe (NonEmpty Buildable)
forall a. Set a -> Maybe (NonEmpty a)
nes Set Buildable
goods
  where
    reportDeps :: Bool -> ([Prebuilt], [NonEmpty Buildable]) -> RIO Env ()
    reportDeps :: Bool -> ([Prebuilt], [NonEmpty Buildable]) -> RIO Env ()
reportDeps Bool
True  = IO () -> RIO Env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO Env ())
-> (([Prebuilt], [NonEmpty Buildable]) -> IO ())
-> ([Prebuilt], [NonEmpty Buildable])
-> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Prebuilt] -> [NonEmpty Buildable] -> IO ())
-> ([Prebuilt], [NonEmpty Buildable]) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Prebuilt] -> [NonEmpty Buildable] -> IO ()
reportListOfDeps
    reportDeps Bool
False = ([Prebuilt] -> [NonEmpty Buildable] -> RIO Env ())
-> ([Prebuilt], [NonEmpty Buildable]) -> RIO Env ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Prebuilt] -> [NonEmpty Buildable] -> RIO Env ()
reportPkgsToInstall

reportPkgsToInstall :: [Prebuilt] -> [NonEmpty Buildable] -> RIO Env ()
reportPkgsToInstall :: [Prebuilt] -> [NonEmpty Buildable] -> RIO Env ()
reportPkgsToInstall [Prebuilt]
rps [NonEmpty Buildable]
bps = do
  let ([Buildable]
explicits, [Buildable]
ds) = (Buildable -> Bool) -> [Buildable] -> ([Buildable], [Buildable])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition Buildable -> Bool
bIsExplicit ([Buildable] -> ([Buildable], [Buildable]))
-> [Buildable] -> ([Buildable], [Buildable])
forall a b. (a -> b) -> a -> b
$ (NonEmpty Buildable -> [Buildable])
-> [NonEmpty Buildable] -> [Buildable]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap NonEmpty Buildable -> [Buildable]
forall a. NonEmpty a -> [a]
NEL.toList [NonEmpty Buildable]
bps
  (Language -> Doc AnsiStyle) -> [PkgName] -> RIO Env ()
f Language -> Doc AnsiStyle
reportPkgsToInstall_1 ([PkgName] -> RIO Env ()) -> [PkgName] -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ (Prebuilt -> PkgName) -> [Prebuilt] -> [PkgName]
forall a b. (a -> b) -> [a] -> [b]
map Prebuilt -> PkgName
pName [Prebuilt]
rps
  (Language -> Doc AnsiStyle) -> [PkgName] -> RIO Env ()
f Language -> Doc AnsiStyle
reportPkgsToInstall_3 ([PkgName] -> RIO Env ()) -> [PkgName] -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ (Buildable -> PkgName) -> [Buildable] -> [PkgName]
forall a b. (a -> b) -> [a] -> [b]
map Buildable -> PkgName
bName [Buildable]
ds
  (Language -> Doc AnsiStyle) -> [PkgName] -> RIO Env ()
f Language -> Doc AnsiStyle
reportPkgsToInstall_2 ([PkgName] -> RIO Env ()) -> [PkgName] -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ (Buildable -> PkgName) -> [Buildable] -> [PkgName]
forall a b. (a -> b) -> [a] -> [b]
map Buildable -> PkgName
bName [Buildable]
explicits
  where
    f :: (Language -> Doc AnsiStyle) -> [PkgName] -> RIO Env ()
    f :: (Language -> Doc AnsiStyle) -> [PkgName] -> RIO Env ()
f Language -> Doc AnsiStyle
m [PkgName]
xs = (NonEmpty PkgName -> RIO Env ())
-> Maybe (NonEmpty PkgName) -> RIO Env ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Doc AnsiStyle -> Doc AnsiStyle)
-> (Language -> Doc AnsiStyle) -> NonEmpty PkgName -> RIO Env ()
report Doc AnsiStyle -> Doc AnsiStyle
green Language -> Doc AnsiStyle
m) (Maybe (NonEmpty PkgName) -> RIO Env ())
-> ([PkgName] -> Maybe (NonEmpty PkgName))
-> [PkgName]
-> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PkgName] -> Maybe (NonEmpty PkgName)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty ([PkgName] -> RIO Env ()) -> [PkgName] -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ [PkgName] -> [PkgName]
forall a. Ord a => [a] -> [a]
L.sort [PkgName]
xs

reportListOfDeps :: [Prebuilt] -> [NonEmpty Buildable] -> IO ()
reportListOfDeps :: [Prebuilt] -> [NonEmpty Buildable] -> IO ()
reportListOfDeps [Prebuilt]
rps [NonEmpty Buildable]
bps = [PkgName] -> IO ()
f ((Prebuilt -> PkgName) -> [Prebuilt] -> [PkgName]
forall a b. (a -> b) -> [a] -> [b]
map Prebuilt -> PkgName
pName [Prebuilt]
rps) IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [PkgName] -> IO ()
f ((Buildable -> PkgName) -> [Buildable] -> [PkgName]
forall a b. (a -> b) -> [a] -> [b]
map Buildable -> PkgName
bName ([Buildable] -> [PkgName]) -> [Buildable] -> [PkgName]
forall a b. (a -> b) -> a -> b
$ (NonEmpty Buildable -> [Buildable])
-> [NonEmpty Buildable] -> [Buildable]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap NonEmpty Buildable -> [Buildable]
forall a. NonEmpty a -> [a]
NEL.toList [NonEmpty Buildable]
bps)
  where
    f :: [PkgName] -> IO ()
    f :: [PkgName] -> IO ()
f = (Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn ([Text] -> IO ()) -> ([PkgName] -> [Text]) -> [PkgName] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. Ord a => [a] -> [a]
L.sort ([Text] -> [Text]) -> ([PkgName] -> [Text]) -> [PkgName] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PkgName -> Text) -> [PkgName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map PkgName -> Text
pnName

pkgbuildDiffs :: Set Buildable -> RIO Env ()
pkgbuildDiffs :: Set Buildable -> RIO Env ()
pkgbuildDiffs Set Buildable
ps = (Env -> Settings) -> RIO Env Settings
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Settings
settings RIO Env Settings -> (Settings -> RIO Env ()) -> RIO Env ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Settings -> RIO Env ()
check
  where
    check :: Settings -> RIO Env ()
    check :: Settings -> RIO Env ()
check Settings
ss | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Settings -> BuildSwitch -> Bool
switch Settings
ss BuildSwitch
DiffPkgbuilds = () -> RIO Env ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
             | Bool
otherwise = (Buildable -> RIO Env ()) -> Set Buildable -> RIO Env ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Buildable -> RIO Env ()
displayDiff Set Buildable
ps

    displayDiff :: Buildable -> RIO Env ()
    displayDiff :: Buildable -> RIO Env ()
displayDiff Buildable
p = do
      Settings
ss <- (Env -> Settings) -> RIO Env Settings
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Settings
settings
      let pn :: PkgName
pn = Buildable -> PkgName
bName Buildable
p
      Bool
isStored <- IO Bool -> RIO Env Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> RIO Env Bool) -> IO Bool -> RIO Env Bool
forall a b. (a -> b) -> a -> b
$ PkgName -> IO Bool
hasPkgbuildStored PkgName
pn
      if Bool -> Bool
not Bool
isStored
        then Settings -> (Language -> Doc AnsiStyle) -> RIO Env ()
forall (m :: * -> *).
MonadIO m =>
Settings -> (Language -> Doc AnsiStyle) -> m ()
warn Settings
ss ((Language -> Doc AnsiStyle) -> RIO Env ())
-> (Language -> Doc AnsiStyle) -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ PkgName -> Language -> Doc AnsiStyle
reportPkgbuildDiffs_1 PkgName
pn
        else 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
$ do
          FilePath -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
setCurrentDirectory FilePath
"/tmp"
          let new :: FilePath
new = FilePath
"/tmp/new.pb"
          FilePath -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> ByteString -> m ()
writeFileBinary FilePath
new (ByteString -> IO ())
-> (Pkgbuild -> ByteString) -> Pkgbuild -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkgbuild -> ByteString
pkgbuild (Pkgbuild -> IO ()) -> Pkgbuild -> IO ()
forall a b. (a -> b) -> a -> b
$ Buildable -> Pkgbuild
bPkgbuild Buildable
p
          Settings -> (Language -> Doc AnsiStyle) -> IO ()
forall (m :: * -> *).
MonadIO m =>
Settings -> (Language -> Doc AnsiStyle) -> m ()
warn Settings
ss ((Language -> Doc AnsiStyle) -> IO ())
-> (Language -> Doc AnsiStyle) -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgName -> Language -> Doc AnsiStyle
reportPkgbuildDiffs_3 PkgName
pn
          Settings -> FilePath -> FilePath -> IO ()
forall (m :: * -> *).
MonadIO m =>
Settings -> FilePath -> FilePath -> m ()
diff Settings
ss (PkgName -> FilePath
pkgbuildPath PkgName
pn) FilePath
new