{-# LANGUAGE OverloadedStrings #-}
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 ((</>))
defaultCommunityPath :: FilePath
= 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 ()
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 ()
= (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
loadProcessedCommunity :: (MonadUnliftIO m, PrimMonad m, MonadThrow m) => FilePath -> m CommunityDB
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
isInCommunity :: Member CommunityEnv r => PackageName -> Sem r Bool
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