[Fencommits] fenserve: nested markup; markdown format for code (doesn't require escaping inside code)

[Benja Fallenstein]

Wed May  9 20:49:29 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * nested markup; markdown format for code (doesn't require escaping inside code)
diff -rN -u old-fenserve/notetaker/Markup.hs new-fenserve/notetaker/Markup.hs
--- old-fenserve/notetaker/Markup.hs	2007-05-09 20:49:39.000000000 +0300
+++ new-fenserve/notetaker/Markup.hs	2007-05-09 20:49:39.000000000 +0300
@@ -2,6 +2,8 @@
 
 module Markup where
 
+import Data.List (isPrefixOf)
+
 quote "" = ""
 quote ('<':cs) = "&lt;" ++ quote cs
 quote ('"':cs) = "&quot;" ++ quote cs
@@ -17,7 +19,7 @@
 unquote (c:cs) = c : unquote cs
 unquote "" = ""
 
-format s = f text links where
+format s = plain text links where
     (text:links) = split s
     split ""       = [""]
     split ('|':cs) = "" : split cs
@@ -25,27 +27,39 @@
     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>" ++ f cs ls
-    code ('\\':cs) ls = esc code cs ls
-    code (c:cs) ls = c : code cs ls
-    code "" ls = "</code>"
+    plain ('*':cs) ls = "<em>" ++ emph plain cs ls
+    plain ('_':cs) (l:ls) = "<a href='" ++ l ++ "'>" ++ link plain cs ls
+    plain ('`':cs) ls = "<code>" ++ code plain cs ls
+    plain ('\\':cs) ls = esc plain cs ls
+    plain (c:cs) ls = c : plain cs ls
+    plain "" ls = ""
+    
+    emph f ('*':cs) ls = "</em>" ++ f cs ls
+    emph f ('_':cs) (l:ls) = "<a href='" ++ l ++ "'>" ++ link (emph f) cs ls
+    emph f ('`':cs) ls = "<code>" ++ code (emph f) cs ls
+    emph f ('\\':cs) ls = esc (emph f) cs ls
+    emph f (c:cs) ls = c : emph f cs ls
+    emph f "" ls = "</em>" ++ f "" ls
+    
+    link f ('*':cs) ls = "<em>" ++ emph (link f) cs ls
+    link f ('_':cs) ls = "</a>" ++ f cs ls
+    link f ('`':cs) ls = "<code>" ++ code (link f) cs ls
+    link f ('\\':cs) ls = esc (link f) cs ls
+    link f (c:cs) ls = c : link f cs ls
+    link f "" ls = "</a>" ++ f "" ls
+
+    code f cs ls = startCode 1 f cs ls
+    
+    startCode n f ('`':cs) ls = startCode (n+1) f cs ls
+    startCode n f (' ':cs) ls = code' n f cs ls
+    startCode n f cs ls       = code' n f cs ls
+    
+    code' n f cs ls | (replicate n '`') `isPrefixOf` cs
+                    = "</code>" ++ f (drop n cs) ls
+    code' n f cs ls | (' ' : replicate n '`') `isPrefixOf` cs
+                    = "</code>" ++ f (drop (n+1) cs) ls
+    code' n f (c:cs) ls = c : code' n f cs ls
+    code' n f ""     ls = "</code>" ++ f "" ls
     
     esc f (c:cs) ls = c : f cs ls
     esc f "" ls = f "" ls
@@ -57,15 +71,32 @@
     h ('<':'/':'b':'>':cs) ls = "*" ++ h cs ls
     h ('<':'i':'>':cs) ls = "*" ++ h cs ls
     h ('<':'/':'i':'>':cs) ls = "*" ++ h cs ls
-    h ('<':'c':'o':'d':'e':'>':cs) ls = "`" ++ h cs ls
-    h ('<':'/':'c':'o':'d':'e':'>':cs) ls = "`" ++ h cs ls
+    h ('<':'c':'o':'d':'e':'>':cs) ls = code 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
+                | otherwise          =       c : h cs ls
     h "" (l:ls) = " | " ++ l ++ h "" ls
     h "" [] = ""
     
+    code cs ls = delim ++ lsp ++ s ++ rsp ++ delim ++ h rest ls where
+        (s, rest) = findEnd cs
+        findEnd ('<':'/':'c':'o':'d':'e':'>':cs) = ("", cs)
+        findEnd "" = ("", cs)
+        findEnd (c:cs) = let (a,b) = findEnd cs in (c:a,b)
+        
+        lsp = if      null s  || head s `elem` "` " then " " else ""
+        rsp = if not (null s) && last s `elem` "` " then " " else ""
+        
+        delim = replicate (n+1) '`'
+        n = longestRun 0 s
+        longestRun n ('`':cs) = run 1 n cs
+        longestRun n (c:cs) = longestRun n cs
+        longestRun n "" = n
+        run m n ('`':cs) = run (m+1) n cs
+        run m n (c:cs) = longestRun (max m n) cs
+        run m n "" = max m n
+    
     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])