{-# 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 m names = runMaybeT $ do
infos <- MaybeT . fmap hush . info m $ foldr (\(PkgName pn) acc -> pn : acc) [] names
badsgoods <- lift $ traverseConcurrently Par' (buildable m) infos
let (bads, goods) = partitionEithers badsgoods
goodNames = S.fromList $ goods ^.. each . to bName
pure (S.fromList bads <> S.fromList (NEL.toList names) S.\\ goodNames, S.fromList goods)
aurRepo :: IO Repository
aurRepo = do
tv <- newTVarIO mempty
let f :: Settings -> NonEmpty PkgName -> IO (Maybe (Set PkgName, Set Package))
f ss ps = do
cache <- readTVarIO tv
let (uncached, cached) = fmapEither (\p -> note p $ M.lookup p cache) $ toList ps
case NEL.nonEmpty uncached of
Nothing -> pure $ Just (S.empty, S.fromList cached)
Just uncached' -> runMaybeT $ do
(bads, goods) <- MaybeT $ aurLookup (managerOf ss) uncached'
let !pkgs = map FromAUR $ S.toList goods
let m = M.fromList $ map (pname &&& id) pkgs
liftIO . atomically $ modifyTVar' tv (<> m)
pure (bads, S.fromList $ cached <> pkgs)
pure $ Repository tv f
buildable :: Manager -> AurInfo -> IO (Either PkgName Buildable)
buildable m ai = do
let !bse = PkgName $ pkgBaseOf ai
mver = hush . versioning $ aurVersionOf ai
mpb <- getPkgbuild m bse
case (,) <$> mpb <*> mver of
Nothing -> pure . Left . PkgName $ aurNameOf ai
Just (pb, ver) -> pure $ Right Buildable
{ bName = PkgName $ aurNameOf ai
, bVersion = ver
, bBase = bse
, bProvides = providesOf ai ^. to listToMaybe . non (aurNameOf ai) . to (Provides . PkgName)
, bDeps = mapMaybe parseDep $ dependsOf ai ++ makeDepsOf ai
, bPkgbuild = pb
, bIsExplicit = False }
aurLink :: FilePath
aurLink = "https://aur.archlinux.org"
pkgUrl :: PkgName -> Text
pkgUrl (PkgName pkg) = T.pack $ aurLink </> "packages" </> T.unpack pkg
clone :: Buildable -> IO (Maybe FilePath)
clone b = do
ec <- runProcess . setStderr closed . setStdout closed
$ proc "git" [ "clone", "--depth", "1", url ]
case ec of
ExitFailure _ -> pure Nothing
ExitSuccess -> do
pwd <- getCurrentDirectory
pure . Just $ pwd </> pathy
where
pathy :: FilePath
pathy = T.unpack . pnName $ bBase b
url :: FilePath
url = aurLink </> pathy <.> "git"
sortAurInfo :: Settings -> [AurInfo] -> [AurInfo]
sortAurInfo ss ai = L.sortBy compare' ai
where
compare' :: AurInfo -> AurInfo -> Ordering
compare' | switch ss SortAlphabetically = compare `on` aurNameOf
| otherwise = \x y -> compare (aurVotesOf y) (aurVotesOf x)
aurSearch :: Text -> RIO Env [AurInfo]
aurSearch regex = do
ss <- asks settings
liftMaybeM (Failure $ FailMsg connectFailure_1) . fmap hush . liftIO $ search (managerOf ss) regex
aurInfo :: NonEmpty PkgName -> RIO Env [AurInfo]
aurInfo pkgs = do
logDebug $ "AUR: Looking up " <> display (length pkgs) <> " packages..."
ss <- asks settings
let !m = managerOf ss
sortAurInfo ss . fold <$> traverseConcurrently Par' (work m) (groupsOf 50 $ NEL.toList pkgs)
where
work :: Manager -> [PkgName] -> RIO Env [AurInfo]
work m ps = liftIO (info m $ map pnName ps) >>= \case
Left (NotFound _) -> throwM (Failure $ FailMsg connectFailure_1)
Left BadJSON -> throwM (Failure $ FailMsg miscAURFailure_3)
Left (OtherAurError e) -> do
let !resp = display $ decodeUtf8Lenient e
logDebug $ "Failed! Server said: " <> resp
throwM (Failure $ FailMsg miscAURFailure_1)
Right res -> pure res