By | Chris Done |
At | 2011-06-13 |
Title | Diff support. |
Description |
Edit file amelie.cabal 33188 → 33188
38 38 ,directory >= 1.0
39 39 ,blaze-builder >= 0.2
40 40 ,ConfigFile >= 1.0
41 41 ,feed >= 0.3
42 42 ,download-curl >= 0.1
+ 43 ,Diff >= 0.1
… … … … Edit file src/Main.hs 33188 → 33188
8 8 import Amelie.Config
9 9 import Amelie.Controller
10 10 import Amelie.Controller.Activity as Activity
11 11 import Amelie.Controller.Browse as Browse
12 12 import Amelie.Controller.Cache (newCache)
+ 13 import Amelie.Controller.Diff as Diff
13 14 import Amelie.Controller.Home as Home
14 15 import Amelie.Controller.New as New
15 16 import Amelie.Controller.Paste as Paste
16 17 import Amelie.Controller.Raw as Raw
17 18 import Amelie.Controller.Script as Script
… … … … 56 57 ,("/new/:channel",run New.handle)
57 58 ,("/browse/page/:page/offset/:offset",run Browse.handle)
58 59 ,("/browse/page/:page",run Browse.handle)
59 60 ,("/browse",run Browse.handle)
60 61 ,("/activity",run Activity.handle)
+ 62 ,("/diff/:this/:that",run Diff.handle)
61 63 ]
62 64 run = runHandler conf p cache ans
… … … … Edit file src/Amelie/View/Paste.hs 33188 → 33188
40 40 -- | Render the page page.
41 41 page :: PastePage -> Html
42 42 page PastePage {ppPaste=p@Paste{..},..} =
43 43 layoutPage $ Page {
44 44 pageTitle = pasteTitle
- 45 , pageBody = do viewPaste ppChans ppLangs (p,ppHints)
- 46 viewAnnotations ppChans
+ 45 , pageBody = do viewPaste [] ppChans ppLangs (p,ppHints)
+ 46 viewAnnotations (p : ppAnnotations)
+ 47 ppChans
47 48 ppLangs
48 49 (zip ppAnnotations ppAnnotationHints)
49 50 , pageName = "paste"
50 51 }
51 52 … … … … 105 106 M.lookup "id" pfParams >>=
106 107 readMay . concat . map toString >>=
107 108 return . (fromIntegral :: Integer -> PasteId)
108 109 109 110 -- | View the paste's annotations.
- 110 viewAnnotations :: [Channel] -> [Language] -> [(Paste,[Hint])] -> Html
- 111 viewAnnotations chans langs pastes = do
- 112 mapM_ (viewPaste chans langs) pastes
+ 111 viewAnnotations :: [Paste] -> [Channel] -> [Language] -> [(Paste,[Hint])] -> Html
+ 112 viewAnnotations pastes chans langs annotations = do
+ 113 mapM_ (viewPaste pastes chans langs) annotations
113 114 114 115 -- | View a paste's details and content.
- 115 viewPaste :: [Channel] -> [Language] -> (Paste,[Hint]) -> Html
- 116 viewPaste chans langs (paste@Paste{..},hints) = do
+ 116 viewPaste :: [Paste] -> [Channel] -> [Language] -> (Paste,[Hint]) -> Html
+ 117 viewPaste pastes chans langs (paste@Paste{..},hints) = do
117 118 case pasteParent of
118 119 Nothing -> return ()
119 120 Just{} -> let an = "a" ++ show (fromIntegral pasteId :: Integer)
120 121 in a ! A.name (toValue an) $ return ()
- 121 pasteDetails chans langs paste
+ 122 pasteDetails pastes chans langs paste
122 123 pasteContent langs paste
123 124 viewHints hints
124 125 125 126 -- | List the details of the page in a dark section.
- 126 pasteDetails :: [Channel] -> [Language] -> Paste -> Html
- 127 pasteDetails chans langs paste@Paste{..} =
+ 127 pasteDetails :: [Paste] -> [Channel] -> [Language] -> Paste -> Html
+ 128 pasteDetails pastes chans langs paste@Paste{..} =
128 129 darkNoTitleSection $ do
- 129 pasteNav paste
+ 130 pasteNav pastes paste
130 131 h2 $ toHtml $ fromStrict pasteTitle
131 132 ul ! aClass "paste-specs" $ do
132 133 detail "Paste" $ pasteLink paste $ "#" ++ show pasteId
133 134 detail "Author" $ pasteAuthor
134 135 detail "Language" $ showLanguage langs pasteLanguage
… … … … 139 140 140 141 where detail title content = do
141 142 li $ do strong (title ++ ":"); toHtml content
142 143 143 144 -- | Individual paste navigation.
- 144 pasteNav :: Paste -> Html
- 145 pasteNav Paste {..} =
+ 145 pasteNav :: [Paste] -> Paste -> Html
+ 146 pasteNav pastes paste =
146 147 H.div ! aClass "paste-nav" $ do
- 147 href ("/edit/" ++ pack (show pasteId) ++ "") ("Annotate" :: Text)
+ 148 diffLink
+ 149 href ("/edit/" ++ pack (show pid) ++ "") ("Annotate" :: Text)
+ 150 + 151 where pid = pasteId paste
+ 152 pairs = zip (drop 1 pastes) pastes
+ 153 parent = fmap snd $ find ((==pid).pasteId.fst) $ pairs
+ 154 diffLink =
+ 155 case parent of
+ 156 Nothing -> return ()
+ 157 Just Paste{pasteId=prevId} -> do
+ 158 href ("/diff/" ++ show prevId ++ "/" ++ show pid)
+ 159 ("Diff" :: Text)
+ 160 " - "
148 161 149 162 -- | Show the paste content with highlighting.
150 163 pasteContent :: [Language] -> Paste -> Html
151 164 pasteContent langs paste =
152 165 lightNoTitleSection $ highlightPaste langs paste
… … … … Edit file src/Amelie/View/Script.hs 33188 → 33188
63 63 -- | Toggle paste details.
64 64 togglePaste :: HJScript ()
65 65 togglePaste = do
66 66 each (do btn <- varWith (j "<a href=\"\">Expand</a>")
67 67 this <- varWith this'
- 68 prepend (string " - ") this
+ 68 prepend (" - " :: Exp String) this
69 69 prepend (val btn) this
70 70 details <- varWith (siblings ".amelie-paste-specs" this)
71 71 display btn "none" details
72 72 toggle (display btn "block" details)
73 73 (display btn "none" details)
… … … … Edit file src/Amelie/View/Style.hs 33188 → 33188
172 172 classRule = rule . (".amelie-" ++)
173 173 174 174 -- | Styles for the highlighter.
175 175 highlighter :: CSS Rule
176 176 highlighter = do
+ 177 diff
177 178 classRule "code" $ do
178 179 tokens
179 180 lineNumbers
180 181 181 182 subRule "pre" $ do
182 183 margin "0"
183 184 184 185 subRule "td" $ do
185 186 verticalAlign "top"
+ 187 + 188 -- | Style for diff groups.
+ 189 diff :: CSS Rule
+ 190 diff = do
+ 191 classRule "diff-both" $
+ 192 return ()
+ 193 classRule "diff-first" $ do
+ 194 backgroundColor "#FDD"
+ 195 color "#695B5B"
+ 196 classRule "diff-second" $ do
+ 197 backgroundColor "#DFD"
186 198 187 199 -- | Tokens colours and styles.
188 200 tokens :: CSS (Either Property Rule)
189 201 tokens = do
190 202 subRule "pre" $ do
… … … … Edit file src/Amelie/Controller/Paste.hs 33188 → 33188
5 5 -- | Paste controller.
6 6 7 7 module Amelie.Controller.Paste
8 8 (handle
9 9 ,pasteForm
- 10 ,getPasteId)
+ 10 ,getPasteId
+ 11 ,getPasteIdKey
+ 12 ,withPasteKey)
11 13 where
12 14 13 15 import Amelie.Types
14 16 15 17 import Amelie.Controller
… … … … 21 23 import Amelie.Types.Cache as Key
22 24 import Amelie.View.Paste (pasteFormlet,page)
23 25 24 26 import Control.Applicative
25 27 import Control.Monad ((>=>))
+ 28 import Data.ByteString (ByteString)
26 29 import Data.ByteString.UTF8 (toString)
27 30 import Data.Maybe
28 31 import Data.Monoid.Operator ((++))
29 32 import Data.String (fromString)
30 33 import Data.Text (Text)
… … … … 94 97 redirect $ "/" ++ fromString (show pid)
95 98 96 99 -- | Get the paste id.
97 100 getPasteId :: Controller (Maybe Integer)
98 101 getPasteId = (fmap toString >=> readMay) <$> getParam "id"
+ 102 + 103 -- | Get the paste id by a key.
+ 104 getPasteIdKey :: ByteString -> Controller (Maybe Integer)
+ 105 getPasteIdKey key = (fmap toString >=> readMay) <$> getParam key
+ 106 + 107 -- | With the
+ 108 withPasteKey :: ByteString -> (Paste -> Controller a) -> Controller ()
+ 109 withPasteKey key with = do
+ 110 pid <- getPasteIdKey key
+ 111 justOrGoHome pid $ \(pid :: Integer) -> do
+ 112 paste <- model $ getPasteById (fromIntegral pid)
+ 113 justOrGoHome paste $ \paste -> do
+ 114 _ <- with paste
+ 115 return ()
… … … … Add file src/Amelie/View/Diff.hs 33188
+ 1 {-# OPTIONS -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind #-} + 2 {-# LANGUAGE OverloadedStrings #-} + 3 {-# LANGUAGE RecordWildCards #-} + 4 + 5 -- | Diff page view. + 6 + 7 module Amelie.View.Diff + 8 (page) + 9 where + 10 + 11 import Amelie.Types + 12 import Amelie.View.Html + 13 import Amelie.View.Layout + 14 import Amelie.View.Paste (pasteLink) + 15 + 16 import Control.Monad + 17 import Data.Algorithm.Diff + 18 import Data.Monoid.Operator ((++)) + 19 import qualified Data.Text as T + 20 import Data.Text.Lazy (pack) + 21 import Prelude hiding ((++)) + 22 import Text.Blaze.Html5 as H hiding (map) + 23 + 24 -- | Render the diff page. + 25 page :: Paste -> Paste -> Html + 26 page this that = + 27 layoutPage $ Page { + 28 pageTitle = "Diff two pastes" + 29 , pageBody = diffBody this that + 30 , pageName = "diff" + 31 } + 32 + 33 -- | View the diff between the two pastes. + 34 diffBody :: Paste -> Paste -> Html + 35 diffBody this that = do + 36 darkSection ("Diff: " ++ pid1 ++ " / " ++ pid2) $ do + 37 pasteMention this pid1 + 38 pasteMention that pid2 + 39 lightNoTitleSection $ do + 40 viewDiff this that + 41 + 42 where pasteMention paste pid = p $ do + 43 pasteLink paste pid + 44 ": " + 45 toHtml $ pasteTitle paste + 46 pid1 = pack (show (pasteId this)) + 47 pid2 = pack (show (pasteId that)) + 48 + 49 -- | View the diff between the two pastes. + 50 viewDiff :: Paste -> Paste -> Html + 51 viewDiff this that = do + 52 H.table ! aClass "code" $ + 53 td $ + 54 pre $ do + 55 forM_ groups $ \(indicator,lines) -> do + 56 let (ind,prefix) = + 57 case indicator of + 58 B -> ("diff-both"," ") + 59 F -> ("diff-first","- ") + 60 S -> ("diff-second","+ ") + 61 lins = map (prefix++) lines + 62 H.div ! aClass ind $ toHtml $ T.unlines $ lins + 63 + 64 where groups = getGroupedDiff lines1 lines2 + 65 lines1 = T.lines (pastePaste this) + 66 lines2 = T.lines (pastePaste that) Add file src/Amelie/Controller/Diff.hs 33188
+ 1 {-# OPTIONS -Wall #-} + 2 {-# LANGUAGE OverloadedStrings #-} + 3 {-# LANGUAGE ScopedTypeVariables #-} + 4 + 5 -- | Diff page controller. + 6 + 7 module Amelie.Controller.Diff + 8 (handle) + 9 where + 10 + 11 import Amelie.Controller + 12 import Amelie.Controller.Paste (withPasteKey) + 13 import Amelie.Model + 14 import Amelie.View.Diff (page) + 15 + 16 handle :: Controller () + 17 handle = do + 18 withPasteKey "this" $ \this -> + 19 withPasteKey "that" $ \that -> + 20 output $ page this that