{-# LANGUAGE TupleSections #-}
module Aura.Packages.Repository
( pacmanRepo
, extractVersion
) where
import Aura.Core
import Aura.IO
import Aura.Languages (provides_1)
import Aura.Pacman (pacmanLines, pacmanOutput)
import Aura.Settings (CommonSwitch(..), Settings(..), shared)
import Aura.Types
import Aura.Utils
import Control.Scheduler (Comp(..), traverseConcurrently)
import Data.Versions
import RIO hiding (try)
import qualified RIO.Map as M
import qualified RIO.Set as S
import qualified RIO.Text as T
import Text.Megaparsec
import Text.Megaparsec.Char
pacmanRepo :: IO Repository
pacmanRepo = do
tv <- newTVarIO mempty
mv <- newMVar ()
let g :: Settings -> NonEmpty 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 mv 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 { pName = pn
, pVersion = ver
, pBase = pn
, pProvides = pro }
resolveName :: MVar () -> Settings -> PkgName -> IO (Either PkgName (PkgName, Provides))
resolveName mv ss pn = do
provs <- map PkgName <$> pacmanLines ["-Ssq", "^" <> escape (pnName pn) <> "$"]
case provs of
[] -> pure $ Left pn
_ -> Right . (, Provides pn) <$> chooseProvider mv ss pn provs
where
escape :: Text -> Text
escape = T.foldl' f ""
f :: Text -> Char -> Text
f acc '+' = acc <> "\\+"
f acc c = T.snoc acc c
chooseProvider :: MVar () -> Settings -> PkgName -> [PkgName] -> IO PkgName
chooseProvider _ _ pn [] = pure pn
chooseProvider _ _ _ [p] = pure p
chooseProvider mv ss pn ps@(a:as) =
traverseConcurrently Par' isInstalled ps >>= maybe f pure . listToMaybe . catMaybes
where
f :: IO PkgName
f | shared ss NoConfirm = pure . bool a pn $ pn `elem` ps
| otherwise = do
void $ takeMVar mv
warn ss $ provides_1 pn
r <- getSelection pnName (a :| as)
putMVar mv ()
pure r
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" ]