{-# LANGUAGE TupleSections #-}

-- |
-- Module    : Aura.Cache
-- Copyright : (c) Colin Woodbury, 2012 - 2020
-- License   : GPL3
-- Maintainer: Colin Woodbury <colin@fosskers.ca>
--
-- Reading and searching the package cache.

module Aura.Cache
  ( -- * Types
    Cache(..)
  , cacheContents
  , CleanMode(..)
    -- * Misc.
  , defaultPackageCache
  , cacheMatches
  , pkgsInCache
  ) where

import           Aura.Settings
import           Aura.Types
import           RIO
import           RIO.Directory
import           RIO.FilePath
import qualified RIO.Map as M
import qualified RIO.Set as S
import qualified RIO.Text as T

---

-- | Every package in the current cache, paired with its original filename.
newtype Cache = Cache { Cache -> Map SimplePkg PackagePath
_cache :: Map SimplePkg PackagePath }

-- | For manipulating the specifics of the cache cleaning process.
data CleanMode = Quantity | AndUninstalled
  deriving (CleanMode -> CleanMode -> Bool
(CleanMode -> CleanMode -> Bool)
-> (CleanMode -> CleanMode -> Bool) -> Eq CleanMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CleanMode -> CleanMode -> Bool
$c/= :: CleanMode -> CleanMode -> Bool
== :: CleanMode -> CleanMode -> Bool
$c== :: CleanMode -> CleanMode -> Bool
Eq, Int -> CleanMode -> ShowS
[CleanMode] -> ShowS
CleanMode -> String
(Int -> CleanMode -> ShowS)
-> (CleanMode -> String)
-> ([CleanMode] -> ShowS)
-> Show CleanMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CleanMode] -> ShowS
$cshowList :: [CleanMode] -> ShowS
show :: CleanMode -> String
$cshow :: CleanMode -> String
showsPrec :: Int -> CleanMode -> ShowS
$cshowsPrec :: Int -> CleanMode -> ShowS
Show)

-- | The default location of the package cache: \/var\/cache\/pacman\/pkg\/
defaultPackageCache :: FilePath
defaultPackageCache :: String
defaultPackageCache = String
"/var/cache/pacman/pkg/"

-- SILENT DROPS PATHS THAT DON'T PARSE
-- Maybe that's okay, since we don't know what non-package garbage files
-- could be sitting in the cache.
-- | Given every filepath contained in the package cache, form
-- the `Cache` type.
cache :: [PackagePath] -> Cache
cache :: [PackagePath] -> Cache
cache = Map SimplePkg PackagePath -> Cache
Cache (Map SimplePkg PackagePath -> Cache)
-> ([PackagePath] -> Map SimplePkg PackagePath)
-> [PackagePath]
-> Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(SimplePkg, PackagePath)] -> Map SimplePkg PackagePath
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(SimplePkg, PackagePath)] -> Map SimplePkg PackagePath)
-> ([PackagePath] -> [(SimplePkg, PackagePath)])
-> [PackagePath]
-> Map SimplePkg PackagePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackagePath -> Maybe (SimplePkg, PackagePath))
-> [PackagePath] -> [(SimplePkg, PackagePath)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\PackagePath
p -> (,PackagePath
p) (SimplePkg -> (SimplePkg, PackagePath))
-> Maybe SimplePkg -> Maybe (SimplePkg, PackagePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackagePath -> Maybe SimplePkg
simplepkg PackagePath
p)

-- | Given a path to the package cache, yields its contents in a usable form.
cacheContents :: FilePath -> IO Cache
cacheContents :: String -> IO Cache
cacheContents String
pth = [PackagePath] -> Cache
cache ([PackagePath] -> Cache)
-> ([String] -> [PackagePath]) -> [String] -> Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe PackagePath) -> [String] -> [PackagePath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> Maybe PackagePath
packagePath (String -> Maybe PackagePath)
-> ShowS -> String -> Maybe PackagePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
pth String -> ShowS
</>)) ([String] -> Cache) -> IO [String] -> IO Cache
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
forall (m :: * -> *). MonadIO m => String -> m [String]
listDirectory String
pth

-- | All packages from a given `Set` who have a copy in the cache.
pkgsInCache :: Settings -> Set PkgName -> IO (Set PkgName)
pkgsInCache :: Settings -> Set PkgName -> IO (Set PkgName)
pkgsInCache Settings
ss Set PkgName
ps = do
  Cache
c <- String -> IO Cache
cacheContents (String -> IO Cache)
-> (CommonConfig -> String) -> CommonConfig -> IO Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> ShowS -> Either String String -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ShowS
forall a. a -> a
id ShowS
forall a. a -> a
id (Either String String -> String)
-> (CommonConfig -> Either String String) -> CommonConfig -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonConfig -> Either String String
cachePathOf (CommonConfig -> IO Cache) -> CommonConfig -> IO Cache
forall a b. (a -> b) -> a -> b
$ Settings -> CommonConfig
commonConfigOf Settings
ss
  Set PkgName -> IO (Set PkgName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set PkgName -> IO (Set PkgName))
-> (Map SimplePkg PackagePath -> Set PkgName)
-> Map SimplePkg PackagePath
-> IO (Set PkgName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PkgName -> Bool) -> Set PkgName -> Set PkgName
forall a. (a -> Bool) -> Set a -> Set a
S.filter (PkgName -> Set PkgName -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set PkgName
ps) (Set PkgName -> Set PkgName)
-> (Map SimplePkg PackagePath -> Set PkgName)
-> Map SimplePkg PackagePath
-> Set PkgName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SimplePkg -> PkgName) -> Set SimplePkg -> Set PkgName
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map SimplePkg -> PkgName
spName (Set SimplePkg -> Set PkgName)
-> (Map SimplePkg PackagePath -> Set SimplePkg)
-> Map SimplePkg PackagePath
-> Set PkgName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map SimplePkg PackagePath -> Set SimplePkg
forall k a. Map k a -> Set k
M.keysSet (Map SimplePkg PackagePath -> IO (Set PkgName))
-> Map SimplePkg PackagePath -> IO (Set PkgName)
forall a b. (a -> b) -> a -> b
$ Cache -> Map SimplePkg PackagePath
_cache Cache
c

-- | Any entries (filepaths) in the cache that match a given `Text`.
cacheMatches :: Settings -> Text -> IO [PackagePath]
cacheMatches :: Settings -> Text -> IO [PackagePath]
cacheMatches Settings
ss Text
input = do
  Cache
c <- String -> IO Cache
cacheContents (String -> IO Cache)
-> (CommonConfig -> String) -> CommonConfig -> IO Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> ShowS -> Either String String -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ShowS
forall a. a -> a
id ShowS
forall a. a -> a
id (Either String String -> String)
-> (CommonConfig -> Either String String) -> CommonConfig -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonConfig -> Either String String
cachePathOf (CommonConfig -> IO Cache) -> CommonConfig -> IO Cache
forall a b. (a -> b) -> a -> b
$ Settings -> CommonConfig
commonConfigOf Settings
ss
  [PackagePath] -> IO [PackagePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([PackagePath] -> IO [PackagePath])
-> (Map SimplePkg PackagePath -> [PackagePath])
-> Map SimplePkg PackagePath
-> IO [PackagePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackagePath -> Bool) -> [PackagePath] -> [PackagePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
T.isInfixOf Text
input (Text -> Bool) -> (PackagePath -> Text) -> PackagePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (PackagePath -> String) -> PackagePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackagePath -> String
ppPath) ([PackagePath] -> [PackagePath])
-> (Map SimplePkg PackagePath -> [PackagePath])
-> Map SimplePkg PackagePath
-> [PackagePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map SimplePkg PackagePath -> [PackagePath]
forall k a. Map k a -> [a]
M.elems (Map SimplePkg PackagePath -> IO [PackagePath])
-> Map SimplePkg PackagePath -> IO [PackagePath]
forall a b. (a -> b) -> a -> b
$ Cache -> Map SimplePkg PackagePath
_cache Cache
c