[Fencommits] fenserve: start work on a simple note-taking system (actually separate from Fenserve as yet, but I don't want to create Yet Another Repo, in the hope that they'll merge)

[Benja Fallenstein]

Fri Apr 27 17:38:45 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * start work on a simple note-taking system (actually separate from Fenserve as yet, but I don't want to create Yet Another Repo, in the hope that they'll merge)
diff -rN -u old-fenserve/notetaker/Main.hs new-fenserve/notetaker/Main.hs
--- old-fenserve/notetaker/Main.hs	1970-01-01 02:00:00.000000000 +0200
+++ new-fenserve/notetaker/Main.hs	2007-04-27 17:39:03.000000000 +0300
@@ -0,0 +1,38 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+
+import HAppS 
+import Control.Monad.State
+import Data.Generics (Typeable)
+import Data.Binary hiding (get,put)
+import Data.Char
+
+data Note = Note String [Note] deriving (Eq,Ord,Read,Show,Typeable)
+
+page = do lines <- get; let notes = foldl (flip execute) [] lines
+          respond $ "<form id='myform' action='' method='post'>\
+                    \    <input name='line' id='myline' type='text' size=60>\
+                    \</form>\
+                    \<script type='text/javascript'>\
+                    \    document.forms[0].elements[0].focus();\
+                    \</script>" ++ renderNotes notes
+                    
+renderNotes notes = "<ol>" ++ concatMap renderNote notes ++ "</ol>" where
+    renderNote (Note title children) = "<li>" ++ title ++ renderNotes children
+    
+execute line0 = addToPath (map (subtract 1) path) line where
+    (path, line) = case reads line0 of ((p,l):_) -> (p, dropWhile isSpace l)
+                                       []        -> ([], line0)
+    addToPath [] line notes = notes ++ [Note line []]
+    addToPath (i:is) line notes = take i notes ++ [note'] ++ drop (i+1) notes
+        where Note title children = notes !! i
+              note' = Note title (addToPath is line children)
+
+instance FromMessage String where
+    fromMessageM m = lookM m "line"
+    
+main = stdHTTP [ debugFilter
+               , h () GET $ ok $ \() () -> page
+               , h () POST $ ok $ \() line -> do modify (++[line]); page
+               , h () POST $ ok $ \() () -> respond "Huh."
+               ]
+
diff -rN -u old-fenserve/notetaker/Makefile new-fenserve/notetaker/Makefile
--- old-fenserve/notetaker/Makefile	1970-01-01 02:00:00.000000000 +0200
+++ new-fenserve/notetaker/Makefile	2007-04-27 17:39:03.000000000 +0300
@@ -0,0 +1,26 @@
+
+PREFIX=~/inst
+CONFIGURE_OPTS=--user --prefix $(PREFIX)
+
+all: build
+
+.setup-config:
+	runhaskell Setup.lhs configure $(CONFIGURE_OPTS)
+
+configure:
+	runhaskell Setup.lhs configure $(CONFIGURE_OPTS)
+
+build: .setup-config
+	runhaskell Setup.lhs build
+
+install: 
+	runhaskell Setup.lhs install
+
+run: build install
+	./dist/build/notetaker/notetaker $(ARGS)
+	
+reset:
+	rm -rf notetaker_state notetaker_error.log fenserve_code
+
+clean:
+	runhaskell Setup.lhs clean
diff -rN -u old-fenserve/notetaker/Setup.lhs new-fenserve/notetaker/Setup.lhs
--- old-fenserve/notetaker/Setup.lhs	1970-01-01 02:00:00.000000000 +0200
+++ new-fenserve/notetaker/Setup.lhs	2007-04-27 17:39:03.000000000 +0300
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMainWithHooks defaultUserHooks
diff -rN -u old-fenserve/notetaker/notetaker.cabal new-fenserve/notetaker/notetaker.cabal
--- old-fenserve/notetaker/notetaker.cabal	1970-01-01 02:00:00.000000000 +0200
+++ new-fenserve/notetaker/notetaker.cabal	2007-04-27 17:39:03.000000000 +0300
@@ -0,0 +1,10 @@
+Name:           notetaker
+Version:        0.1
+License:        GPL
+License-file:   LICENSE
+Author:         Benja Fallenstein
+Maintainer:     fenfire-dev at nongnu.org
+Build-Depends:  base, mtl, network, HAppS, binary
+
+Executable:     notetaker
+Main-Is:        Main.hs