[Fencommits] fenserve: a primitive exporter

[Benja Fallenstein]

Tue May  1 18:54:44 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * a primitive exporter
diff -rN -u old-fenserve/notetaker/Main.hs new-fenserve/notetaker/Main.hs
--- old-fenserve/notetaker/Main.hs	2007-05-01 19:05:29.000000000 +0300
+++ new-fenserve/notetaker/Main.hs	2007-05-01 19:05:29.000000000 +0300
@@ -64,8 +64,8 @@
     renderNote p (Note title False cs) = "<li>" ++ title ++ renderNotes p nick cs
     renderNote p (Note title True cs) =
          "<li>" ++ title ++ " (<a href='/item/"
-      ++ renderPath p ++ "?nick=" ++ nick ++ "'><i>"
-      ++ show (length cs) ++ " children</i></a>)"
+      ++ renderPath p ++ "?nick=" ++ nick ++ "'><i>" ++ c ++ "</i></a>)"
+      where l = length cs; c = if l==1 then "1 child" else show l++" children"
     
 readPath :: String -> Path
 readPath s = readPath' s 0 (\p _ -> p)
@@ -198,9 +198,37 @@
 bodyView (MakeOwnPage p) nick = page p nick
 bodyView (Unpage p) nick = page p nick
 
+export prefix = ("<pre>"++) . concatMap (\(Line _ _ body) -> f body) where
+    r = renderPath . (prefix ++)
+    f (Body s) = ""
+    f (Add p s) = ":add " ++ r p ++ " " ++ h s [] ++ "\n"
+    f (Edit p s) = ":edit " ++ r p ++ " " ++ h s [] ++ "\n"
+    f (Move p q) = ":move " ++ r p ++ " " ++ r q ++ "\n"
+    f (DeleteOne p) = ":del " ++ r p ++ "\n"
+    f (Delete p) = ":deltree " ++ r p ++ "\n"
+    f (MakeOwnPage p) = ":page " ++ r p ++ "\n"
+    f (Unpage p) = ":unpage " ++ r p ++ "\n"
+    
+    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 : 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
+               , h (Prefix ["export"]) GET $ ok $ \[p] () -> get >>= respond . export (readPath p)
                , h [""]    GET  $ ok $ \() nick -> page [] nick
                , h ()      POST $ ok $ \() (nick,line) -> do
                      if line == ":ll" then