{-# LANGUAGE OverloadedStrings #-}

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

import Conduit
import Control.Monad (when)
import qualified Data.Conduit.Tar as Tar
import qualified Data.Conduit.Zlib as Zlib
import Data.List (intercalate)
import Data.List.Split (splitOn)
import qualified Data.Set as Set
import Distribution.ArchHs.Types
import Distribution.ArchHs.Utils (toLower')
import Distribution.Types.PackageName (PackageName, unPackageName)
import System.FilePath ((</>))

-- | 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 FilePath m ()
loadCommunity :: FilePath -> ConduitT i 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 FilePath m () -> ConduitT i 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 FilePath m ()
-> ConduitM ByteString 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 FilePath m ()
-> ConduitM ByteString 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 FilePath m ())
-> ConduitM TarChunk FilePath m ()
forall (m :: * -> *) o.
MonadThrow m =>
(Header -> ConduitM ByteString o m ()) -> ConduitM TarChunk o m ()
Tar.withEntries Header -> ConduitM ByteString FilePath m ()
forall (m :: * -> *) i.
Monad m =>
Header -> ConduitT i FilePath m ()
action
  where
    action :: Header -> ConduitT i FilePath m ()
action Header
header =
      Bool -> ConduitT i FilePath m () -> ConduitT i 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 i FilePath m () -> ConduitT i FilePath m ())
-> ConduitT i FilePath m () -> ConduitT i FilePath m ()
forall a b. (a -> b) -> a -> b
$
        FilePath -> ConduitT i FilePath m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (FilePath -> ConduitT i FilePath m ())
-> FilePath -> ConduitT i FilePath m ()
forall a b. (a -> b) -> a -> b
$ Header -> FilePath
Tar.headerFilePath Header
header

cookCommunity :: (Monad m) => ConduitT FilePath FilePath m ()
cookCommunity :: ConduitT FilePath FilePath m ()
cookCommunity = (FilePath -> FilePath) -> ConduitT FilePath FilePath m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC ([FilePath] -> FilePath
go ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
"-"))
  where
    go :: [FilePath] -> FilePath
go [FilePath]
list = case [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
list of
      Int
3 -> [FilePath]
list [FilePath] -> Int -> FilePath
forall a. [a] -> Int -> a
!! Int
0
      Int
s ->
        if [FilePath]
list [FilePath] -> Int -> FilePath
forall a. [a] -> Int -> a
!! Int
0 FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"haskell"
          then FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"-" ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath], [FilePath]) -> [FilePath]
forall a b. (a, b) -> a
fst (([FilePath], [FilePath]) -> [FilePath])
-> ([FilePath] -> ([FilePath], [FilePath]))
-> [FilePath]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [FilePath] -> ([FilePath], [FilePath])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) ([FilePath] -> ([FilePath], [FilePath]))
-> ([FilePath] -> [FilePath])
-> [FilePath]
-> ([FilePath], [FilePath])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. [a] -> [a]
tail ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
list
          else FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"-" ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath], [FilePath]) -> [FilePath]
forall a b. (a, b) -> a
fst (([FilePath], [FilePath]) -> [FilePath])
-> ([FilePath] -> ([FilePath], [FilePath]))
-> [FilePath]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [FilePath] -> ([FilePath], [FilePath])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
list

-- | Load @community.db@ from @path@, removing @haskell-@ prefix.
loadProcessedCommunity :: (MonadUnliftIO m, PrimMonad m, MonadThrow m) => FilePath -> m CommunityDB
loadProcessedCommunity :: FilePath -> m CommunityDB
loadProcessedCommunity FilePath
path = ([FilePath] -> CommunityDB) -> m [FilePath] -> m CommunityDB
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> CommunityDB
forall a. Ord a => [a] -> Set a
Set.fromList (m [FilePath] -> m CommunityDB) -> m [FilePath] -> m CommunityDB
forall a b. (a -> b) -> a -> b
$ ConduitT () Void (ResourceT m) [FilePath] -> m [FilePath]
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes (ConduitT () Void (ResourceT m) [FilePath] -> m [FilePath])
-> ConduitT () Void (ResourceT m) [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> ConduitT () FilePath (ResourceT m) ()
forall (m :: * -> *) i.
(MonadResource m, PrimMonad m, MonadThrow m) =>
FilePath -> ConduitT i FilePath m ()
loadCommunity FilePath
path ConduitT () FilePath (ResourceT m) ()
-> ConduitM FilePath Void (ResourceT m) [FilePath]
-> ConduitT () Void (ResourceT m) [FilePath]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT FilePath FilePath (ResourceT m) ()
forall (m :: * -> *). Monad m => ConduitT FilePath FilePath m ()
cookCommunity ConduitT FilePath FilePath (ResourceT m) ()
-> ConduitM FilePath Void (ResourceT m) [FilePath]
-> ConduitM FilePath Void (ResourceT m) [FilePath]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM FilePath Void (ResourceT m) [FilePath]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList

-- | Check if a package from hackage exists in archlinux community repo.
-- The following name conversion occurs during the checking to work with 'loadProcessedCommunity'.
--
-- >>> "aeson" --> "aeson"
-- >>> "Cabal" --> "cabal"
-- >>> "haskell-a" --> "a"
isInCommunity :: Member CommunityEnv r => PackageName -> Sem r Bool
isInCommunity :: PackageName -> Sem r Bool
isInCommunity PackageName
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
$ case FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
"-" (FilePath -> [FilePath])
-> (PackageName -> FilePath) -> PackageName -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> FilePath
unPackageName (PackageName -> [FilePath]) -> PackageName -> [FilePath]
forall a b. (a -> b) -> a -> b
$ PackageName
name of
      (FilePath
"haskell" : [FilePath]
xs) -> FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"-" [FilePath]
xs FilePath -> CommunityDB -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` CommunityDB
db
      [FilePath]
_ -> (FilePath -> FilePath
toLower' (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ PackageName -> FilePath
unPackageName PackageName
name) FilePath -> CommunityDB -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` CommunityDB
db