Add Haddock style.css and script.js

This commit is contained in:
Michael Snoyman 2016-05-02 14:18:27 +03:00
parent a9534e5390
commit 60af396f9c
5 changed files with 47 additions and 2 deletions

View file

@ -1,12 +1,53 @@
module Handler.Haddock
( getHaddockR
, getHaddockBackupR
) where
import Import
import Stackage.Database
import Text.HTML.TagStream.Types (Token' (..))
import Text.HTML.TagStream.ByteString (tokenStream, showToken)
getHaddockR :: SnapName -> [Text] -> Handler ()
getHaddockR slug rest = redirect $ concat
makeURL :: SnapName -> [Text] -> Text
makeURL slug rest = concat
$ "http://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
$ "http://haddock.stackage.org"
: map (cons '/') rest

View file

@ -28,6 +28,7 @@
/system SystemR GET
/haddock/#SnapName/*Texts HaddockR GET
!/haddock/*Texts HaddockBackupR GET
/package/#PackageName PackageR GET
/package/#PackageName/snapshots PackageSnapshotsR GET
/package/#PackageName/badge/#SnapshotBranch PackageBadgeR GET

View file

@ -125,6 +125,7 @@ library
, shakespeare >= 2.0 && < 2.1
, system-fileio >= 0.3 && < 0.4
, system-filepath >= 0.4 && < 0.5
, tagstream-conduit
, tar >= 0.5 && < 0.6
, template-haskell >= 2.10 && < 2.11
, temporary-rc >= 1.2 && < 1.3

1
static/haddock/script.js Normal file
View file

@ -0,0 +1 @@
// FIXME add something here later

1
static/haddock/style.css Normal file
View file

@ -0,0 +1 @@
/* FIXME add something here later */