[Fencommits] fenserve: add a simple light-weight markup syntax, and quote HTML markup characters

[Benja Fallenstein]

Mon Apr 30 23:00:38 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * add a simple light-weight markup syntax, and quote HTML markup characters
diff -rN -u old-fenserve/notetaker/Main.hs new-fenserve/notetaker/Main.hs
--- old-fenserve/notetaker/Main.hs	2007-04-30 23:00:51.000000000 +0300
+++ new-fenserve/notetaker/Main.hs	2007-04-30 23:00:51.000000000 +0300
@@ -78,14 +78,53 @@
     segments s       = (read x - 1) : segments y where (x,y) = span (/= '.') s
 
 readBody :: String -> Body
-readBody s | ":add "     `isPrefixOf` s = readPath' s 5 $ \p l  -> Add p l
-           | ":edit "    `isPrefixOf` s = readPath' s 6 $ \p l  -> Edit p l
+readBody s | ":add "     `isPrefixOf` s = readPath' s 5 $ \p l  -> Add p (f l)
+           | ":edit "    `isPrefixOf` s = readPath' s 6 $ \p l  -> Edit p (f l)
            | ":move "    `isPrefixOf` s = readPath' s 6 $ \p l  -> Move p (readPath l)
            | ":del "     `isPrefixOf` s = readPath' s 5 $ \p "" -> DeleteOne p
            | ":deltree " `isPrefixOf` s = readPath' s 9 $ \p "" -> Delete p
            | ":page "    `isPrefixOf` s = readPath' s 6 $ \p "" -> MakeOwnPage p
            | ":unpage "  `isPrefixOf` s = readPath' s 8 $ \p "" -> Unpage p
-           | otherwise               = Body s
+           | otherwise               = Body (format (quote s))
+
+    where f s = format (quote s)
+    
+quote "" = ""
+quote ('<':cs) = "&lt;" ++ quote cs
+quote ('"':cs) = "&quot;" ++ quote cs
+quote ('\'':cs) = "&apos;" ++ quote cs
+quote ('&':cs) = "&amp;" ++ quote cs
+quote (c:cs) = c : quote cs
+
+format s = f text links where
+    (text:links) = split s
+    split ""       = [""]
+    split ('|':cs) = "" : split cs
+    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
     
 executeAll = foldl (\n (Line _ _ b) -> execute b n) (Note "HOME" True [])