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

-- |
-- Module    : Aura.Packages.AUR
-- Copyright : (c) Colin Woodbury, 2012 - 2021
-- License   : GPL3
-- Maintainer: Colin Woodbury <colin@fosskers.ca>
--
-- Module for connecting to the AUR servers, downloading PKGBUILDs and package
-- sources.

module Aura.Packages.AUR
  ( -- * Batch Querying
    aurLookup
  , aurRepo
    -- * Single Querying
  , aurInfo
  , aurSearch
  , sortAurInfo
    -- * Source Retrieval
  , clone
  , pkgUrl
  ) where

import           Aura.Core
import           Aura.Languages
import           Aura.Pkgbuild.Fetch
import           Aura.Settings
import           Aura.Types
import           Aura.Utils
import           Control.Monad.Trans.Maybe
import           Control.Scheduler (Comp(..), traverseConcurrently)
import           Data.Versions (versioning)
import           Linux.Arch.Aur
import           Network.HTTP.Client (Manager)
import           RIO
import           RIO.Directory
import           RIO.FilePath
import           RIO.Lens (each, non)
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 qualified RIO.Text as T
import           System.Process.Typed

---

-- | Attempt to retrieve info about a given `Set` of packages from the AUR.
aurLookup :: Manager -> NonEmpty PkgName -> IO (Maybe (Set PkgName, Set Buildable))
aurLookup :: Manager
-> NonEmpty PkgName -> IO (Maybe (Set PkgName, Set Buildable))
aurLookup Manager
m NonEmpty PkgName
names = MaybeT IO (Set PkgName, Set Buildable)
-> IO (Maybe (Set PkgName, Set Buildable))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO (Set PkgName, Set Buildable)
 -> IO (Maybe (Set PkgName, Set Buildable)))
-> MaybeT IO (Set PkgName, Set Buildable)
-> IO (Maybe (Set PkgName, Set Buildable))
forall a b. (a -> b) -> a -> b
$ do
  [AurInfo]
infos <- IO (Maybe [AurInfo]) -> MaybeT IO [AurInfo]
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe [AurInfo]) -> MaybeT IO [AurInfo])
-> ([Text] -> IO (Maybe [AurInfo]))
-> [Text]
-> MaybeT IO [AurInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either AurError [AurInfo] -> Maybe [AurInfo])
-> IO (Either AurError [AurInfo]) -> IO (Maybe [AurInfo])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either AurError [AurInfo] -> Maybe [AurInfo]
forall a b. Either a b -> Maybe b
hush (IO (Either AurError [AurInfo]) -> IO (Maybe [AurInfo]))
-> ([Text] -> IO (Either AurError [AurInfo]))
-> [Text]
-> IO (Maybe [AurInfo])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Manager -> [Text] -> IO (Either AurError [AurInfo])
info Manager
m ([Text] -> MaybeT IO [AurInfo]) -> [Text] -> MaybeT IO [AurInfo]
forall a b. (a -> b) -> a -> b
$ (PkgName -> [Text] -> [Text])
-> [Text] -> NonEmpty PkgName -> [Text]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(PkgName Text
pn) [Text]
acc -> Text
pn Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc) [] NonEmpty PkgName
names
  [Either PkgName Buildable]
badsgoods <- IO [Either PkgName Buildable]
-> MaybeT IO [Either PkgName Buildable]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO [Either PkgName Buildable]
 -> MaybeT IO [Either PkgName Buildable])
-> IO [Either PkgName Buildable]
-> MaybeT IO [Either PkgName Buildable]
forall a b. (a -> b) -> a -> b
$ Comp
-> (AurInfo -> IO (Either PkgName Buildable))
-> [AurInfo]
-> IO [Either PkgName Buildable]
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
Comp -> (a -> m b) -> t a -> m (t b)
traverseConcurrently Comp
Par' (Manager -> AurInfo -> IO (Either PkgName Buildable)
buildable Manager
m) [AurInfo]
infos
  let ([PkgName]
bads, [Buildable]
goods) = [Either PkgName Buildable] -> ([PkgName], [Buildable])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either PkgName Buildable]
badsgoods
      goodNames :: Set PkgName
goodNames     = [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
$ [Buildable]
goods [Buildable]
-> Getting (Endo [PkgName]) [Buildable] PkgName -> [PkgName]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Buildable -> Const (Endo [PkgName]) Buildable)
-> [Buildable] -> Const (Endo [PkgName]) [Buildable]
forall s t a b. Each s t a b => Traversal s t a b
each ((Buildable -> Const (Endo [PkgName]) Buildable)
 -> [Buildable] -> Const (Endo [PkgName]) [Buildable])
-> ((PkgName -> Const (Endo [PkgName]) PkgName)
    -> Buildable -> Const (Endo [PkgName]) Buildable)
-> Getting (Endo [PkgName]) [Buildable] PkgName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buildable -> PkgName) -> SimpleGetter Buildable PkgName
forall s a. (s -> a) -> SimpleGetter s a
to Buildable -> PkgName
bName
  (Set PkgName, Set Buildable)
-> MaybeT IO (Set PkgName, Set Buildable)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([PkgName] -> Set PkgName
forall a. Ord a => [a] -> Set a
S.fromList [PkgName]
bads Set PkgName -> Set PkgName -> Set PkgName
forall a. Semigroup a => a -> a -> a
<> [PkgName] -> Set PkgName
forall a. Ord a => [a] -> Set a
S.fromList (NonEmpty PkgName -> [PkgName]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty PkgName
names) Set PkgName -> Set PkgName -> Set PkgName
forall a. Ord a => Set a -> Set a -> Set a
S.\\ Set PkgName
goodNames, [Buildable] -> Set Buildable
forall a. Ord a => [a] -> Set a
S.fromList [Buildable]
goods)

-- | Yield fully realized `Package`s from the AUR.
aurRepo :: IO Repository
aurRepo :: IO Repository
aurRepo = do
  TVar (Map PkgName Package)
tv <- Map PkgName Package -> IO (TVar (Map PkgName Package))
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Map PkgName Package
forall a. Monoid a => a
mempty

  -- TODO Use `data-or` here to offer `Or (NESet PkgName) (NESet Package)`?
  -- Yes that sounds like a good idea :)
  let f :: Settings -> NonEmpty PkgName -> IO (Maybe (Set PkgName, Set Package))
      f :: Settings
-> NonEmpty PkgName -> IO (Maybe (Set PkgName, Set Package))
f Settings
ss NonEmpty PkgName
ps = do
        --- Retrieve cached Packages ---
        Map PkgName Package
cache <- TVar (Map PkgName Package) -> IO (Map PkgName Package)
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Map PkgName Package)
tv
        let ([PkgName]
uncached, [Package]
cached) = (PkgName -> Either PkgName Package)
-> [PkgName] -> ([PkgName], [Package])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
fmapEither (\PkgName
p -> PkgName -> Maybe Package -> Either PkgName Package
forall a b. a -> Maybe b -> Either a b
note PkgName
p (Maybe Package -> Either PkgName Package)
-> Maybe Package -> Either PkgName Package
forall a b. (a -> b) -> a -> b
$ PkgName -> Map PkgName Package -> Maybe Package
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PkgName
p Map PkgName Package
cache) ([PkgName] -> ([PkgName], [Package]))
-> [PkgName] -> ([PkgName], [Package])
forall a b. (a -> b) -> a -> b
$ NonEmpty PkgName -> [PkgName]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty PkgName
ps
        --- Lookup uncached Packages ---
        case [PkgName] -> Maybe (NonEmpty PkgName)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty [PkgName]
uncached of
          Maybe (NonEmpty PkgName)
Nothing -> Maybe (Set PkgName, Set Package)
-> IO (Maybe (Set PkgName, Set Package))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Set PkgName, Set Package)
 -> IO (Maybe (Set PkgName, Set Package)))
-> Maybe (Set PkgName, Set Package)
-> IO (Maybe (Set PkgName, Set Package))
forall a b. (a -> b) -> a -> b
$ (Set PkgName, Set Package) -> Maybe (Set PkgName, Set Package)
forall a. a -> Maybe a
Just (Set PkgName
forall a. Set a
S.empty, [Package] -> Set Package
forall a. Ord a => [a] -> Set a
S.fromList [Package]
cached)
          Just NonEmpty PkgName
uncached' -> MaybeT IO (Set PkgName, Set Package)
-> IO (Maybe (Set PkgName, Set Package))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO (Set PkgName, Set Package)
 -> IO (Maybe (Set PkgName, Set Package)))
-> MaybeT IO (Set PkgName, Set Package)
-> IO (Maybe (Set PkgName, Set Package))
forall a b. (a -> b) -> a -> b
$ do
            (Set PkgName
bads, Set Buildable
goods) <- IO (Maybe (Set PkgName, Set Buildable))
-> MaybeT IO (Set PkgName, Set Buildable)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe (Set PkgName, Set Buildable))
 -> MaybeT IO (Set PkgName, Set Buildable))
-> IO (Maybe (Set PkgName, Set Buildable))
-> MaybeT IO (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
uncached'
            let !pkgs :: [Package]
pkgs = (Buildable -> Package) -> [Buildable] -> [Package]
forall a b. (a -> b) -> [a] -> [b]
map Buildable -> Package
FromAUR ([Buildable] -> [Package]) -> [Buildable] -> [Package]
forall a b. (a -> b) -> a -> b
$ Set Buildable -> [Buildable]
forall a. Set a -> [a]
S.toList Set Buildable
goods
            --- Update Cache ---
            let m :: Map PkgName Package
m = [(PkgName, Package)] -> Map PkgName Package
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(PkgName, Package)] -> Map PkgName Package)
-> [(PkgName, Package)] -> Map PkgName Package
forall a b. (a -> b) -> a -> b
$ (Package -> (PkgName, Package))
-> [Package] -> [(PkgName, Package)]
forall a b. (a -> b) -> [a] -> [b]
map (Package -> PkgName
pname (Package -> PkgName)
-> (Package -> Package) -> Package -> (PkgName, Package)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Package -> Package
forall a. a -> a
id) [Package]
pkgs
            IO () -> MaybeT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT IO ())
-> (STM () -> IO ()) -> STM () -> MaybeT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> MaybeT IO ()) -> STM () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ TVar (Map PkgName Package)
-> (Map PkgName Package -> Map PkgName Package) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar (Map PkgName Package)
tv (Map PkgName Package -> Map PkgName Package -> Map PkgName Package
forall a. Semigroup a => a -> a -> a
<> Map PkgName Package
m)
            (Set PkgName, Set Package) -> MaybeT IO (Set PkgName, Set Package)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set PkgName
bads, [Package] -> Set Package
forall a. Ord a => [a] -> Set a
S.fromList ([Package] -> Set Package) -> [Package] -> Set Package
forall a b. (a -> b) -> a -> b
$ [Package]
cached [Package] -> [Package] -> [Package]
forall a. Semigroup a => a -> a -> a
<> [Package]
pkgs)

  Repository -> IO Repository
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Repository -> IO Repository) -> Repository -> IO Repository
forall a b. (a -> b) -> a -> b
$ TVar (Map PkgName Package)
-> (Settings
    -> NonEmpty PkgName -> IO (Maybe (Set PkgName, Set Package)))
-> Repository
Repository TVar (Map PkgName Package)
tv Settings
-> NonEmpty PkgName -> IO (Maybe (Set PkgName, Set Package))
f

buildable :: Manager -> AurInfo -> IO (Either PkgName Buildable)
buildable :: Manager -> AurInfo -> IO (Either PkgName Buildable)
buildable Manager
m AurInfo
ai = do
  let !bse :: PkgName
bse = Text -> PkgName
PkgName (Text -> PkgName) -> Text -> PkgName
forall a b. (a -> b) -> a -> b
$ AurInfo -> Text
pkgBaseOf AurInfo
ai
      mver :: Maybe Versioning
mver = Either ParsingError Versioning -> Maybe Versioning
forall a b. Either a b -> Maybe b
hush (Either ParsingError Versioning -> Maybe Versioning)
-> (Text -> Either ParsingError Versioning)
-> Text
-> Maybe Versioning
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParsingError Versioning
versioning (Text -> Maybe Versioning) -> Text -> Maybe Versioning
forall a b. (a -> b) -> a -> b
$ AurInfo -> Text
aurVersionOf AurInfo
ai
  Maybe Pkgbuild
mpb <- Manager -> PkgName -> IO (Maybe Pkgbuild)
getPkgbuild Manager
m PkgName
bse  -- Using the package base ensures split packages work correctly.
  case (,) (Pkgbuild -> Versioning -> (Pkgbuild, Versioning))
-> Maybe Pkgbuild -> Maybe (Versioning -> (Pkgbuild, Versioning))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Pkgbuild
mpb Maybe (Versioning -> (Pkgbuild, Versioning))
-> Maybe Versioning -> Maybe (Pkgbuild, Versioning)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Versioning
mver of
    Maybe (Pkgbuild, Versioning)
Nothing        -> Either PkgName Buildable -> IO (Either PkgName Buildable)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either PkgName Buildable -> IO (Either PkgName Buildable))
-> (Text -> Either PkgName Buildable)
-> Text
-> IO (Either PkgName Buildable)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgName -> Either PkgName Buildable
forall a b. a -> Either a b
Left (PkgName -> Either PkgName Buildable)
-> (Text -> PkgName) -> Text -> Either PkgName Buildable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PkgName
PkgName (Text -> IO (Either PkgName Buildable))
-> Text -> IO (Either PkgName Buildable)
forall a b. (a -> b) -> a -> b
$ AurInfo -> Text
aurNameOf AurInfo
ai
    Just (Pkgbuild
pb, Versioning
ver) -> Either PkgName Buildable -> IO (Either PkgName Buildable)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either PkgName Buildable -> IO (Either PkgName Buildable))
-> Either PkgName Buildable -> IO (Either PkgName Buildable)
forall a b. (a -> b) -> a -> b
$ Buildable -> Either PkgName Buildable
forall a b. b -> Either a b
Right Buildable :: PkgName
-> Versioning
-> PkgName
-> Provides
-> [Dep]
-> Pkgbuild
-> Bool
-> Buildable
Buildable
      { bName :: PkgName
bName     = Text -> PkgName
PkgName (Text -> PkgName) -> Text -> PkgName
forall a b. (a -> b) -> a -> b
$ AurInfo -> Text
aurNameOf AurInfo
ai
      , bVersion :: Versioning
bVersion  = Versioning
ver
      , bBase :: PkgName
bBase     = PkgName
bse
      , bProvides :: Provides
bProvides = AurInfo -> [Text]
providesOf AurInfo
ai [Text] -> Getting Provides [Text] Provides -> Provides
forall s a. s -> Getting a s a -> a
^. ([Text] -> Maybe Text) -> SimpleGetter [Text] (Maybe Text)
forall s a. (s -> a) -> SimpleGetter s a
to [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe Getting Provides [Text] (Maybe Text)
-> ((Provides -> Const Provides Provides)
    -> Maybe Text -> Const Provides (Maybe Text))
-> Getting Provides [Text] Provides
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Lens' (Maybe Text) Text
forall a. Eq a => a -> Lens' (Maybe a) a
non (AurInfo -> Text
aurNameOf AurInfo
ai) ((Text -> Const Provides Text)
 -> Maybe Text -> Const Provides (Maybe Text))
-> ((Provides -> Const Provides Provides)
    -> Text -> Const Provides Text)
-> (Provides -> Const Provides Provides)
-> Maybe Text
-> Const Provides (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Provides) -> SimpleGetter Text Provides
forall s a. (s -> a) -> SimpleGetter s a
to (PkgName -> Provides
Provides (PkgName -> Provides) -> (Text -> PkgName) -> Text -> Provides
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PkgName
PkgName)
      -- TODO This is a potentially naughty mapMaybe, since deps that fail to
      -- parse will be silently dropped. Unfortunately there isn't much to be
      -- done - `aurLookup` and `aurRepo` which call this function only report
      -- existence errors (i.e. "this package couldn't be found at all").
      , bDeps :: [Dep]
bDeps       = (Text -> Maybe Dep) -> [Text] -> [Dep]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe Dep
parseDep ([Text] -> [Dep]) -> [Text] -> [Dep]
forall a b. (a -> b) -> a -> b
$ AurInfo -> [Text]
dependsOf AurInfo
ai [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ AurInfo -> [Text]
makeDepsOf AurInfo
ai
      , bPkgbuild :: Pkgbuild
bPkgbuild   = Pkgbuild
pb
      , bIsExplicit :: Bool
bIsExplicit = Bool
False }

----------------
-- AUR PKGBUILDS
----------------
aurLink :: FilePath
aurLink :: FilePath
aurLink = FilePath
"https://aur.archlinux.org"

-- | A package's home URL on the AUR.
pkgUrl :: PkgName -> Text
pkgUrl :: PkgName -> Text
pkgUrl (PkgName Text
pkg) = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
aurLink FilePath -> FilePath -> FilePath
</> FilePath
"packages" FilePath -> FilePath -> FilePath
</> Text -> FilePath
T.unpack Text
pkg

-------------------
-- SOURCES FROM GIT
-------------------
-- | Attempt to freshly clone a package source from the AUR.
clone :: Buildable -> IO (Maybe FilePath)
clone :: Buildable -> IO (Maybe FilePath)
clone Buildable
b = do
  ExitCode
ec <- 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
"git" [ FilePath
"clone", FilePath
"--depth", FilePath
"1", FilePath
url ]
  case ExitCode
ec of
    ExitFailure Int
_ -> Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
    ExitCode
ExitSuccess   -> do
      FilePath
pwd <- IO FilePath
forall (m :: * -> *). MonadIO m => m FilePath
getCurrentDirectory
      Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO (Maybe FilePath))
-> (FilePath -> Maybe FilePath) -> FilePath -> IO (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> IO (Maybe FilePath))
-> FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath
pwd FilePath -> FilePath -> FilePath
</> FilePath
pathy
  where
    pathy :: FilePath
    pathy :: FilePath
pathy = Text -> FilePath
T.unpack (Text -> FilePath) -> (PkgName -> Text) -> PkgName -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgName -> Text
pnName (PkgName -> FilePath) -> PkgName -> FilePath
forall a b. (a -> b) -> a -> b
$ Buildable -> PkgName
bBase Buildable
b

    url :: FilePath
    url :: FilePath
url = FilePath
aurLink FilePath -> FilePath -> FilePath
</> FilePath
pathy FilePath -> FilePath -> FilePath
<.> FilePath
"git"

------------
-- RPC CALLS
------------
sortAurInfo :: Settings -> [AurInfo] -> [AurInfo]
sortAurInfo :: Settings -> [AurInfo] -> [AurInfo]
sortAurInfo Settings
ss [AurInfo]
ai = (AurInfo -> AurInfo -> Ordering) -> [AurInfo] -> [AurInfo]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy AurInfo -> AurInfo -> Ordering
compare' [AurInfo]
ai
  where
    compare' :: AurInfo -> AurInfo -> Ordering
    compare' :: AurInfo -> AurInfo -> Ordering
compare' | Settings -> BuildSwitch -> Bool
switch Settings
ss BuildSwitch
SortAlphabetically = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Text -> Text -> Ordering)
-> (AurInfo -> Text) -> AurInfo -> AurInfo -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` AurInfo -> Text
aurNameOf
             | Bool
otherwise = \AurInfo
x AurInfo
y -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (AurInfo -> Int
aurVotesOf AurInfo
y) (AurInfo -> Int
aurVotesOf AurInfo
x)

-- | Frontend to the `aur` library. For @-As@.
aurSearch :: Text -> RIO Env [AurInfo]
aurSearch :: Text -> RIO Env [AurInfo]
aurSearch Text
regex = do
  Settings
ss  <- (Env -> Settings) -> RIO Env Settings
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Settings
settings
  Failure -> RIO Env (Maybe [AurInfo]) -> RIO Env [AurInfo]
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 [AurInfo]) -> RIO Env [AurInfo])
-> (IO (Either AurError [AurInfo]) -> RIO Env (Maybe [AurInfo]))
-> IO (Either AurError [AurInfo])
-> RIO Env [AurInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either AurError [AurInfo] -> Maybe [AurInfo])
-> RIO Env (Either AurError [AurInfo]) -> RIO Env (Maybe [AurInfo])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either AurError [AurInfo] -> Maybe [AurInfo]
forall a b. Either a b -> Maybe b
hush (RIO Env (Either AurError [AurInfo]) -> RIO Env (Maybe [AurInfo]))
-> (IO (Either AurError [AurInfo])
    -> RIO Env (Either AurError [AurInfo]))
-> IO (Either AurError [AurInfo])
-> RIO Env (Maybe [AurInfo])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either AurError [AurInfo])
-> RIO Env (Either AurError [AurInfo])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either AurError [AurInfo]) -> RIO Env [AurInfo])
-> IO (Either AurError [AurInfo]) -> RIO Env [AurInfo]
forall a b. (a -> b) -> a -> b
$ Manager -> Text -> IO (Either AurError [AurInfo])
search (Settings -> Manager
managerOf Settings
ss) Text
regex

-- | Frontend to the `aur` library. For @-Ai@.
aurInfo :: NonEmpty PkgName -> RIO Env [AurInfo]
aurInfo :: NonEmpty PkgName -> RIO Env [AurInfo]
aurInfo NonEmpty PkgName
pkgs = 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
"AUR: Looking up " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (NonEmpty PkgName -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty PkgName
pkgs) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" packages..."
  Settings
ss <- (Env -> Settings) -> RIO Env Settings
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Settings
settings
  let !m :: Manager
m = Settings -> Manager
managerOf Settings
ss
  Settings -> [AurInfo] -> [AurInfo]
sortAurInfo Settings
ss ([AurInfo] -> [AurInfo])
-> ([[AurInfo]] -> [AurInfo]) -> [[AurInfo]] -> [AurInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[AurInfo]] -> [AurInfo]
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([[AurInfo]] -> [AurInfo])
-> RIO Env [[AurInfo]] -> RIO Env [AurInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Comp
-> ([PkgName] -> RIO Env [AurInfo])
-> [[PkgName]]
-> RIO Env [[AurInfo]]
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
Comp -> (a -> m b) -> t a -> m (t b)
traverseConcurrently Comp
Par' (Manager -> [PkgName] -> RIO Env [AurInfo]
work Manager
m) (Int -> [PkgName] -> [[PkgName]]
forall a. Int -> [a] -> [[a]]
groupsOf Int
50 ([PkgName] -> [[PkgName]]) -> [PkgName] -> [[PkgName]]
forall a b. (a -> b) -> a -> b
$ NonEmpty PkgName -> [PkgName]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty PkgName
pkgs)
  where
    work :: Manager -> [PkgName] -> RIO Env [AurInfo]
    work :: Manager -> [PkgName] -> RIO Env [AurInfo]
work Manager
m [PkgName]
ps = IO (Either AurError [AurInfo])
-> RIO Env (Either AurError [AurInfo])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Manager -> [Text] -> IO (Either AurError [AurInfo])
info Manager
m ([Text] -> IO (Either AurError [AurInfo]))
-> [Text] -> IO (Either AurError [AurInfo])
forall a b. (a -> b) -> a -> b
$ (PkgName -> Text) -> [PkgName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map PkgName -> Text
pnName [PkgName]
ps) RIO Env (Either AurError [AurInfo])
-> (Either AurError [AurInfo] -> RIO Env [AurInfo])
-> RIO Env [AurInfo]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left (NotFound ByteString
_) -> Failure -> RIO Env [AurInfo]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (FailMsg -> Failure
Failure (FailMsg -> Failure) -> FailMsg -> Failure
forall a b. (a -> b) -> a -> b
$ (Language -> Doc AnsiStyle) -> FailMsg
FailMsg Language -> Doc AnsiStyle
connectFailure_1)
      Left AurError
BadJSON -> Failure -> RIO Env [AurInfo]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (FailMsg -> Failure
Failure (FailMsg -> Failure) -> FailMsg -> Failure
forall a b. (a -> b) -> a -> b
$ (Language -> Doc AnsiStyle) -> FailMsg
FailMsg Language -> Doc AnsiStyle
miscAURFailure_3)
      Left (OtherAurError ByteString
e) -> do
        let !resp :: Utf8Builder
resp = Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Text -> Utf8Builder) -> Text -> Utf8Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8Lenient ByteString
e
        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
"Failed! Server said: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
resp
        Failure -> RIO Env [AurInfo]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (FailMsg -> Failure
Failure (FailMsg -> Failure) -> FailMsg -> Failure
forall a b. (a -> b) -> a -> b
$ (Language -> Doc AnsiStyle) -> FailMsg
FailMsg Language -> Doc AnsiStyle
miscAURFailure_1)
      Right [AurInfo]
res -> [AurInfo] -> RIO Env [AurInfo]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [AurInfo]
res