| By | Chris Done |
| At | 2011-06-10 |
| Title | Drop highlighter library, use hscolour. |
| Description |
Edit file amelie.cabal 33188 → 33188
29 29 ,network >= 2.3 && < 2.4
30 30 ,MonadCatchIO-transformers >= 0.2 && < 0.3
31 31 ,time >= 1.1
32 32 ,old-locale >= 1.0
33 33 ,safe >= 0.3
- 34 ,highlighter >= 0.2
+ 34 ,hscolour >= 1.17
35 35 ,HJScript >= 0.5
… … … … Edit file src/Amelie/View/Highlight.hs 33188 → 33188
3 3 {-# LANGUAGE RecordWildCards #-}4 4 5 5 -- | Code highlighting.
6 6 7 7 module Amelie.View.Highlight
- 8 -- (highlightPaste)
+ 8 (highlightPaste)
9 9 where
10 10 11 11 import Amelie.Types
+ 12 import Amelie.View.Html
12 13 - 13 import Data.Char
- 14 import Data.List (find)
- 15 import Data.Monoid.Operator ((++))
- 16 import Data.Text (unpack,replace)
- 17 import Data.Text.Encoding (encodeUtf8)
- 18 import Prelude hiding ((++))
- 19 import Text.Blaze.Html5 as H hiding (map)
- 20 import Text.Highlighter.Formatters.Html (format)
- 21 import Text.Highlighter.Lexer (runLexer)
- 22 import Text.Highlighter.Lexers
- 23 import Text.Highlighter.Types
+ 14 import Data.List (find)
+ 15 import Data.Text (unpack)
+ 16 import Language.Haskell.HsColour.CSS (hscolour)
+ 17 import Prelude hiding ((++))
+ 18 import Text.Blaze.Html5 as H hiding (map)
24 19 25 20 -- | Syntax highlight the paste.
26 21 highlightPaste :: [Language] -> Paste -> Html
27 22 highlightPaste langs Paste{..} =- 28 case lang >>= ((`lookupLang` (map snd lexers)) . unpack . languageName) of
- 29 Nothing -> pre $ toHtml pastePaste
- 30 Just lexer ->
- 31 case runLexer lexer (encodeUtf8 (clean pastePaste ++ "\n")) of
- 32 Right tokens -> format True tokens
- 33 _ -> pre $ toHtml pastePaste
- 34 + 23 H.table ! aClass "code" $
+ 24 td $
+ 25 case lang of
+ 26 Just (Language{languageName="haskell"}) ->+ 27 preEscapedString $ hscolour False (unpack pastePaste)
+ 28 _ -> pre $ toHtml pastePaste
+ 29 35 30 where lang = find ((==pasteLanguage) . Just . languageId) langs
- 36 lookupLang name = find $ \lexer -> lower (lName lexer) == lower name
- 37 lower = map toLower
- 38 clean = replace "\r\n" "\n"
… … … … Edit file src/Amelie/View/Paste.hs 33188 → 33188
30 30 import Text.Blaze.Html5 as H hiding (map)
31 31 import qualified Text.Blaze.Html5.Attributes as A
32 32 import Text.Blaze.Html5.Extra
33 33 import Text.Formlet
34 34 + 35 -- | Render the page page.
+ 36 page :: [Channel] -> [Language] -> Paste -> [Paste] -> Html
+ 37 page chans langs p@Paste{..} as =+ 38 layoutPage $ Page {+ 39 pageTitle = pasteTitle
+ 40 , pageBody = do viewPaste chans langs p
+ 41 viewAnnotations chans langs as
+ 42 , pageName = "paste"
+ 43 }
+ 44 35 45 -- | A formlet for paste submission / editing.
36 46 pasteFormlet :: PasteFormlet -> (Formlet PasteSubmit,Html)
37 47 pasteFormlet pf@PasteFormlet{..} =38 48 let form = postForm ! A.action "/new" $ do
39 49 when pfSubmitted $
… … … … 67 77 getPasteId :: PasteFormlet -> Maybe PasteId
68 78 getPasteId PasteFormlet{..} =69 79 M.lookup "paste_id" pfParams >>=
70 80 readMay . concat . map toString >>=
71 81 return . (fromIntegral :: Integer -> PasteId)
- 72 - 73 -- | Render the page page.
- 74 page :: [Channel] -> [Language] -> Paste -> [Paste] -> Html
- 75 page chans langs p@Paste{..} as =- 76 layoutPage $ Page {- 77 pageTitle = pasteTitle
- 78 , pageBody = do viewPaste chans langs p
- 79 viewAnnotations chans langs as
- 80 , pageName = "paste"
- 81 }
82 82 83 83 -- | View the paste's annotations.
84 84 viewAnnotations :: [Channel] -> [Language] -> [Paste] -> Html
85 85 viewAnnotations chans langs pastes = do
86 86 mapM_ (viewPaste chans langs) pastes
… … … … Edit file src/Amelie/View/Script.hs 33188 → 33188
18 18 script :: Text
19 19 script = pack $ show $ snd $ evalHJScript $ do
20 20 ready $ do
21 21 each (setWidth (j ".amelie-wrap")
22 22 (mathMax (getWidth this' + 50) 500))
- 23 (j ".highlighttable:first")
+ 23 (j ".amelie-code")
24 24 25 25 -- | jQuery selector.
26 26 j :: String -> JObject JQuery
27 27 j = selectExpr . string
28 28 … … … … Edit file src/Amelie/View/Style.hs 33188 → 33188
142 142 classRule = rule . (".amelie-" ++)143 143 144 144 -- | Styles for the highlighter.
145 145 highlighter :: CSS Rule
146 146 highlighter = do
- 147 rule ".highlighttable" $ do
+ 147 classRule "code" $ do
148 148 tokens
149 149 lineNumbers
150 150 151 151 subRule "pre" $ do
152 152 margin "0"
… … … … 155 155 verticalAlign "top"
156 156 157 157 -- | Tokens colours and styles.
158 158 tokens :: CSS (Either Property Rule)
159 159 tokens = do
- 160 subRule ".highlight" $ do
- 161 tokenColor "cm" "#555"
- 162 tokenColor "c1" "#555"
- 163 tokenColor "kr" "#397460"
- 164 tokenColor "s" "#366354"
- 165 tokenColor "sc" "#366354"
- 166 tokenColor "se" "#743838"
- 167 tokenColor "kt" "#4F4371"
- 168 tokenColor "nv" "#4F4371"
- 169 tokenColor "ow" "#333"
- 170 tokenColor "o" "#3E394D"
- 171 tokenColor "n" "#343634"
- 172 tokenColor "nf" "#222"
- 173 -- This is a weird one.
- 174 -- subRule ".c1 + .t" $ do
- 175 -- display "none"
- 176 - 177 where token name props = subRule ("." ++ name) $ props+ 160 subRule "pre" $ do
+ 161 marginTop "0"
+ 162 tokenColor "comment" "#555"
+ 163 tokenColor "keyword" "#397460"
+ 164 tokenColor "str" "#366354"
+ 165 tokenColor "conid" "#4F4371"
+ 166 tokenColor "varop" "#333"
+ 167 tokenColor "varid" "#333"
+ 168 + 169 where token name props = subRule (".hs-" ++ name) $ props178 170 tokenColor name col = token name $ color col
179 171 180 172 -- | The line number part.
181 173 lineNumbers :: CSS (Either Property Rule)
182 174 lineNumbers = do
… … … …