<commit_before>module Handler.Haddock
    ( getHaddockR
    , getHaddockBackupR
    ) where

import Import
import Stackage.Database
import Text.HTML.TagStream.Types (Token' (..))
import Text.HTML.TagStream.ByteString (tokenStream, showToken)

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

getHaddockR :: SnapName -> [Text] -> Handler TypedContent
getHaddockR slug rest
  | final:_ <- reverse rest, ".html" `isSuffixOf` final = do
      render <- getUrlRender

      let stylesheet = encodeUtf8 $ render $ StaticR haddock_style_css
          script = encodeUtf8 $ render $ StaticR haddock_script_js

          addExtra t@(TagClose "head") =
            [ TagOpen "link"
                [ ("rel", "stylesheet")
                , ("href", stylesheet)
                ]
                False
            , TagOpen "script"
                [ ("src", script)
                ]
                False
            , TagClose "script"
            , t
            ]
          addExtra t = [t]

      req <- parseUrl $ unpack $ makeURL slug rest
      (_, res) <- acquireResponse req >>= allocateAcquire

      respondSource typeHtml
         $ responseBody res
        $= tokenStream
        $= concatMapC addExtra
        $= mapC (Chunk . showToken id)
  | otherwise = redirect $ makeURL slug rest

getHaddockBackupR :: [Text] -> Handler ()
getHaddockBackupR rest = redirect $ concat
    $ "https://s3.amazonaws.com/haddock.stackage.org"<commit_msg>Workaround for #176<commit_after>module Handler.Haddock
    ( getHaddockR
    , getHaddockBackupR
    ) where

import Import
import Stackage.Database
import Text.HTML.TagStream.Types (Token' (..))
import Text.HTML.TagStream.ByteString (tokenStream, showToken)

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

shouldRedirect :: Bool
shouldRedirect = True

getHaddockR :: SnapName -> [Text] -> Handler TypedContent
getHaddockR slug rest
  | shouldRedirect = redirect $ makeURL slug rest
  | final:_ <- reverse rest, ".html" `isSuffixOf` final = do
      render <- getUrlRender

      let stylesheet = encodeUtf8 $ render $ StaticR haddock_style_css
          script = encodeUtf8 $ render $ StaticR haddock_script_js

          addExtra t@(TagClose "head") =
            [ TagOpen "link"
                [ ("rel", "stylesheet")
                , ("href", stylesheet)
                ]
                False
            , TagOpen "script"
                [ ("src", script)
                ]
                False
            , TagClose "script"
            , t
            ]
          addExtra t = [t]

      req <- parseUrl $ unpack $ makeURL slug rest
      (_, res) <- acquireResponse req >>= allocateAcquire

      respondSource typeHtml
         $ responseBody res
        $= tokenStream
        $= concatMapC addExtra
        -- FIXME showToken does not encode HTML entities
        $= mapC (Chunk . showToken id)
  | otherwise = redirect $ makeURL slug rest

getHaddockBackupR :: [Text] -> Handler ()
getHaddockBackupR rest = redirect $ concat
    $ "https://s3.amazonaws.com/haddock.stackage.org"
{'fraction_non_alphanumeric': 0.10441400304414003, 'fraction_numerical': 0.0033485540334855404, 'mean_word_length': 2.1, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 17, 'https://': 4, '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': '2711500', 'n_tokens_mistral': 1013, 'n_tokens_neox': 953, 'n_words': 243}