<commit_before>{-# LANGUAGE NoImplicitPrelude #-}
module Handler.Haddock
    ( getHaddockR
    , getHaddockBackupR
    ) where

import Import
import qualified Data.Text as T (takeEnd)
import Stackage.Database
import Stackage.Database.Types (haddockBucketName)

makeURL :: SnapName -> [Text] -> Text
makeURL snapName rest = concat
    $ "https://s3.amazonaws.com/"
    : haddockBucketName
    : "/"
    : toPathPiece snapName
    : map (cons '/') rest

shouldRedirect :: Bool
shouldRedirect = False

data DocType = DocHtml | DocJson

getHaddockR :: SnapName -> [Text] -> Handler TypedContent
getHaddockR snapName rest
    | shouldRedirect = do
        result <- redirectWithVersion snapName rest
        case result of
            Just route -> redirect route
            Nothing -> redirect $ makeURL snapName rest
    | Just docType <- mdocType = do
        result <- redirectWithVersion snapName rest
        case result of
            Just route -> redirect route
            Nothing -> do
                (contentType, plain) <-
                    case docType of
                        DocHtml -> do
                            mstyle <- lookupGetParam "style"
                            return ("text/html; charset=utf-8", mstyle == Just "plain")
                        DocJson ->
                            return ("application/jsontml; charset=utf-8", True)
                req <- parseRequest $ unpack $ makeURL snapName rest
                man <- getHttpManager <$> getYesod
                (_, res) <- runReaderT (acquireResponse req >>= allocateAcquire) man
                if plain
                    then respondSource contentType $ responseBody res .| mapC (Chunk . toBuilder)
                    else do
                        extra <- getExtra
                        respondSource contentType $
                            responseBody res .|
                            (do takeUntilChunk "</head>"
                                peekC >>= maybe (return ()) (const $ yield $ encodeUtf8 extra)
                                mapC id) .|
                            mapC (Chunk . toBuilder)
    | otherwise = redirect $ makeURL snapName rest
  where<commit_msg>Disable custom Haddock style by default #278<commit_after>{-# LANGUAGE NoImplicitPrelude #-}
module Handler.Haddock
    ( getHaddockR
    , getHaddockBackupR
    ) where

import Import
import qualified Data.Text as T (takeEnd)
import Stackage.Database
import Stackage.Database.Types (haddockBucketName)

makeURL :: SnapName -> [Text] -> Text
makeURL snapName rest = concat
    $ "https://s3.amazonaws.com/"
    : haddockBucketName
    : "/"
    : toPathPiece snapName
    : map (cons '/') rest

shouldRedirect :: Bool
shouldRedirect = False

data DocType = DocHtml | DocJson

getHaddockR :: SnapName -> [Text] -> Handler TypedContent
getHaddockR snapName rest
    | shouldRedirect = do
        result <- redirectWithVersion snapName rest
        case result of
            Just route -> redirect route
            Nothing -> redirect $ makeURL snapName rest
    | Just docType <- mdocType = do
        result <- redirectWithVersion snapName rest
        case result of
            Just route -> redirect route
            Nothing -> do
                (contentType, plain) <-
                    case docType of
                        DocHtml -> do
                            mstyle <- lookupGetParam "style"
                            return ("text/html; charset=utf-8", mstyle /= Just "stackage")
                        DocJson ->
                            return ("application/jsontml; charset=utf-8", True)
                req <- parseRequest $ unpack $ makeURL snapName rest
                man <- getHttpManager <$> getYesod
                (_, res) <- runReaderT (acquireResponse req >>= allocateAcquire) man
                if plain
                    then respondSource contentType $ responseBody res .| mapC (Chunk . toBuilder)
                    else do
                        extra <- getExtra
                        respondSource contentType $
                            responseBody res .|
                            (do takeUntilChunk "</head>"
                                peekC >>= maybe (return ()) (const $ yield $ encodeUtf8 extra)
                                mapC id) .|
                            mapC (Chunk . toBuilder)
    | otherwise = redirect $ makeURL snapName rest
  where
{'fraction_non_alphanumeric': 0.07913832199546485, 'fraction_numerical': 0.002494331065759637, 'mean_word_length': 1.5379746835443038, 'pattern_counts': {'":': 0, '<': 25, '<?xml version=': 0, '>': 35, 'https://': 2, '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': '3182301', 'n_tokens_mistral': 1138, 'n_tokens_neox': 1075, 'n_words': 329}