[Fencommits] fenserve: refactor: move quote/format/unformat to a new module, Markup
Benja Fallenstein
benja.fallenstein at gmail.com
Tue May 1 21:40:11 EEST 2007
Tue May 1 21:40:01 EEST 2007 Benja Fallenstein <benja.fallenstein at gmail.com>
* refactor: move quote/format/unformat to a new module, Markup
diff -rN -u old-fenserve/notetaker/Main.hs new-fenserve/notetaker/Main.hs
--- old-fenserve/notetaker/Main.hs 2007-05-01 21:40:11.000000000 +0300
+++ new-fenserve/notetaker/Main.hs 2007-05-01 21:40:11.000000000 +0300
@@ -1,5 +1,7 @@
{-# OPTIONS_GHC -fglasgow-exts #-}
+import Markup
+
import HAppS hiding (Body, getPath)
import Control.Monad.State
import Data.Generics (Typeable)
@@ -91,46 +93,6 @@
where f s = format (quote s)
-quote "" = ""
-quote ('<':cs) = "<" ++ quote cs
-quote ('"':cs) = """ ++ quote cs
-quote ('\'':cs) = "'" ++ quote cs
-quote ('&':cs) = "&" ++ quote cs
-quote (c:cs) = c : quote cs
-
-format s = f text links where
- (text:links) = split s
- split "" = [""]
- split ('|':cs) = "" : split cs
- split ('\\':'|':cs) = let x:xs = split cs in ('|':x):xs
- split ('\\':c:cs) = let x:xs = split cs in ('\\':c:x):xs
- split (c:cs) = let x:xs = split cs in (c:x):xs
-
- f ('*':cs) ls = "<em>" ++ emph cs ls
- f ('_':cs) (l:ls) = "<a href='" ++ l ++ "'>" ++ link cs ls
- f ('\\':cs) ls = esc f cs ls
- f ('`':cs) ls = "<code>" ++ code cs ls
- f (c:cs) ls = c : f cs ls
- f "" ls = ""
-
- emph ('*':cs) ls = "</em>" ++ f cs ls
- emph ('\\':cs) ls = esc emph cs ls
- emph (c:cs) ls = c : emph cs ls
- emph "" ls = "</em>"
-
- link ('_':cs) ls = "</a>" ++ f cs ls
- link ('\\':cs) ls = esc link cs ls
- link (c:cs) ls = c : link cs ls
- link "" ls = "</a>"
-
- code ('`':cs) ls = "</code>"
- code ('\\':cs) ls = esc code cs ls
- code (c:cs) ls = c : code cs ls
- code "" ls = "</code>"
-
- esc f (c:cs) ls = c : f cs ls
- esc f "" ls = f "" ls
-
executeAll = foldl (\n (Line _ _ b) -> execute b n) (Note "HOME" True [])
. processReverts [] . reverse where
processReverts ls' (Line _ _ (Revert n) : ls) = processReverts ls' (drop n ls)
@@ -209,27 +171,10 @@
export path notes = concatMap f [0..length notes-1] where
f i | Note title own cs <- notes !! i =
- ":add " ++ renderPath path ++ " " ++ h title [] ++ "\n"
+ ":add " ++ renderPath path ++ " " ++ unformat title ++ "\n"
++ (if own then ":page " ++ renderPath (path++[i]) ++ "\n" else "")
++ export (path++[i]) cs where
- h ('<':'e':'m':'>':cs) ls = "*" ++ h cs ls
- h ('<':'/':'e':'m':'>':cs) ls = "*" ++ h cs ls
- h ('<':'b':'>':cs) ls = "*" ++ h cs ls
- h ('<':'/':'b':'>':cs) ls = "*" ++ h cs ls
- h ('<':'i':'>':cs) ls = "*" ++ h cs ls
- h ('<':'/':'i':'>':cs) ls = "*" ++ h cs ls
- h ('<':'a':' ':'h':'r':'e':'f':'=':sep:cs) ls = "_" ++ link sep "" cs ls
- h ('<':'/':'a':'>':cs) ls = "_" ++ h cs ls
- h (c:cs) ls | c `elem` "*_`\\|" = '\\' : c : h cs ls
- | otherwise = c : h cs ls
- h "" (l:ls) = " | " ++ l ++ h "" ls
- h "" [] = ""
-
- link sep l (c:'>':cs) ls | c == sep = h cs (ls++[l])
- link sep l (c:cs) ls = link sep (l++[c]) cs ls
- link sep l "" ls = h "" (ls++[l])
-
main = stdHTTP [ debugFilter
, h ["log"] GET $ ok $ \() nick -> renderLog nick False
, h ["lastlog"] GET $ ok $ \() nick -> renderLog nick True
diff -rN -u old-fenserve/notetaker/Markup.hs new-fenserve/notetaker/Markup.hs
--- old-fenserve/notetaker/Markup.hs 1970-01-01 02:00:00.000000000 +0200
+++ new-fenserve/notetaker/Markup.hs 2007-05-01 21:40:11.000000000 +0300
@@ -0,0 +1,62 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+
+module Markup where
+
+quote "" = ""
+quote ('<':cs) = "<" ++ quote cs
+quote ('"':cs) = """ ++ quote cs
+quote ('\'':cs) = "'" ++ quote cs
+quote ('&':cs) = "&" ++ quote cs
+quote (c:cs) = c : quote cs
+
+format s = f text links where
+ (text:links) = split s
+ split "" = [""]
+ split ('|':cs) = "" : split cs
+ split ('\\':'|':cs) = let x:xs = split cs in ('|':x):xs
+ split ('\\':c:cs) = let x:xs = split cs in ('\\':c:x):xs
+ split (c:cs) = let x:xs = split cs in (c:x):xs
+
+ f ('*':cs) ls = "<em>" ++ emph cs ls
+ f ('_':cs) (l:ls) = "<a href='" ++ l ++ "'>" ++ link cs ls
+ f ('\\':cs) ls = esc f cs ls
+ f ('`':cs) ls = "<code>" ++ code cs ls
+ f (c:cs) ls = c : f cs ls
+ f "" ls = ""
+
+ emph ('*':cs) ls = "</em>" ++ f cs ls
+ emph ('\\':cs) ls = esc emph cs ls
+ emph (c:cs) ls = c : emph cs ls
+ emph "" ls = "</em>"
+
+ link ('_':cs) ls = "</a>" ++ f cs ls
+ link ('\\':cs) ls = esc link cs ls
+ link (c:cs) ls = c : link cs ls
+ link "" ls = "</a>"
+
+ code ('`':cs) ls = "</code>"
+ code ('\\':cs) ls = esc code cs ls
+ code (c:cs) ls = c : code cs ls
+ code "" ls = "</code>"
+
+ esc f (c:cs) ls = c : f cs ls
+ esc f "" ls = f "" ls
+
+unformat s = h s [] where
+ h ('<':'e':'m':'>':cs) ls = "*" ++ h cs ls
+ h ('<':'/':'e':'m':'>':cs) ls = "*" ++ h cs ls
+ h ('<':'b':'>':cs) ls = "*" ++ h cs ls
+ h ('<':'/':'b':'>':cs) ls = "*" ++ h cs ls
+ h ('<':'i':'>':cs) ls = "*" ++ h cs ls
+ h ('<':'/':'i':'>':cs) ls = "*" ++ h cs ls
+ h ('<':'a':' ':'h':'r':'e':'f':'=':sep:cs) ls = "_" ++ link sep "" cs ls
+ h ('<':'/':'a':'>':cs) ls = "_" ++ h cs ls
+ h (c:cs) ls | c `elem` "*_`\\|" = '\\' : c : h cs ls
+ | otherwise = c : h cs ls
+ h "" (l:ls) = " | " ++ l ++ h "" ls
+ h "" [] = ""
+
+ link sep l (c:'>':cs) ls | c == sep = h cs (ls++[l])
+ link sep l (c:cs) ls = link sep (l++[c]) cs ls
+ link sep l "" ls = h "" (ls++[l])
+
More information about the Fencommits
mailing list