[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 $ "<" ++ unHTML (hquote cs)
-hquote ('&':cs) = HTML $ "&" ++ unHTML (hquote cs)
-hquote ('"':cs) = HTML $ """ ++ 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 $ "<" ++ unHTML (hquote cs)
+hquote ('&':cs) = HTML $ "&" ++ unHTML (hquote cs)
+hquote ('"':cs) = HTML $ """ ++ 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