Permalink
Browse files

Use highlight.js for the … other languages.

  • Loading branch information...
1 parent 891114f commit 8a29c84edd795e5a178f42b2b379dab8aaaf1be6 @chrisdone chrisdone committed Jun 14, 2011
Showing with 70 additions and 40 deletions.
  1. +1 −1 src/Amelie/View/Highlight.hs
  2. +3 −0 src/Amelie/View/Layout.hs
  3. +48 −26 src/Amelie/View/Style.hs
  4. +17 −13 src/Text/CSS.hs
  5. +1 −0 wwwroot/js/highlight.pack.js
@@ -25,6 +25,6 @@ highlightPaste langs Paste{..} =
case lang of
Just (Language{languageName="haskell"}) ->
preEscapedString $ hscolour False (unpack pastePaste)
- _ -> pre $ toHtml pastePaste
+ _ -> pre $ code $ toHtml pastePaste
where lang = find ((==pasteLanguage) . Just . languageId) langs
@@ -25,7 +25,10 @@ layoutPage Page{..} = do
link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href "/css/amelie.css"
js "jquery.js"
js "amelie.js"
+ js "highlight.pack.js"
title $ toHtml $ pageTitle ++ " :: hpaste — Haskell Pastebin"
+ script $
+ "hljs.tabReplace = ' ';hljs.initHighlightingOnLoad();"
body ! A.id (toValue pageName) $
wrap $ do
nav
View
@@ -32,9 +32,9 @@ footer :: CSS Rule
footer = do
classRule "footer" $ do
textAlign "center"
- subRule "a" $ do
+ rule "a" $ do
textDecoration "none"
- subRule "a:hover" $ do
+ rule "a:hover" $ do
textDecoration "underline"
-- | General layout styles.
@@ -71,19 +71,19 @@ form = do
inputs :: CSS Rule
inputs =
rule "form p label" $ do
- subRule "textarea" $ do
+ rule "textarea" $ do
width "100%"
height "20em"
clear "both"
margin "1em 0 0 0"
- subRule "textarea, input.text" $ do
+ rule "textarea, input.text" $ do
border "2px solid #ddd"
borderRadius "4px"
- subRule "textarea:focus, input.text:focus" $ do
+ rule "textarea:focus, input.text:focus" $ do
background "#eee"
- subRule "span" $ do
+ rule "span" $ do
float "left"
width "7em"
display "block"
@@ -97,7 +97,7 @@ sections = do
border "3px solid #000"
margin "0 0 0.5em 0"
- subRule "h2" $ do
+ rule "h2" $ do
margin "0"
fontSize "1.2em"
padding "0"
@@ -107,41 +107,41 @@ sections = do
borderColor "#A9A0D2"
color "#FFF"
- subRule "h2" $ do
+ rule "h2" $ do
color "#FFF"
- subRule "a" $ do
+ rule "a" $ do
color "#8ae0c2"
textDecoration "none"
- subRule "a:hover" $ do
+ rule "a:hover" $ do
textDecoration "underline"
classRule "section-light" $ do
background "#FFF"
borderColor "#EEE"
color "#000"
- subRule "h2" $ do
+ rule "h2" $ do
color "#2D2542"
classRule "section-error" $ do
background "#FFDFDF"
color "#5b4444"
border "1px solid #EFB3B3"
- subRule "pre" $ do
+ rule "pre" $ do
margin "0"
- subRule "h2" $ do
+ rule "h2" $ do
color "#2D2542"
classRule "section-warn" $ do
background "#FFF9C7"
color "#915c31"
border "1px solid #FFF178"
- subRule "pre" $ do
+ rule "pre" $ do
margin "0"
- subRule "h2" $ do
+ rule "h2" $ do
color "#2D2542"
-- | Paste view styles.
@@ -153,7 +153,7 @@ paste = do
listStyle "none"
lineHeight "1.5em"
- subRule "strong" $ do
+ rule "strong" $ do
fontWeight "normal"
width "8em"
display "block"
@@ -179,10 +179,10 @@ highlighter = do
tokens
lineNumbers
- subRule "pre" $ do
+ rule "pre" $ do
margin "0"
- subRule "td" $ do
+ rule "td" $ do
verticalAlign "top"
-- | Style for diff groups.
@@ -199,26 +199,48 @@ diff = do
-- | Tokens colours and styles.
tokens :: CSS (Either Property Rule)
tokens = do
- subRule "pre" $ do
+ rule "pre" $ do
marginTop "0"
tokenColor "comment" "#555"
tokenColor "keyword" "#397460"
tokenColor "str" "#366354"
tokenColor "conid" "#4F4371"
tokenColor "varop" "#333"
tokenColor "varid" "#333"
-
- where token name props = subRule (".hs-" ++ name) $ props
+ rule "pre" $ do
+ rule ".diff" $ do
+ color "#555"
+ rule "code" $ do
+ jcolor "title" "#333"
+ jcolor "string" "#366354"
+ jcolor "built_in" "#397460"
+ jcolor "preprocessor" "#4F4371"
+ jcolor "comment" "#555"
+ jcolor "command" "#397460"
+ jcolor "special" "#333"
+ jcolor "formula" "#4F4371"
+ jcolor "keyword" "#397460"
+ jcolor "number" "#4F4371"
+ rule ".header" $ do
+ color "#555"
+ rule ".addition" $ do
+ backgroundColor "#FDD"
+ color "#695B5B"
+ rule ".deletion" $ do
+ backgroundColor "#DFD"
+ color "#000"
+ where token name props = rule (".hs-" ++ name) $ props
tokenColor name col = token name $ color col
+ jcolor name col = rule ("." ++ name) $ color col
-- | The line number part.
lineNumbers :: CSS (Either Property Rule)
lineNumbers = do
- subRule ".linenodiv" $ do
+ rule ".linenodiv" $ do
margin "0 1em 0 0"
textAlign "right"
- subRule "a" $ do
+ rule "a" $ do
textDecoration "none"
color "#555"
@@ -231,7 +253,7 @@ home = do
classRule "latest-pastes" $ do
marginTop "0.5em"
- where wrap = subRule ".amelie-wrap" $ do
+ where wrap = rule ".amelie-wrap" $ do
width "50em"
-- | Browse page styles.
@@ -241,15 +263,15 @@ browse = do
textAlign "center"
margin "1em"
- subRule ".amelie-inner" $ do
+ rule ".amelie-inner" $ do
margin "auto"
width "15em"
-- | Developer activity page styles.
activity :: CSS Rule
activity = do
rule "#activity" $ do
- subRule ".amelie-wrap" $ do
+ rule ".amelie-wrap" $ do
width "50em"
-- | Hlint hints
View
@@ -2,6 +2,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE FlexibleInstances #-}
-- | CSS generation.
module Text.CSS
@@ -10,8 +11,8 @@ module Text.CSS
,runCSS
,renderCSS
,renderPrettyCSS
- ,rule
- ,subRule)
+ ,rules
+ ,rule)
where
import Text.CSS.Properties
@@ -52,20 +53,23 @@ renderPrettyCSS :: [Rule] -> Text
renderPrettyCSS = mconcat . map renderRule where
renderRule (Rule name props sub) =
name ++ "{\n" ++ renderProps props ++ "\n}" ++ "\n" ++
- renderCSS (map prefix sub)
+ renderPrettyCSS (map prefix sub)
where prefix subr@Rule{ruleExpr} =
subr { ruleExpr = name ++ " " ++ ruleExpr }
renderProps = T.intercalate ";\n" . map ((" "++) . renderProp)
renderProp (Property name value) = name ++ ": " ++ value
--- | Make a CSS rule.
-rule :: Text -> CSS (Either Property Rule) -> CSS Rule
-rule name getProps = do
- let body = runBody getProps
- tell $ [Rule name (lefts body) (rights body)]
+class Ruleable a where
+ rule :: Text -> CSS (Either Property Rule) -> CSS a
+ rules :: [Text] -> CSS (Either Property Rule) -> CSS a
+ rules rs body = mapM_ (`rule` body) rs
+
+instance Ruleable Rule where
+ rule name getProps = do
+ let body = runBody getProps
+ tell $ [Rule name (lefts body) (rights body)]
--- | Make a sub-CSS rule.
-subRule :: Text -> CSS (Either Property Rule) -> CSS (Either Property Rule)
-subRule name getProps = do
- let body = runBody getProps
- tell $ [Right $ Rule name (lefts body) (rights body)]
+instance Ruleable (Either Property Rule) where
+ rule name getProps = do
+ let body = runBody getProps
+ tell $ [Right $ Rule name (lefts body) (rights body)]

Large diffs are not rendered by default.

Oops, something went wrong.

0 comments on commit 8a29c84

Please sign in to comment.