{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module Aura.Commands.A
( I.install
, upgradeAURPkgs
, aurPkgInfo
, aurPkgSearch
, I.displayPkgDeps
, displayPkgbuild
, aurJson
) where
import Aura.Colour
import Aura.Core
import qualified Aura.Install as I
import Aura.Languages
import Aura.Packages.AUR
import Aura.Pkgbuild.Fetch
import Aura.Settings
import Aura.State (saveState)
import Aura.Types
import Aura.Utils
import Control.Error.Util (hush)
import Data.Aeson.Encode.Pretty (encodePretty)
import Data.Generics.Product (field)
import qualified Data.List.NonEmpty as NEL
import Data.Set.NonEmpty (NESet)
import qualified Data.Set.NonEmpty as NES
import Data.Text.Prettyprint.Doc
import Data.Text.Prettyprint.Doc.Render.Terminal
import Data.Versions (Versioning, prettyV, versioning)
import Lens.Micro (each, (^..))
import Linux.Arch.Aur
import Network.HTTP.Client (Manager)
import RIO
import qualified RIO.ByteString as B
import qualified RIO.ByteString.Lazy as BL
import RIO.List (intersperse)
import RIO.List.Partial (maximum)
import qualified RIO.Set as S
import qualified RIO.Text as T
import RIO.Text.Partial (splitOn)
import Text.Printf (printf)
upgradeAURPkgs :: Set PkgName -> RIO Env ()
upgradeAURPkgs pkgs = do
ss <- asks settings
liftIO . notify ss . upgradeAURPkgs_1 $ langOf ss
liftIO (foreigns ss) >>= traverse_ (upgrade pkgs) . NES.nonEmptySet
foreigns :: Settings -> IO (Set SimplePkg)
foreigns ss = S.filter (notIgnored . view (field @"name")) <$> foreignPackages
where notIgnored p = not . S.member p $ ignoresOf ss
upgrade :: Set PkgName -> NESet SimplePkg -> RIO Env ()
upgrade pkgs fs = do
ss <- asks settings
toUpgrade <- possibleUpdates fs
let !names = map (PkgName . aurNameOf . fst) toUpgrade
auraFirst <- auraCheck names
case auraFirst of
Just a -> auraUpgrade a
Nothing -> do
devel <- develPkgCheck
liftIO . notify ss . upgradeAURPkgs_2 $ langOf ss
if | null toUpgrade && null devel -> liftIO . warn ss . upgradeAURPkgs_3 $ langOf ss
| otherwise -> do
reportPkgsToUpgrade toUpgrade (toList devel)
liftIO . unless (switch ss DryRun) $ saveState ss
traverse_ I.install . NES.nonEmptySet $ S.fromList names <> pkgs <> devel
possibleUpdates :: NESet SimplePkg -> RIO Env [(AurInfo, Versioning)]
possibleUpdates (NES.toList -> pkgs) = do
aurInfos <- aurInfo $ fmap (^. field @"name") pkgs
let !names = map aurNameOf aurInfos
aurPkgs = NEL.filter (\(SimplePkg (PkgName n) _) -> n `elem` names) pkgs
pure . filter isntMostRecent . zip aurInfos $ aurPkgs ^.. each . field @"version"
auraCheck :: [PkgName] -> RIO Env (Maybe PkgName)
auraCheck ps = join <$> traverse f auraPkg
where f a = do
ss <- asks settings
bool Nothing (Just a) <$> liftIO (optionalPrompt ss auraCheck_1)
auraPkg | "aura" `elem` ps = Just "aura"
| "aura-bin" `elem` ps = Just "aura-bin"
| otherwise = Nothing
auraUpgrade :: PkgName -> RIO Env ()
auraUpgrade = I.install . NES.singleton
develPkgCheck :: RIO Env (Set PkgName)
develPkgCheck = asks settings >>= \ss ->
if switch ss RebuildDevel then liftIO develPkgs else pure S.empty
aurPkgInfo :: NESet PkgName -> RIO Env ()
aurPkgInfo = aurInfo . NES.toList >=> traverse_ displayAurPkgInfo
displayAurPkgInfo :: AurInfo -> RIO Env ()
displayAurPkgInfo ai = asks settings >>= \ss -> liftIO . putTextLn $ renderAurPkgInfo ss ai <> "\n"
renderAurPkgInfo :: Settings -> AurInfo -> Text
renderAurPkgInfo ss ai = dtot . colourCheck ss $ entrify ss fields entries
where fields = infoFields . langOf $ ss
entries = [ magenta "aur"
, annotate bold . pretty $ aurNameOf ai
, pretty $ aurVersionOf ai
, outOfDateMsg (dateObsoleteOf ai) $ langOf ss
, orphanedMsg (aurMaintainerOf ai) $ langOf ss
, cyan . maybe "(null)" pretty $ urlOf ai
, pretty . pkgUrl . PkgName $ aurNameOf ai
, pretty . T.unwords $ licenseOf ai
, pretty . T.unwords $ dependsOf ai
, pretty . T.unwords $ makeDepsOf ai
, yellow . pretty $ aurVotesOf ai
, yellow . pretty . T.pack . printf "%0.2f" $ popularityOf ai
, maybe "(null)" pretty $ aurDescriptionOf ai ]
aurPkgSearch :: Text -> RIO Env ()
aurPkgSearch regex = do
ss <- asks settings
db <- S.map (^. field @"name" . field @"name") <$> liftIO foreignPackages
let t = case truncationOf $ buildConfigOf ss of
None -> id
Head n -> take $ fromIntegral n
Tail n -> reverse . take (fromIntegral n) . reverse
results <- fmap (\x -> (x, aurNameOf x `S.member` db)) . t
<$> aurSearch regex
liftIO $ traverse_ (putTextLn . renderSearch ss regex) results
renderSearch :: Settings -> Text -> (AurInfo, Bool) -> Text
renderSearch ss r (i, e) = searchResult
where searchResult = if switch ss LowVerbosity then sparseInfo else dtot $ colourCheck ss verboseInfo
sparseInfo = aurNameOf i
verboseInfo = repo <> n <+> v <+> "(" <> l <+> "|" <+> p <>
")" <> (if e then annotate bold " [installed]" else "") <> "\n " <> d
repo = magenta "aur/"
n = fold . intersperse (bCyan $ pretty r) . map (annotate bold . pretty) . splitOn r $ aurNameOf i
d = maybe "(null)" pretty $ aurDescriptionOf i
l = yellow . pretty $ aurVotesOf i
p = yellow . pretty . T.pack . printf "%0.2f" $ popularityOf i
v = case dateObsoleteOf i of
Just _ -> red . pretty $ aurVersionOf i
Nothing -> green . pretty $ aurVersionOf i
displayPkgbuild :: NESet PkgName -> RIO Env ()
displayPkgbuild ps = do
man <- asks (managerOf . settings)
pbs <- catMaybes <$> traverse (liftIO . getPkgbuild man) (toList ps)
liftIO . traverse_ (\p -> B.putStr @IO p >> B.putStr "\n") $ pbs ^.. each . field @"pkgbuild"
isntMostRecent :: (AurInfo, Versioning) -> Bool
isntMostRecent (ai, v) = trueVer > Just v
where trueVer = hush . versioning $ aurVersionOf ai
aurJson :: NESet PkgName -> RIO Env ()
aurJson ps = do
m <- asks (managerOf . settings)
infos <- liftMaybeM (Failure connectionFailure_1) . fmap hush . liftIO $ f m ps
liftIO $ traverse_ (BL.putStrLn @IO . encodePretty) infos
where
f :: Manager -> NESet PkgName -> IO (Either ClientError [AurInfo])
f m = info m . (^.. each . field @"name") . toList
reportPkgsToUpgrade :: [(AurInfo, Versioning)] -> [PkgName] -> RIO Env ()
reportPkgsToUpgrade ups pns = do
ss <- asks settings
liftIO . notify ss . reportPkgsToUpgrade_1 $ langOf ss
liftIO $ putDoc (colourCheck ss . vcat $ map f ups' <> map g devels) >> putTextLn "\n"
where devels = pns ^.. each . field @"name"
ups' = map (second prettyV) ups
nLen = maximum $ map (T.length . aurNameOf . fst) ups <> map T.length devels
vLen = maximum $ map (T.length . snd) ups'
g = annotate (color Cyan) . pretty
f (p, v) = hsep [ cyan . fill nLen . pretty $ aurNameOf p
, "::"
, yellow . fill vLen $ pretty v
, "->"
, green . pretty $ aurVersionOf p ]