[Fencommits] fenserve: remove the need to unload previously loaded code before loading new code

Benja Fallenstein benja.fallenstein at gmail.com
Sun Mar 25 22:07:53 EEST 2007


Sun Mar 25 22:07:23 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * remove the need to unload previously loaded code before loading new code
diff -rN -u old-fenserve-1/FenServe.hs new-fenserve-1/FenServe.hs
--- old-fenserve-1/FenServe.hs	2007-03-25 22:07:52.000000000 +0300
+++ new-fenserve-1/FenServe.hs	2007-03-25 22:07:52.000000000 +0300
@@ -264,12 +264,21 @@
 -- Running executable resources
 --------------------------------------------------------------------------
 
+imports = ["Fenfire.RDF", "HAppS hiding (Handler, query)",
+           "PagePrelude", "Storm", "FenServe",
+           "Control.Monad", "Data.Maybe",
+           "qualified Data.ByteString as ByteString",
+           "qualified Data.List as List",
+           "qualified Data.Map as Map"]
+
 execute :: Node -> Request -> FenServe Result
 execute code req = do
     s <- getBlock (bID code)
     let errH stage msg = return $ (,) Nothing $ \req -> return $ 
             mkResult 500 "text/plain" $ toUTF $ stage ++ " failed:\n" ++ msg
-        s2 = "module Page_" ++ (blockId $ bID code) ++ " where\n" ++
+        mname = "Page_" ++ (blockId $ bID code)
+        s2 = "module " ++ mname ++ " where\n" ++
+                     concatMap (\i -> "import "++i++"\n") imports ++
                      "dummyAssignment = 0\n" ++ fromUTF s
                      -- the 'dummyAssignment' is to make sure that
                      -- pages can't import anything -- imports are
@@ -283,24 +292,25 @@
                        
            putStrLn (unlines $ take 10 $ lines s')
 
-           (fp,hdl) <- openTempFile "/tmp" "fenserve.page"
+           let fp = "/tmp/"++mname++".hs"
+           hdl <- openFile fp WriteMode
            hPutStr hdl s'
            hClose hdl
-           let dir = "dist/build/fenserve/fenserve-tmp"
+           let dir = "dist/build"
            homedir <- getEnv "HOME"
-           makeResult <- Plugins.makeWith fp "Page.stub" ["-i"++dir, "-fglasgow-exts", "-fallow-overlapping-instances"]
+           makeResult <- Plugins.make fp ["-fglasgow-exts", "-fallow-overlapping-instances"]
            h' <- case makeResult of
                Plugins.MakeFailure err -> 
                    errH "Make" $ concat (List.intersperse "\n" err)
                Plugins.MakeSuccess _ o -> do
-                   loadResult <- Plugins.load o [dir] [homedir ++ "/.ghc/i386-linux-6.6/package.conf"] "handler"
+                   loadResult <- Plugins.load o [] [homedir ++ "/.ghc/i386-linux-6.6/package.conf"] "handler"
                    case loadResult of
                        Plugins.LoadSuccess m v -> return (Just m,v)
                        Plugins.LoadFailure err ->
                            errH "Load" $ concat (List.intersperse "\n" err)
-           removeFile fp; return h'
+           Plugins.makeCleaner fp; return h'
     result <- h req -- run the loaded handler
-    case m of Just m' -> unsafePerformIO $ do Plugins.unload m'
+    case m of Just m' -> unsafePerformIO $ do --Plugins.unload m'
                                               return (return result)
               Nothing -> return result
 
diff -rN -u old-fenserve-1/Makefile new-fenserve-1/Makefile
--- old-fenserve-1/Makefile	2007-03-25 22:07:52.000000000 +0300
+++ new-fenserve-1/Makefile	2007-03-25 22:07:52.000000000 +0300
@@ -16,7 +16,7 @@
 install: 
 	runhaskell Setup.hs install
 
-run: build
+run: build install
 	./dist/build/fenserve/fenserve $(ARGS)
 	
 reset:
diff -rN -u old-fenserve-1/Page.stub new-fenserve-1/Page.stub
--- old-fenserve-1/Page.stub	2007-03-25 22:07:52.000000000 +0300
+++ new-fenserve-1/Page.stub	1970-01-01 02:00:00.000000000 +0200
@@ -1,70 +0,0 @@
-{-
-Needs options: -fglasgow-exts -fallow-overlapping-instances
--}
-module PageStub where
-
-import Fenfire.RDF
-
-import HAppS hiding (Handler, query)
-
-import Storm
-import FenServe
-
-import Control.Monad
-
-import qualified Data.ByteString as ByteString
-import qualified Data.List as List
-import qualified Data.Map as Map
-import Data.Maybe
-
-
-pageHandler :: HTML -> Handler
-pageHandler html _request = 
-    return $ mkResult 200 "text/html" (toUTF $ unHTML html)
-    
-lookWithDefault param dflt req = fromMaybe dflt $ lookM req param
-
-newtype HTML = HTML { unHTML :: String } deriving (Show,Read,Eq,Ord)
-
-(+++) :: (ToXML a, ToXML b) => a -> b -> HTML
-x +++ y = HTML (unHTML (toXMLs x) ++ unHTML (toXMLs y))
-
-hquote :: String -> HTML
-hquote ('<':cs) = HTML $ "&lt;" ++ unHTML (hquote cs)
-hquote ('&':cs) = HTML $ "&amp;" ++ unHTML (hquote cs)
-hquote ('"':cs) = HTML $ "&quot;" ++ unHTML (hquote cs)
-hquote (c:cs) = HTML $ c : unHTML (hquote cs)
-hquote "" = HTML ""
-
-genAttr :: (String, HTML) -> String
-genAttr (n,v) = " " ++ n ++ "=\"" ++ unHTML v ++ "\""
-
-genTag :: (Maybe a, String) -> [(String, HTML)] -> [HTML] -> HTML
-genTag (Nothing, s) attrs children = HTML $
-    "<"++s++concatMap genAttr attrs++">"++concatMap unHTML children++"</"++s++">"
-    
-genETag :: (Maybe a, String) -> [(String, HTML)] -> HTML
-genETag (Nothing, s) attrs = HTML $ "<"++s++concatMap genAttr attrs++" />"
-
-pcdata :: String -> HTML
-pcdata = HTML -- need to test: is this supposed to be 'hquote'?
-
-data Attr = forall a. ToXML a => String := a
-
-toAttribute (n := v) = (n, toXMLs v)
-
-class ToXML a where
-    toXMLs :: a -> HTML
-
-instance ToXML HTML where
-    toXMLs = id
-
-instance ToXML String where
-    toXMLs = hquote
-    
-instance ToXML Integer where
-    toXMLs = hquote . show
-    
-instance ToXML a => ToXML [a] where
-    toXMLs = HTML . concatMap (unHTML . toXMLs)
-
diff -rN -u old-fenserve-1/PagePrelude.hs new-fenserve-1/PagePrelude.hs
--- old-fenserve-1/PagePrelude.hs	1970-01-01 02:00:00.000000000 +0200
+++ new-fenserve-1/PagePrelude.hs	2007-03-25 22:07:52.000000000 +0300
@@ -0,0 +1,79 @@
+{-# OPTIONS_GHC -fglasgow-exts -fallow-overlapping-instances #-}
+module PagePrelude where
+
+-- Copyright (c) 2006-2007, Benja Fallenstein, Tuukka Hastrup
+-- This file is part of Fenfire.
+-- 
+-- Fenfire is free software; you can redistribute it and/or modify it under
+-- the terms of the GNU General Public License as published by
+-- the Free Software Foundation; either version 2 of the License, or
+-- (at your option) any later version.
+-- 
+-- Fenfire is distributed in the hope that it will be useful, but WITHOUT
+-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General
+-- Public License for more details.
+-- 
+-- You should have received a copy of the GNU General
+-- Public License along with Fenfire; if not, write to the Free
+-- Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
+-- MA  02111-1307  USA
+
+import HAppS hiding (Handler, query)
+
+import Storm
+import FenServe
+
+import Data.Maybe (fromMaybe)
+
+
+pageHandler :: HTML -> Handler
+pageHandler html _request = 
+    return $ mkResult 200 "text/html" (toUTF $ unHTML html)
+    
+lookWithDefault param dflt req = fromMaybe dflt $ lookM req param
+
+newtype HTML = HTML { unHTML :: String } deriving (Show,Read,Eq,Ord)
+
+(+++) :: (ToXML a, ToXML b) => a -> b -> HTML
+x +++ y = HTML (unHTML (toXMLs x) ++ unHTML (toXMLs y))
+
+hquote :: String -> HTML
+hquote ('<':cs) = HTML $ "&lt;" ++ unHTML (hquote cs)
+hquote ('&':cs) = HTML $ "&amp;" ++ unHTML (hquote cs)
+hquote ('"':cs) = HTML $ "&quot;" ++ unHTML (hquote cs)
+hquote (c:cs) = HTML $ c : unHTML (hquote cs)
+hquote "" = HTML ""
+
+genAttr :: (String, HTML) -> String
+genAttr (n,v) = " " ++ n ++ "=\"" ++ unHTML v ++ "\""
+
+genTag :: (Maybe a, String) -> [(String, HTML)] -> [HTML] -> HTML
+genTag (Nothing, s) attrs children = HTML $
+    "<"++s++concatMap genAttr attrs++">"++concatMap unHTML children++"</"++s++">"
+    
+genETag :: (Maybe a, String) -> [(String, HTML)] -> HTML
+genETag (Nothing, s) attrs = HTML $ "<"++s++concatMap genAttr attrs++" />"
+
+pcdata :: String -> HTML
+pcdata = HTML -- need to test: is this supposed to be 'hquote'?
+
+data Attr = forall a. ToXML a => String := a
+
+toAttribute (n := v) = (n, toXMLs v)
+
+class ToXML a where
+    toXMLs :: a -> HTML
+
+instance ToXML HTML where
+    toXMLs = id
+
+instance ToXML String where
+    toXMLs = hquote
+    
+instance ToXML Integer where
+    toXMLs = hquote . show
+    
+instance ToXML a => ToXML [a] where
+    toXMLs = HTML . concatMap (unHTML . toXMLs)
+
diff -rN -u old-fenserve-1/board-demo.page new-fenserve-1/board-demo.page
--- old-fenserve-1/board-demo.page	2007-03-25 22:07:52.000000000 +0300
+++ new-fenserve-1/board-demo.page	2007-03-25 22:07:52.000000000 +0300
@@ -97,7 +97,7 @@
         <p><input type="submit"/></p>
       </form>
       
-postHandler :: Handler
+postHandler :: (?graph :: Graph, ?req :: Request) => Handler
 postHandler req = do
     let time = unsafeGetW3CTime ()
     let f = lit . g; g = fromMaybe "" . lookM ?req
@@ -117,7 +117,7 @@
     putEntry ["testdata","blog"] $ FileEntry $ bIRI bid
     pageHandler (let ?graph = graph' in renderBoard blog) ?req
 
-editHandler :: Handler
+editHandler :: (?graph :: Graph, ?req :: Request) => Handler
 editHandler req = do
     let time = unsafeGetW3CTime ()
     let f = lit . g; g = fromMaybe "" . lookM ?req
diff -rN -u old-fenserve-1/fenserve.cabal new-fenserve-1/fenserve.cabal
--- old-fenserve-1/fenserve.cabal	2007-03-25 22:07:52.000000000 +0300
+++ new-fenserve-1/fenserve.cabal	2007-03-25 22:07:52.000000000 +0300
@@ -6,6 +6,7 @@
 Maintainer:     fenfire-dev at nongnu.org
 Build-Depends:  base, mtl, network, HAppS, fenfire, glib, plugins,
                 haskell-src-exts, unix
+Exposed-Modules: FenServe, Storm, PagePrelude, SHA1
 
 Executable:     fenserve
 Main-Is:        Main.hs




More information about the Fencommits mailing list