<commit_before>module Data.Hackage
    ( loadCabalFiles
    , sourceHackageSdist
    , createView
    , sourceHackageViewSdist
    , sinkUploadHistory
    , UploadState (..)
    , UploadHistory
    , sourceHistory
    ) where

import ClassyPrelude.Yesod hiding (get)
import Types
import Data.BlobStore
import Data.Conduit.Lazy (MonadActive (..), lazyConsume)
import qualified Codec.Archive.Tar as Tar
import Control.Monad.Logger (runNoLoggingT)
import qualified Data.Text as T
import Data.Conduit.Zlib (ungzip, gzip)
import System.IO.Temp (withSystemTempFile, withSystemTempDirectory)
import System.IO (IOMode (ReadMode), openBinaryFile)
import Model (Uploaded (Uploaded), Metadata (..))
import Filesystem (createTree)
import Distribution.PackageDescription.Parse (parsePackageDescription, ParseResult (ParseOk))
import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription)
import Distribution.PackageDescription (GenericPackageDescription)
import qualified Distribution.PackageDescription as PD
import qualified Distribution.Package as PD
import Control.Exception (throw)
import Control.Monad.State.Strict (put, get, execStateT, MonadState)
import Crypto.Hash.Conduit (sinkHash)
import Crypto.Hash (Digest, SHA256)
import Data.Byteable (toBytes)
import Distribution.Text (display)
import Text.Markdown (Markdown (Markdown))
import qualified Data.Traversable as T
import qualified Data.Version
import Text.ParserCombinators.ReadP (readP_to_S)
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
import Text.Blaze.Html (unsafeByteString)
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import qualified Documentation.Haddock.Parser as Haddock
import Documentation.Haddock.Types (DocH (..), Hyperlink (..), Picture (..), Header (..), Example (..))
import qualified Data.HashMap.Lazy as HM

sinkUploadHistory :: Monad m => Consumer (Entity Uploaded) m UploadHistory
sinkUploadHistory =
    foldlC go mempty
  where
    go history (Entity _ (Uploaded name version time)) =
        case lookup name history of
            Nothing -> insertMap name (singletonMap version time) history
            Just vhistory -> insertMap name (insertMap version time vhistory) history

loadCabalFiles :: ( MonadActive m
                  , MonadBaseControl IO m
                  , MonadThrow m
                  , MonadIO m
                  , MonadReader env m
                  , HasHttpManager env
                  , HasBlobStore env StoreKey
                  , HasHackageRoot env
                  , MonadLogger m
                  , MonadMask m
                  )
               => Bool -- ^ do the database updating
               -> Bool -- ^ force updates regardless of hash value?
               -> UploadHistory -- ^ initial
               -> HashMap PackageName (Version, ByteString)
               -> m (UploadState Metadata)
loadCabalFiles dbUpdates forceUpdate uploadHistory0 metadata0 = (>>= runUploadState) $ flip execStateT (UploadState uploadHistory0 [] metadata1 mempty) $ do
    HackageRoot root <- liftM getHackageRoot ask
    $logDebug $ "Entering loadCabalFiles, root == " ++ root
    req <- parseUrl $ unpack $ root ++ "/00-index.tar.gz"
    withSystemTempFile "hackage-index" $ \tempIndex handleOut -> do
        $logDebug $ "Requesting: " ++ tshow req
        withResponse req $ \res -> responseBody res $$ sinkHandle handleOut
        liftIO $ hClose handleOut
        withBinaryFile tempIndex ReadMode $ \handleIn -> do
            bss <- lazyConsume $ sourceHandle handleIn $= ungzip
            tarSource (Tar.read $ fromChunks bss)
                $$ parMapMC 32 go
                =$ scanlC (\x _ -> x + 1) (0 :: Int)
                =$ filterC ((== 0) . (`mod` 1000))
                =$ mapM_C (\i -> $logInfo $ "Processing cabal file #" ++ tshow i)
  where
    metadata1 = flip fmap metadata0 $ \(v, h) -> MetaSig
        v
        (fromMaybe (pack [0, 0, 0]) $ readVersion v)
        h
    withBinaryFile fp mode = bracket (liftIO $ openBinaryFile fp mode) (liftIO . hClose)

    go entry = do
        case Tar.entryContent entry of
            Tar.NormalFile lbs _
                | Just (name, version) <- parseFilePath (Tar.entryPath entry) -> do
                    let key = HackageCabal name version
                    -- It's not longer sufficient to simply check if the cabal
                    -- file exists, since Hackage now allows updating in place.
                    -- Instead, we have to check if it matches what we have
                    -- and, if not, update it.
                    store <- liftM getBlobStore ask
                    newDigest :: Digest SHA256 <- sourceLazy lbs $$ sinkHash<commit_msg>A little more debug output<commit_after>module Data.Hackage
    ( loadCabalFiles
    , sourceHackageSdist
    , createView
    , sourceHackageViewSdist
    , sinkUploadHistory
    , UploadState (..)
    , UploadHistory
    , sourceHistory
    ) where

import ClassyPrelude.Yesod hiding (get)
import Types
import Data.BlobStore
import Data.Conduit.Lazy (MonadActive (..), lazyConsume)
import qualified Codec.Archive.Tar as Tar
import Control.Monad.Logger (runNoLoggingT)
import qualified Data.Text as T
import Data.Conduit.Zlib (ungzip, gzip)
import System.IO.Temp (withSystemTempFile, withSystemTempDirectory)
import System.IO (IOMode (ReadMode), openBinaryFile)
import Model (Uploaded (Uploaded), Metadata (..))
import Filesystem (createTree)
import Distribution.PackageDescription.Parse (parsePackageDescription, ParseResult (ParseOk))
import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription)
import Distribution.PackageDescription (GenericPackageDescription)
import qualified Distribution.PackageDescription as PD
import qualified Distribution.Package as PD
import Control.Exception (throw)
import Control.Monad.State.Strict (put, get, execStateT, MonadState)
import Crypto.Hash.Conduit (sinkHash)
import Crypto.Hash (Digest, SHA256)
import Data.Byteable (toBytes)
import Distribution.Text (display)
import Text.Markdown (Markdown (Markdown))
import qualified Data.Traversable as T
import qualified Data.Version
import Text.ParserCombinators.ReadP (readP_to_S)
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
import Text.Blaze.Html (unsafeByteString)
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import qualified Documentation.Haddock.Parser as Haddock
import Documentation.Haddock.Types (DocH (..), Hyperlink (..), Picture (..), Header (..), Example (..))
import qualified Data.HashMap.Lazy as HM

sinkUploadHistory :: Monad m => Consumer (Entity Uploaded) m UploadHistory
sinkUploadHistory =
    foldlC go mempty
  where
    go history (Entity _ (Uploaded name version time)) =
        case lookup name history of
            Nothing -> insertMap name (singletonMap version time) history
            Just vhistory -> insertMap name (insertMap version time vhistory) history

loadCabalFiles :: ( MonadActive m
                  , MonadBaseControl IO m
                  , MonadThrow m
                  , MonadIO m
                  , MonadReader env m
                  , HasHttpManager env
                  , HasBlobStore env StoreKey
                  , HasHackageRoot env
                  , MonadLogger m
                  , MonadMask m
                  )
               => Bool -- ^ do the database updating
               -> Bool -- ^ force updates regardless of hash value?
               -> UploadHistory -- ^ initial
               -> HashMap PackageName (Version, ByteString)
               -> m (UploadState Metadata)
loadCabalFiles dbUpdates forceUpdate uploadHistory0 metadata0 = (>>= runUploadState) $ flip execStateT (UploadState uploadHistory0 [] metadata1 mempty) $ do
    HackageRoot root <- liftM getHackageRoot ask
    $logDebug $ "Entering loadCabalFiles, root == " ++ root
    req <- parseUrl $ unpack $ root ++ "/00-index.tar.gz"
    withSystemTempFile "hackage-index" $ \tempIndex handleOut -> do
        $logDebug $ "Requesting: " ++ tshow req
        withResponse req $ \res -> responseBody res $$ sinkHandle handleOut
        liftIO $ hClose handleOut
        withBinaryFile tempIndex ReadMode $ \handleIn -> do
            bss <- lazyConsume $ sourceHandle handleIn $= ungzip
            tarSource (Tar.read $ fromChunks bss)
                $$ parMapMC 32 go
                =$ scanlC (\x _ -> x + 1) (0 :: Int)
                =$ filterC ((== 0) . (`mod` 1000))
                =$ mapM_C (\i -> $logInfo $ "Processing cabal file #" ++ tshow i)
    $logInfo "Finished processing cabal files"
  where
    metadata1 = flip fmap metadata0 $ \(v, h) -> MetaSig
        v
        (fromMaybe (pack [0, 0, 0]) $ readVersion v)
        h
    withBinaryFile fp mode = bracket (liftIO $ openBinaryFile fp mode) (liftIO . hClose)

    go entry = do
        case Tar.entryContent entry of
            Tar.NormalFile lbs _
                | Just (name, version) <- parseFilePath (Tar.entryPath entry) -> do
                    let key = HackageCabal name version
                    -- It's not longer sufficient to simply check if the cabal
                    -- file exists, since Hackage now allows updating in place.
                    -- Instead, we have to check if it matches what we have
                    -- and, if not, update it.
                    store <- liftM getBlobStore ask
                    newDigest :: Digest SHA256 <- sourceLazy lbs $$ sinkHash
{'fraction_non_alphanumeric': 0.08326298016040523, 'fraction_numerical': 0.006120726044744618, 'mean_word_length': 2.5520989505247376, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 37, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '863978', 'n_tokens_mistral': 2668, 'n_tokens_neox': 2531, 'n_words': 826}