module Stackage.PackageIndex.Conduit
( sourceTarFile
, sourceAllCabalFiles
, parseDistText
, renderDistText
, CabalFileEntry (..)
) where
import qualified Codec.Archive.Tar as Tar
import Codec.Compression.GZip (decompress)
import Control.Monad (guard)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Resource (MonadResource, throwM)
import qualified Data.ByteString.Lazy as L
import Data.Conduit (Producer, bracketP,
yield, (=$=))
import qualified Data.Conduit.List as CL
import Data.Text.Encoding.Error (lenientDecode)
import qualified Data.Text.Lazy as TL
import Data.Text.Lazy.Encoding (decodeUtf8With)
import Data.Version (Version)
import Distribution.Compat.ReadP (readP_to_S)
import Distribution.Package (PackageName)
import Distribution.PackageDescription (GenericPackageDescription)
import Distribution.PackageDescription.Parse (ParseResult,
parsePackageDescription)
import Distribution.Text (disp, parse)
import qualified Distribution.Text
import System.IO (IOMode (ReadMode),
hClose, openBinaryFile)
import Text.PrettyPrint (render)
sourceTarFile :: MonadResource m
=> Bool
-> FilePath
-> Producer m Tar.Entry
sourceTarFile toUngzip fp = do
bracketP (openBinaryFile fp ReadMode) hClose $ \h -> do
lbs <- liftIO $ L.hGetContents h
loop $ Tar.read $ ungzip' lbs
where
ungzip'
| toUngzip = decompress
| otherwise = id
loop Tar.Done = return ()
loop (Tar.Fail e) = throwM e
loop (Tar.Next e es) = yield e >> loop es
data CabalFileEntry = CabalFileEntry
{ cfeName :: !PackageName
, cfeVersion :: !Version
, cfeRaw :: L.ByteString
, cfeEntry :: Tar.Entry
, cfeParsed :: ParseResult GenericPackageDescription
}
sourceAllCabalFiles
:: MonadResource m
=> IO FilePath
-> Producer m CabalFileEntry
sourceAllCabalFiles getIndexTar = do
tarball <- liftIO $ getIndexTar
sourceTarFile False tarball =$= CL.mapMaybe go
where
go e =
case (toPkgVer $ Tar.entryPath e, Tar.entryContent e) of
(Just (name, version), Tar.NormalFile lbs _) -> Just CabalFileEntry
{ cfeName = name
, cfeVersion = version
, cfeRaw = lbs
, cfeEntry = e
, cfeParsed = parsePackageDescription $ TL.unpack $ decodeUtf8With lenientDecode lbs
}
_ -> Nothing
toPkgVer s0 = do
(name', '/':s1) <- Just $ break (== '/') s0
(version', '/':s2) <- Just $ break (== '/') s1
guard $ s2 == (name' ++ ".cabal")
name <- parseDistText name'
version <- parseDistText version'
Just (name, version)
parseDistText :: (Monad m, Distribution.Text.Text t) => String -> m t
parseDistText s =
case map fst $ filter (null . snd) $ readP_to_S parse s of
[x] -> return x
_ -> fail $ "Could not parse: " ++ s
renderDistText :: Distribution.Text.Text t => t -> String
renderDistText = render . disp