[Fencommits] fenserve: whoo, the code is a bit ugly, but I can evaluate Haskell in fenserve! :-)

[Benja Fallenstein]

Mon Mar 19 20:24:57 EET 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * whoo, the code is a bit ugly, but I can evaluate Haskell in fenserve! :-)
diff -rN -u old-fenserve/FenServe.hs new-fenserve/FenServe.hs
--- old-fenserve/FenServe.hs	2007-03-22 19:49:16.000000000 +0200
+++ new-fenserve/FenServe.hs	2007-03-22 19:49:17.000000000 +0200
@@ -32,6 +32,7 @@
 import qualified Data.ByteString as ByteString
 import Data.ByteString (ByteString)
 import Data.Generics
+import qualified Data.List as List
 import qualified Data.Map as Map
 import Data.Map (Map)
 import qualified Data.Set as Set
@@ -40,18 +41,21 @@
 
 import Network.URI (uriToString)
 
+import System.Eval.Haskell (eval)
 import System.IO.Unsafe (unsafePerformIO)
 
 fs                 =     "http://fenfire.org/2007/fenserve#"
 fs_Directory       = IRI "http://fenfire.org/2007/fenserve#Directory"
 fs_DirEntry        = IRI "http://fenfire.org/2007/fenserve#DirEntry"
 fs_FileEntry       = IRI "http://fenfire.org/2007/fenserve#FileEntry"
+fs_ExecutableEntry = IRI "http://fenfire.org/2007/fenserve#ExecutableEntry"
 fs_FirstVersion    = IRI "http://fenfire.org/2007/fenserve#FirstVersion"
 fs_previousVersion = IRI "http://fenfire.org/2007/fenserve#previousVersion"
 fs_entries         = IRI "http://fenfire.org/2007/fenserve#entries"
 fs_filename        = IRI "http://fenfire.org/2007/fenserve#filename"
-fs_subdir          = IRI "http://fenfire.org/2007/fenserve#"
+fs_subdir          = IRI "http://fenfire.org/2007/fenserve#subdir"
 fs_representation  = IRI "http://fenfire.org/2007/fenserve#representation"
+fs_code            = IRI "http://fenfire.org/2007/fenserve#code"
 fs_mimeType        = IRI "http://fenfire.org/2007/fenserve#mimeType"
 fs_language        = IRI "http://fenfire.org/2007/fenserve#language"
 
@@ -61,7 +65,9 @@
                        (getOne g s p Pos)
 
 data Entry = DirEntry { entryName :: String, entrySubdir :: Node }
-           | FileEntry { entryName :: String, entryRepr :: Node } deriving (Show, Read)
+           | FileEntry { entryName :: String, entryRepr :: Node } 
+           | ExecutableEntry { entryName :: String, entryCode :: Node } 
+           deriving (Show, Read)
            
 data Directory = Dir { dirNode :: Node, dirEntries :: [Entry] } deriving (Show, Read)
 
@@ -94,6 +100,11 @@
         tellTs [ (e, fs_filename, nameR), (e, rdf_type, fs_DirEntry),
                  (e, fs_subdir, subdir) ]
         return e
+    toRDF (ExecutableEntry name code) = do
+        e <- newBNode; nameR <- toRDF name
+        tellTs [ (e, fs_filename, nameR), (e, rdf_type, fs_ExecutableEntry),
+                 (e, fs_code, code) ]
+        return e
         
 instance FromRDF Entry where
     readRDF g node = case rget rdf_type node g of
@@ -111,6 +122,13 @@
             tellTs [ (node, fs_filename, nameR), 
                      (node, fs_subdir, subdir) ]
             return $ DirEntry name subdir
+        x | x == fs_ExecutableEntry -> do
+            let nameR = rget fs_filename node g
+            name <- readRDF g nameR
+            let code = rget fs_code node g
+            tellTs [ (node, fs_filename, nameR), 
+                     (node, fs_subdir, code) ]
+            return $ ExecutableEntry name code
 
 instance StartState Ptr where startStateM = return emptyState
 
@@ -170,21 +188,31 @@
 
 getURI :: [String] -> Node -> StormIO ByteString
 getURI [x] dir = readData dir >>= f . dirEntries where
-    f (FileEntry n r : _ ) | n == x = getBlock (bID r)
-    f (_             : es) = f es
-    f []                   = return $ toUTF $ "not found: " ++ x
+    f (FileEntry n r : _ )       | n == x = getBlock (bID r)
+    f (ExecutableEntry n c : _ ) | n == x = execute c
+    f (_                   : es) = f es
+    f []                         = return $ toUTF $ "not found: " ++ x
 getURI (x:xs) dir = readData dir >>= f . dirEntries where
     f (DirEntry n sub : _ ) | n == x = getURI xs sub
     f (_              : es) = f es
     f []                    = return $ toUTF $ "dir not found: " ++ x
+    
+execute :: Node -> StormIO ByteString
+execute code = do s <- getBlock (bID code)
+                  let x = eval (fromUTF s) [] :: IO (Maybe String)
+                  return $ toUTF $ fromMaybe "error" $ unsafePerformIO x
 
 putURI :: [String] -> ByteString -> Node -> StormIO Node
 putURI path s dir = do rid <- addBlock s; putURI' path (bIRI rid) dir where
   putURI' [x] r dir = updateData f' dir where
     f' (Dir n entries) = return $ Dir n (f entries)
-    f (FileEntry n _ : es) | n == x = FileEntry n r : es
-    f (e             : es) = e : f es
-    f []                   = [FileEntry x r]
+    f (FileEntry       n _ : es) | n == x = FileEntry n r : es
+                                 | n ++ ".code" == x = ExecutableEntry n r : es
+    f (ExecutableEntry n _ : es) | n == x = FileEntry n r : es
+                                 | n ++ ".code" == x = ExecutableEntry n r : es
+    f (e                   : es) = e : f es
+    f []                         | ".code" `List.isSuffixOf` x = [ExecutableEntry (take (length x - 5) x) r]
+                                 | otherwise = [FileEntry x r]
   putURI' (x:xs) r dir = updateData f' dir where
     recurse sub = do sub' <- putURI' xs r sub; return [DirEntry x sub']
     f' (Dir n entries) = do es' <- f entries; return (Dir n es')
diff -rN -u old-fenserve/fenserve.cabal new-fenserve/fenserve.cabal
--- old-fenserve/fenserve.cabal	2007-03-22 19:49:16.000000000 +0200
+++ new-fenserve/fenserve.cabal	2007-03-22 19:49:17.000000000 +0200
@@ -4,7 +4,7 @@
 License-file:   LICENSE
 Author:         Benja Fallenstein
 Maintainer:     fenfire-dev at nongnu.org
-Build-Depends:  base, mtl, network, HAppS, fenfire, glib
+Build-Depends:  base, mtl, network, HAppS, fenfire, glib, plugins
 
 Executable:     fenserve
 Main-Is:        FenServe.hs