{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
module Aura.Packages.Repository
( pacmanRepo
, extractVersion
) where
import Aura.Core
import Aura.Languages (provides_1)
import Aura.Pacman (pacmanLines, pacmanOutput)
import Aura.Settings (CommonSwitch(..), Settings(..), shared)
import Aura.Types
import Aura.Utils (getSelection)
import Control.Compactable (fmapEither, traverseEither)
import Control.Error.Util (hush, note)
import Control.Scheduler (Comp(..), traverseConcurrently)
import Data.Generics.Product (field)
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.Set.NonEmpty as NES
import Data.Versions
import RIO hiding (try)
import qualified RIO.Map as M
import qualified RIO.Set as S
import Text.Megaparsec
import Text.Megaparsec.Char
pacmanRepo :: IO Repository
pacmanRepo = do
tv <- newTVarIO mempty
let g :: Settings -> NES.NESet PkgName -> IO (Maybe (Set PkgName, Set Package))
g ss names = do
cache <- readTVarIO tv
let (uncached, cached) = fmapEither (\p -> note p $ M.lookup p cache) $ toList names
bgs <- traverseConcurrently Par' (resolveName ss) uncached
let (bads, goods) = partitionEithers bgs
(bads', goods') <- traverseEither f goods
let m = M.fromList $ map (pname &&& id) goods'
atomically $ modifyTVar' tv (<> m)
pure $ Just (S.fromList $ bads <> bads', S.fromList $ cached <> goods')
pure $ Repository tv g
where
f (r, p) = fmap (FromRepo . packageRepo r p) <$> mostRecent r
packageRepo :: PkgName -> Provides -> Versioning -> Prebuilt
packageRepo pn pro ver = Prebuilt { name = pn
, version = ver
, base = pn
, provides = pro }
resolveName :: Settings -> PkgName -> IO (Either PkgName (PkgName, Provides))
resolveName ss pn = do
provs <- map PkgName <$> pacmanLines ["-Ssq", "^" <> (pn ^. field @"name") <> "$"]
case provs of
[] -> pure $ Left pn
_ -> Right . (, Provides pn) <$> chooseProvider ss pn provs
chooseProvider :: Settings -> PkgName -> [PkgName] -> IO PkgName
chooseProvider _ pn [] = pure pn
chooseProvider _ _ [p] = pure p
chooseProvider ss pn ps@(a:as) =
traverseConcurrently Par' isInstalled ps >>= maybe f pure . listToMaybe . catMaybes
where
f | shared ss NoConfirm = pure . bool a pn $ pn `elem` ps
| otherwise = warn ss (provides_1 pn $ langOf ss) >> getSelection (^. field @"name") (a :| as)
mostRecent :: PkgName -> IO (Either PkgName Versioning)
mostRecent p@(PkgName s) = note p . extractVersion . decodeUtf8Lenient <$> pacmanOutput ["-Si", s]
extractVersion :: Text -> Maybe Versioning
extractVersion = hush . parse p "extractVersion"
where p = do
void $ takeWhile1P Nothing (/= '\n') *> newline
void $ takeWhile1P Nothing (/= '\n') *> newline
string "Version" *> space1 *> char ':' *> space1 *> v
v = choice [ try (fmap Ideal semver' <* string "Description")
, try (fmap General version' <* string "Description")
, fmap Complex mess' <* string "Description" ]