{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}

-- | Copyright: (c) 2020 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <1793913507@qq.com>
-- Stability: experimental
-- Portability: portable
-- This module provides functions operating with @community.db@ of pacman.
module Distribution.ArchHs.Community
  ( defaultCommunityPath,
    loadProcessedCommunity,
    isInCommunity,
    versionInCommunity,
  )
where

import Conduit
import qualified Data.Conduit.Tar as Tar
import qualified Data.Conduit.Zlib as Zlib
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import Distribution.ArchHs.Exception
import Distribution.ArchHs.Internal.Prelude
import Distribution.ArchHs.Name
import Distribution.ArchHs.PkgDesc
import Distribution.ArchHs.Types

-- | Default path to @community.db@.
defaultCommunityPath :: FilePath
defaultCommunityPath :: FilePath
defaultCommunityPath = FilePath
"/" FilePath -> FilePath -> FilePath
</> FilePath
"var" FilePath -> FilePath -> FilePath
</> FilePath
"lib" FilePath -> FilePath -> FilePath
</> FilePath
"pacman" FilePath -> FilePath -> FilePath
</> FilePath
"sync" FilePath -> FilePath -> FilePath
</> FilePath
"community.db"

loadCommunity ::
  (MonadResource m, PrimMonad m, MonadThrow m) =>
  FilePath ->
  ConduitT i (CommunityName, CommunityVersion) m ()
loadCommunity :: FilePath -> ConduitT i (CommunityName, FilePath) m ()
loadCommunity FilePath
path = do
  FilePath -> ConduitT i ByteString m ()
forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitT i ByteString m ()
sourceFileBS FilePath
path ConduitT i ByteString m ()
-> ConduitM ByteString (CommunityName, FilePath) m ()
-> ConduitT i (CommunityName, FilePath) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT ByteString ByteString m ()
forall (m :: * -> *).
(PrimMonad m, MonadThrow m) =>
ConduitT ByteString ByteString m ()
Zlib.ungzip ConduitT ByteString ByteString m ()
-> ConduitM ByteString (CommunityName, FilePath) m ()
-> ConduitM ByteString (CommunityName, FilePath) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString TarChunk m ()
forall (m :: * -> *). Monad m => ConduitM ByteString TarChunk m ()
Tar.untarChunks ConduitM ByteString TarChunk m ()
-> ConduitM TarChunk (CommunityName, FilePath) m ()
-> ConduitM ByteString (CommunityName, FilePath) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (Header -> ConduitM ByteString (CommunityName, FilePath) m ())
-> ConduitM TarChunk (CommunityName, FilePath) m ()
forall (m :: * -> *) o.
MonadThrow m =>
(Header -> ConduitM ByteString o m ()) -> ConduitM TarChunk o m ()
Tar.withEntries Header -> ConduitM ByteString (CommunityName, FilePath) m ()
forall (m :: * -> *).
Monad m =>
Header -> ConduitT ByteString (CommunityName, FilePath) m ()
action
  where
    action :: Header -> ConduitT ByteString (CommunityName, FilePath) m ()
action Header
header =
      Bool
-> ConduitT ByteString (CommunityName, FilePath) m ()
-> ConduitT ByteString (CommunityName, FilePath) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Header -> FileType
Tar.headerFileType Header
header FileType -> FileType -> Bool
forall a. Eq a => a -> a -> Bool
== FileType
Tar.FTNormal) (ConduitT ByteString (CommunityName, FilePath) m ()
 -> ConduitT ByteString (CommunityName, FilePath) m ())
-> ConduitT ByteString (CommunityName, FilePath) m ()
-> ConduitT ByteString (CommunityName, FilePath) m ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString
x <- [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat ([ByteString] -> ByteString)
-> ConduitT ByteString (CommunityName, FilePath) m [ByteString]
-> ConduitT ByteString (CommunityName, FilePath) m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT ByteString (CommunityName, FilePath) m [ByteString]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList
        let txt :: FilePath
txt = Text -> FilePath
T.unpack (Text -> FilePath)
-> (ByteString -> Text) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> FilePath) -> ByteString -> FilePath
forall a b. (a -> b) -> a -> b
$ ByteString
x
            result :: [(FilePath, FilePath)]
result =
              let provided :: Map k a -> a
provided Map k a
r = Map k a
r Map k a -> k -> a
forall k a. Ord k => Map k a -> k -> a
Map.! k
"PROVIDES"
                  parseProvidedTerm :: FilePath -> (FilePath, FilePath)
parseProvidedTerm FilePath
t = let s :: [FilePath]
s = FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
"=" FilePath
t in ([FilePath]
s [FilePath] -> Getting FilePath [FilePath] FilePath -> FilePath
forall s a. s -> Getting a s a -> a
^. Index [FilePath] -> Traversal' [FilePath] (IxValue [FilePath])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index [FilePath]
0, [FilePath]
s [FilePath] -> Getting FilePath [FilePath] FilePath -> FilePath
forall s a. s -> Getting a s a -> a
^. Index [FilePath] -> Traversal' [FilePath] (IxValue [FilePath])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index [FilePath]
1)
               in case FilePath
-> FilePath
-> Either
     (ParseErrorBundle FilePath Void) (Map FilePath [FilePath])
runDescFieldsParser (Header -> FilePath
Tar.headerFilePath Header
header) FilePath
txt of
                    Right Map FilePath [FilePath]
r -> case [FilePath] -> FilePath
forall a. [a] -> a
head ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ Map FilePath [FilePath]
r Map FilePath [FilePath] -> FilePath -> [FilePath]
forall k a. Ord k => Map k a -> k -> a
Map.! FilePath
"NAME" of
                      FilePath
"ghc" -> FilePath -> (FilePath, FilePath)
parseProvidedTerm (FilePath -> (FilePath, FilePath))
-> [FilePath] -> [(FilePath, FilePath)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map FilePath [FilePath] -> [FilePath]
forall k a. (Ord k, IsString k) => Map k a -> a
provided Map FilePath [FilePath]
r
                      FilePath
"ghc-libs" -> FilePath -> (FilePath, FilePath)
parseProvidedTerm (FilePath -> (FilePath, FilePath))
-> [FilePath] -> [(FilePath, FilePath)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map FilePath [FilePath] -> [FilePath]
forall k a. (Ord k, IsString k) => Map k a -> a
provided Map FilePath [FilePath]
r
                      FilePath
_ -> [([FilePath] -> FilePath
forall a. [a] -> a
head ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ Map FilePath [FilePath]
r Map FilePath [FilePath] -> FilePath -> [FilePath]
forall k a. Ord k => Map k a -> k -> a
Map.! FilePath
"NAME", FilePath -> FilePath
extractVer (FilePath -> FilePath)
-> ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
forall a. [a] -> a
head ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ Map FilePath [FilePath]
r Map FilePath [FilePath] -> FilePath -> [FilePath]
forall k a. Ord k => Map k a -> k -> a
Map.! FilePath
"VERSION")]
                    -- TODO: Drop it
                    Left ParseErrorBundle FilePath Void
_ -> []
            extractVer :: FilePath -> FilePath
extractVer FilePath
ver = [FilePath] -> FilePath
forall a. [a] -> a
head ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$
              FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
"-" (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ case FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
":" FilePath
ver of
                (FilePath
_ : FilePath
v : []) -> FilePath
v
                FilePath
v : [] -> FilePath
v
                [FilePath]
_ -> FilePath -> FilePath
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"err"

        [(CommunityName, FilePath)]
-> ConduitT ByteString (Element [(CommunityName, FilePath)]) m ()
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
yieldMany ([(CommunityName, FilePath)]
 -> ConduitT ByteString (Element [(CommunityName, FilePath)]) m ())
-> [(CommunityName, FilePath)]
-> ConduitT ByteString (Element [(CommunityName, FilePath)]) m ()
forall a b. (a -> b) -> a -> b
$ [(FilePath, FilePath)]
result [(FilePath, FilePath)]
-> ([(FilePath, FilePath)] -> [(CommunityName, FilePath)])
-> [(CommunityName, FilePath)]
forall a b. a -> (a -> b) -> b
& ((FilePath, FilePath) -> Identity (CommunityName, FilePath))
-> [(FilePath, FilePath)] -> Identity [(CommunityName, FilePath)]
forall s t a b. Each s t a b => Traversal s t a b
each (((FilePath, FilePath) -> Identity (CommunityName, FilePath))
 -> [(FilePath, FilePath)] -> Identity [(CommunityName, FilePath)])
-> ((FilePath -> Identity CommunityName)
    -> (FilePath, FilePath) -> Identity (CommunityName, FilePath))
-> (FilePath -> Identity CommunityName)
-> [(FilePath, FilePath)]
-> Identity [(CommunityName, FilePath)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Identity CommunityName)
-> (FilePath, FilePath) -> Identity (CommunityName, FilePath)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((FilePath -> Identity CommunityName)
 -> [(FilePath, FilePath)] -> Identity [(CommunityName, FilePath)])
-> (FilePath -> CommunityName)
-> [(FilePath, FilePath)]
-> [(CommunityName, FilePath)]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FilePath -> CommunityName
CommunityName

-- | Load @community.db@ from @path@.
-- @desc@ files in the db will be parsed by @descParser@.
loadProcessedCommunity :: (MonadUnliftIO m, PrimMonad m, MonadThrow m) => FilePath -> m CommunityDB
loadProcessedCommunity :: FilePath -> m CommunityDB
loadProcessedCommunity FilePath
path = [(CommunityName, FilePath)] -> CommunityDB
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(CommunityName, FilePath)] -> CommunityDB)
-> m [(CommunityName, FilePath)] -> m CommunityDB
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ConduitT () Void (ResourceT m) [(CommunityName, FilePath)]
-> m [(CommunityName, FilePath)]
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes (ConduitT () Void (ResourceT m) [(CommunityName, FilePath)]
 -> m [(CommunityName, FilePath)])
-> ConduitT () Void (ResourceT m) [(CommunityName, FilePath)]
-> m [(CommunityName, FilePath)]
forall a b. (a -> b) -> a -> b
$ FilePath -> ConduitT () (CommunityName, FilePath) (ResourceT m) ()
forall (m :: * -> *) i.
(MonadResource m, PrimMonad m, MonadThrow m) =>
FilePath -> ConduitT i (CommunityName, FilePath) m ()
loadCommunity FilePath
path ConduitT () (CommunityName, FilePath) (ResourceT m) ()
-> ConduitM
     (CommunityName, FilePath)
     Void
     (ResourceT m)
     [(CommunityName, FilePath)]
-> ConduitT () Void (ResourceT m) [(CommunityName, FilePath)]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM
  (CommunityName, FilePath)
  Void
  (ResourceT m)
  [(CommunityName, FilePath)]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList)

-- | Check if a package exists in archlinux community repo.
-- See 'HasMyName'.
isInCommunity :: (HasMyName n, Member CommunityEnv r) => n -> Sem r Bool
isInCommunity :: n -> Sem r Bool
isInCommunity n
name = forall (r :: [Effect]).
MemberWithError (Reader CommunityDB) r =>
Sem r CommunityDB
forall i (r :: [Effect]). MemberWithError (Reader i) r => Sem r i
ask @CommunityDB Sem r CommunityDB -> (CommunityDB -> Sem r Bool) -> Sem r Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CommunityDB
db -> Bool -> Sem r Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Sem r Bool) -> Bool -> Sem r Bool
forall a b. (a -> b) -> a -> b
$ (n -> CommunityName
forall n. HasMyName n => n -> CommunityName
toCommunityName n
name) CommunityName -> CommunityDB -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` CommunityDB
db

-- | Get the version of a package in archlinux community repo.
-- If the package does not exist, 'PkgNotFound' will be thrown.
versionInCommunity :: (HasMyName n, Members [CommunityEnv, WithMyErr] r) => n -> Sem r CommunityVersion
versionInCommunity :: n -> Sem r FilePath
versionInCommunity n
name =
  forall (r :: [Effect]).
MemberWithError (Reader CommunityDB) r =>
Sem r CommunityDB
forall i (r :: [Effect]). MemberWithError (Reader i) r => Sem r i
ask @CommunityDB Sem r CommunityDB
-> (CommunityDB -> Sem r FilePath) -> Sem r FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CommunityDB
db -> case CommunityDB
db CommunityDB -> CommunityName -> Maybe FilePath
forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? (n -> CommunityName
forall n. HasMyName n => n -> CommunityName
toCommunityName n
name) of
    Just FilePath
x -> FilePath -> Sem r FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
x
    Maybe FilePath
_ -> MyException -> Sem r FilePath
forall e (r :: [Effect]) a.
MemberWithError (Error e) r =>
e -> Sem r a
throw (MyException -> Sem r FilePath) -> MyException -> Sem r FilePath
forall a b. (a -> b) -> a -> b
$ n -> MyException
forall n. HasMyName n => n -> MyException
PkgNotFound n
name