[Fencommits] fenserve: non-working version of FenServe.hs that helped me figure out the approach I'll try next, for reference (note: keeping track of such alternate paths tried is one place where a fenfireish version control system might be able to do something better than current systems)
Benja Fallenstein
benja.fallenstein at gmail.com
Thu Mar 22 19:49:39 EET 2007
Fri Mar 16 19:08:44 EET 2007 Benja Fallenstein <benja.fallenstein at gmail.com>
* non-working version of FenServe.hs that helped me figure out the approach I'll try next, for reference (note: keeping track of such alternate paths tried is one place where a fenfireish version control system might be able to do something better than current systems)
diff -rN -u old-fenserve/FenServe.hs.1 new-fenserve/FenServe.hs.1
--- old-fenserve/FenServe.hs.1 1970-01-01 02:00:00.000000000 +0200
+++ new-fenserve/FenServe.hs.1 2007-03-22 19:49:37.000000000 +0200
@@ -0,0 +1,145 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+module Main 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 Storm
+import Fenfire.RDF
+import qualified Fenfire.Raptor as Raptor
+
+import HAppS
+
+import Control.Monad.State (State, get, put, modify, execState)
+
+import qualified Data.ByteString as ByteString
+import Data.ByteString (ByteString)
+import qualified Data.Map as Map
+import Data.Map (Map)
+import Data.Maybe (fromMaybe)
+import Data.Typeable
+
+import Network.URI (uriToString)
+
+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_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_representation = IRI "http://fenfire.org/2007/fenserve#representation"
+fs_mimeType = IRI "http://fenfire.org/2007/fenserve#mimeType"
+fs_language = IRI "http://fenfire.org/2007/fenserve#language"
+
+rget :: Node -> Node -> Graph -> Node
+rget p s g = getOne g s p Pos
+
+type Ptr = (BlockId, Pool)
+
+instance StartState Ptr where
+ startStateM = return $ flip addBlock Map.empty $
+ "@prefix foaf: <http://xmlns.com/foaf/0.1/>.\n" ++
+ "@prefix fs: <http://fenfire.org/2007/fenserve#>.\n" ++
+ "@prefix rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#>.\n" ++
+ "\n" ++
+ "<> foaf:primaryTopic <#dir>.\n" ++
+ "<#dir> rdf:type fs:Directory, fs:FirstVersion;\n" ++
+ " fs:entries ().\n"
+
+instance Serialize Ptr where
+ typeString _ = "FenServe.State"
+ decodeStringM = defaultDecodeStringM
+ encodeStringM = defaultEncodeStringM
+
+instance ToMessage ByteString where
+ toMessageBodyM = return
+
+asPath :: SURI -> Maybe [String]
+asPath = Just . splitPath . path
+
+main :: IO ()
+main = stdHTTP
+ [ h asPath GET $ ok $ \uri () -> get >>= return . Right . getURI uri
+ , h asPath PUT $ ok $ \uri () -> do
+ Request { rqBody=Body body } <- getEvent
+ modify (putURI uri body); return $ Right "Ok."
+ ]
+
+readGraph :: (BlockId, Pool) -> Graph
+readGraph (bid, pool) = raptorToGraph triples namespaces uri where
+ uri = ("b:" ++ bid)
+ (triples, namespaces) =
+ unsafePerformIO $ Raptor.stringToTriples (pool Map.! bid) uri
+
+writeGraph :: Graph -> Pool -> (BlockId, Pool)
+writeGraph graph pool = addBlock body pool where
+ (triples, namespaces) = graphToRaptor graph
+ body = unsafePerformIO $ Raptor.triplesToString triples namespaces ""
+
+type M = State (Graph, Pool)
+
+execM :: (String -> M ()) -> (BlockId, Pool) -> (BlockId, Pool)
+execM m (bid, pool) = let g = getGraph (bid, pool)
+ uri = "b:" ++ bid
+ (g', pool') = execState (m uri) (g, pool)
+ in writeGraph g' pool'
+
+getGraph :: M Graph; getGraph = gets fst
+putGraph :: Graph -> M (); putGraph g = modify $ \(_,p) -> (g,p)
+
+getURI :: [String] -> (BlockId, Pool) -> ByteString
+getURI _ _ = error "foo"
+--getURI [] (File s) = s
+--getURI (x:xs) (Dir m) = getURI xs (m Map.! x)
+
+putURI :: [String] -> ByteString -> Endo (BlockId, Pool)
+putURI (x:xs) s = execM $ \uri -> do
+ let dir = IRI $ uri ++ "#dir"
+ entries = readRDFList dir graph
+ upd :: [Node] -> M [Node]
+ upd (e:es) = do g <- getGraph
+ let fn = rget fs_filename e
+ if (isJust fn) then do
+ ...
+ else do
+ es' <- upd es; return (e:es')
+ upd [] = do ...
+ upd . readRDFList dir graph =<< getGraph
+ (subdir', pool') = putURI xs subdir pool
+
+--putURI [x] s (Dir m) = Dir $ Map.insert x (File s) m
+--putURI (x:xs) s (Dir m) = Dir $ updateWithDefault (Dir Map.empty) (putURI xs s) x m
+
+updateWithDefault :: Ord k => a -> (a -> a) -> k -> Map k a -> Map k a
+updateWithDefault x f = Map.alter (Just . f . fromMaybe x)
+
+--------------------------------------------------------------------------
+-- Copied from HAppS.Protocols.SimpleHTTP2, which is BSD3-licensed
+--------------------------------------------------------------------------
+
+splitPath :: String -> [String]
+splitPath ('/':x) = a : splitPath b where (a,b) = break (=='/') x
+splitPath [] = []
+splitPath _ = error "splitPath: malformed path"
+
+--------------------------------------------------------------------------
More information about the Fencommits
mailing list