mirror of
https://github.com/commercialhaskell/stackage-server.git
synced 2026-01-11 19:58:28 +01:00
Add Haddock style.css and script.js
This commit is contained in:
parent
a9534e5390
commit
60af396f9c
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
1
static/haddock/script.js
Normal file
@ -0,0 +1 @@
|
||||
// FIXME add something here later
|
||||
1
static/haddock/style.css
Normal file
1
static/haddock/style.css
Normal file
@ -0,0 +1 @@
|
||||
/* FIXME add something here later */
|
||||
Loading…
Reference in New Issue
Block a user