{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
module Aura.Packages.AUR
(
aurLookup
, aurRepo
, aurInfo
, aurSearch
, sortAurInfo
, 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
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)
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
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
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
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
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
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)
, 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 }
aurLink :: FilePath
aurLink :: FilePath
aurLink = FilePath
"https://aur.archlinux.org"
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
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"
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)
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
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