{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Aura.Pacman
(
pacman
, pacmanOutput, pacmanSuccess, pacmanLines
, lockFile
, pacmanConfFile
, defaultLogFile
, getCachePath
, getLogFilePath
, Config(..), config
, getPacmanConf
, getIgnoredPkgs, getIgnoredGroups
, groupPackages
, versionInfo
, verMsgPad
) where
import Aura.Languages
import Aura.Types
import Data.Bifunctor (first)
import Data.Set.NonEmpty (NESet)
import Lens.Micro (at, (^?), _2, _Just, _head)
import Lens.Micro.GHC ()
import RIO hiding (first, some, try)
import qualified RIO.ByteString as BS
import qualified RIO.ByteString.Lazy as BL
import RIO.List.Partial ((!!))
import qualified RIO.Map as M
import qualified RIO.Set as S
import qualified RIO.Text as T
import System.Path (Absolute, Path, fromAbsoluteFilePath, toFilePath)
import System.Process.Typed
import Text.Megaparsec hiding (single)
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L
newtype Config = Config (Map Text [Text]) deriving (Show)
config :: Parsec Void Text Config
config = Config . M.fromList . rights <$> (garbage *> some (fmap Right (try pair) <|> fmap Left single) <* eof)
single :: Parsec Void Text ()
single = L.lexeme garbage . void $ manyTill letterChar newline
pair :: Parsec Void Text (Text, [Text])
pair = L.lexeme garbage $ do
n <- takeWhile1P Nothing (/= ' ')
space
void $ char '='
space
rest <- T.words <$> takeWhile1P Nothing (/= '\n')
pure (n, rest)
garbage :: Parsec Void Text ()
garbage = L.space space1 (L.skipLineComment "#") (L.skipBlockComment "[" "]")
pacmanConfFile :: Path Absolute
pacmanConfFile = fromAbsoluteFilePath "/etc/pacman.conf"
defaultLogFile :: Path Absolute
defaultLogFile = fromAbsoluteFilePath "/var/log/pacman.log"
lockFile :: Path Absolute
lockFile = fromAbsoluteFilePath "/var/lib/pacman/db.lck"
getPacmanConf :: Path Absolute -> IO (Either Failure Config)
getPacmanConf fp = do
file <- decodeUtf8Lenient <$> BS.readFile (toFilePath fp)
pure . first (const (Failure confParsing_1)) $ parse config "pacman config" file
getIgnoredPkgs :: Config -> Set PkgName
getIgnoredPkgs (Config c) = maybe S.empty (S.fromList . map PkgName) $ M.lookup "IgnorePkg" c
getIgnoredGroups :: Config -> Set PkgGroup
getIgnoredGroups (Config c) = maybe S.empty (S.fromList . map PkgGroup) $ M.lookup "IgnoreGroup" c
groupPackages :: NESet PkgGroup -> IO (Set PkgName)
groupPackages igs = fmap (f . decodeUtf8Lenient) . pacmanOutput $ "-Qg" : asFlag igs
where
f :: Text -> Set PkgName
f = S.fromList . map (PkgName . (!! 1) . T.words) . T.lines
getCachePath :: Config -> Maybe (Path Absolute)
getCachePath (Config c) = c ^? at "CacheDir" . _Just . _head . to (fromAbsoluteFilePath . T.unpack)
getLogFilePath :: Config -> Maybe (Path Absolute)
getLogFilePath (Config c) = c ^? at "LogFile" . _Just . _head . to (fromAbsoluteFilePath . T.unpack)
pacmanProc :: [String] -> ProcessConfig () () ()
pacmanProc args = setEnv [("LC_ALL", "C")] $ proc "pacman" args
pacman :: [Text] -> IO ()
pacman (map T.unpack -> args) = do
ec <- runProcess $ pacmanProc args
unless (ec == ExitSuccess) $ throwM (Failure pacmanFailure_1)
pacmanSuccess :: [T.Text] -> IO Bool
pacmanSuccess = fmap (== ExitSuccess) . runProcess . setStderr closed . setStdout closed . pacmanProc . map T.unpack
pacmanOutput :: [Text] -> IO ByteString
pacmanOutput = fmap (^. _2 . to BL.toStrict) . readProcess . pacmanProc . map T.unpack
pacmanLines :: [Text] -> IO [Text]
pacmanLines s = T.lines . decodeUtf8Lenient <$> pacmanOutput s
versionInfo :: IO [Text]
versionInfo = map (T.drop verMsgPad) <$> pacmanLines ["-V"]
verMsgPad :: Int
verMsgPad = 23