-
Notifications
You must be signed in to change notification settings - Fork 113
/
ServeFile.hs
140 lines (116 loc) · 4.95 KB
/
ServeFile.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module ServeFile where
import Control.Monad.Trans (liftIO)
import qualified Data.List as List
import qualified Data.Text.Lazy as Text
import Snap.Core (Snap, writeBuilder)
import Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes as A
import qualified Text.Blaze.Html.Renderer.Utf8 as Blaze
import qualified Elm.Compiler.Module as Module
import qualified Elm.Package.Name as N
import qualified Elm.Package.Version as V
import qualified PackageSummary as PkgSummary
import qualified Path
filler :: Module.Name -> Snap ()
filler name =
writeBuilder $
Blaze.renderHtmlBuilder $
docTypeHtml $ do
H.head $ do
meta ! charset "UTF-8"
H.title (toHtml (Module.nameToString name))
H.style $ preEscapedToMarkup standardStyle
script ! src (toValue ("/" ++ Path.artifact name)) $ ""
body $
script $ preEscapedToMarkup $
"Elm.fullscreen(Elm." ++ Module.nameToString name ++ ")"
analytics
packageDocs :: N.Name -> V.Version -> Snap ()
packageDocs pkg@(N.Name user name) version =
do maybeVersions <- liftIO (PkgSummary.readVersionsOf pkg)
let versionList =
maybe [] (List.map V.toString) maybeVersions
writeBuilder $
Blaze.renderHtmlBuilder $
docTypeHtml $ do
H.head $ do
meta ! charset "UTF-8"
H.title "Elm Package Documentation"
H.style $ preEscapedToMarkup standardStyle
script ! src "/artifacts/Page-PackageDocs.js" $ ""
link ! rel "stylesheet" ! href "/assets/highlight/styles/github.css"
script ! src "/assets/highlight/highlight.pack.js" $ ""
body $ script $ preEscapedToMarkup $
context
[ ("user", show user)
, ("name", show name)
, ("version", show (V.toString version))
, ("versionList", show versionList)
]
++ "var page = Elm.fullscreen(Elm.Page.PackageDocs, { context: context });\n"
analytics
moduleDocs :: N.Name -> V.Version -> Module.Name -> Snap ()
moduleDocs pkg@(N.Name user name) version moduleName =
do maybeVersions <- liftIO (PkgSummary.readVersionsOf pkg)
let versionList =
maybe [] (List.map V.toString) maybeVersions
writeBuilder $
Blaze.renderHtmlBuilder $
docTypeHtml $ do
H.head $ do
meta ! charset "UTF-8"
H.title "Elm Package Documentation"
H.style $ preEscapedToMarkup standardStyle
script ! src "/artifacts/Page-ModuleDocs.js" $ ""
link ! rel "stylesheet" ! href "/assets/highlight/styles/github.css"
script ! src "/assets/highlight/highlight.pack.js" $ ""
body $ script $ preEscapedToMarkup $
context
[ ("user", show user)
, ("name", show name)
, ("version", show (V.toString version))
, ("versionList", show versionList)
, ("moduleName", show (Module.nameToString moduleName))
]
++ "var page = Elm.fullscreen(Elm.Page.ModuleDocs, { context: context });\n"
analytics
context :: [(String, String)] -> String
context pairs =
"\nvar context = { " ++ List.intercalate ", " (List.map (\(k,v) -> k ++ ": " ++ v) pairs) ++ " };\n"
standardStyle :: Text.Text
standardStyle =
"html,head,body { padding:0; margin:0; }\n\
\body { font-family: 'Lucida Grande','Trebuchet MS','Bitstream Vera Sans',Verdana,Helvetica,sans-serif; }\n\
\a:link {text-decoration: none; color: rgb(15,102,230);}\n\
\a:visited {text-decoration: none; color: rgb(15,102,230);}\n\
\a:active {text-decoration: none}\n\
\a:hover { text-decoration: underline; color: rgb(234,21,122); }\n\
\h1,h2,h3,h4 { font-weight:normal; font-family: futura, 'century gothic', 'twentieth century', calibri, verdana, helvetica, arial; }\n\
\p, li {\n\
\ font-size: 14px !important;\n\
\ line-height: 1.5em !important;\n\
\}\n\
\pre {\n\
\ margin: 0;\n\
\ padding: 10px;\n\
\ background-color: rgb(254,254,254);\n\
\ border-style: solid;\n\
\ border-width: 1px;\n\
\ border-color: rgb(245,245,245);\n\
\ border-radius: 6px;\n\
\}\n"
-- | Add analytics to a page.
analytics :: Html
analytics =
script ! type_ "text/javascript" $
"var _gaq = _gaq || [];\n\
\_gaq.push(['_setAccount', 'UA-25827182-1']);\n\
\_gaq.push(['_setDomainName', 'package.elm-lang.org']);\n\
\_gaq.push(['_trackPageview']);\n\
\(function() {\n\
\ var ga = document.createElement('script'); ga.type = 'text/javascript'; ga.async = true;\n\
\ ga.src = ('https:' == document.location.protocol ? 'https://ssl' : 'http://www') + '.google-analytics.com/ga.js';\n\
\ var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s);\n\
\})();"