]> gitweb @ CieloNegro.org - Rakka.git/blob - Rakka/Resource/PageEntity.hs
Resurrection from slight bitrot.
[Rakka.git] / Rakka / Resource / PageEntity.hs
1 module Rakka.Resource.PageEntity
2     ( fallbackPageEntity
3     )
4     where
5
6 import qualified Codec.Binary.UTF8.String as UTF8
7 import           Control.Monad.Trans
8 import qualified Data.ByteString.Lazy as L hiding (ByteString)
9 import           Data.Char
10 import qualified Data.Map as M
11 import           Data.Maybe
12 import           Data.Time
13 import           Network.HTTP.Lucu
14 import           Network.URI hiding (path)
15 import           Rakka.Environment
16 import           Rakka.Page
17 import           Rakka.Resource
18 import           Rakka.Storage
19 import           Rakka.SystemConfig
20 import           Rakka.Utils
21 import           Rakka.W3CDateTime
22 import           Rakka.Wiki.Engine
23 import           System.FilePath.Posix
24 import           Text.HyperEstraier hiding (getText)
25 import           Text.XML.HXT.Arrow
26 import           Text.XML.HXT.XPath
27
28
29 fallbackPageEntity :: Environment -> [String] -> IO (Maybe ResourceDef)
30 fallbackPageEntity env path
31     | null path                  = return Nothing
32     | null $ head path           = return Nothing
33     | isLower $ head $ head path = return Nothing -- 先頭の文字が小文字であってはならない
34     | otherwise
35         = return $ Just $ ResourceDef {
36             resUsesNativeThread = False
37           , resIsGreedy         = True
38           , resGet              = Just $ handleGet    env (toPageName path)
39           , resHead             = Nothing
40           , resPost             = Nothing
41           , resPut              = Just $ handlePut    env (toPageName path)
42           , resDelete           = Just $ handleDelete env (toPageName path)
43           }
44     where
45       toPageName :: [String] -> PageName
46       toPageName = decodePageName . dropExtension . joinPath
47
48
49 handleGet :: Environment -> PageName -> Resource ()
50 handleGet env name
51     = do BaseURI baseURI <- getSysConf (envSysConf env)
52          runIdempotentA baseURI $ proc ()
53              -> do pageM <- getPageA (envStorage env) -< (name, Nothing)
54                    case pageM of
55                      Nothing
56                          -> do items <- getDirContentsA (envStorage env) -< (name, Nothing)
57                                case items of
58                                  [] -> handlePageNotFound   env -< name
59                                  _  -> handleGetPageListing env -< (name, items)
60                      Just page
61                          -> if isEntity page then
62                                 handleGetEntity env -< page
63                             else
64                                 handleRedirect env -< page
65
66
67 {-
68   HTTP/1.1 302 Found
69   Location: http://example.org/Destination.html#Redirect:Source
70 -}
71 handleRedirect :: (ArrowXml a, ArrowIO a) => Environment -> a Page (Resource ())
72 handleRedirect env
73     = proc redir
74     -> returnA -< do mType <- getEntityType
75                      case mType of
76                        MIMEType "text" "xml" _
77                            -> do setContentType mType
78                                  [resultStr] <- liftIO $ runX ( setErrorMsgHandler False fail
79                                                                 >>>
80                                                                 constA redir
81                                                                 >>>
82                                                                 xmlizePage
83                                                                 >>>
84                                                                 writeDocumentToString [ (a_indent         , v_1 )
85                                                                                       , (a_output_encoding, utf8)
86                                                                                       , (a_no_xml_pi      , v_0 ) ]
87                                                               )
88                                  output resultStr
89
90                        _   -> do BaseURI baseURI <- getSysConf (envSysConf env)
91                                  let uri = mkPageFragmentURI
92                                            baseURI
93                                            (redirDest redir)
94                                            ("Redirect:" ++ redirName redir)
95                                  redirect Found uri
96
97
98 handleGetEntity :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a Page (Resource ())
99 handleGetEntity env
100     = proc page
101     -> do tree <- xmlizePage -< page
102           returnA -< outputXmlPage tree [ (MIMEType "application" "xhtml+xml" [], entityToXHTML env)
103                                         , (MIMEType "application" "rss+xml"   [], entityToRSS   env)
104                                         ]
105
106
107 entityToXHTML :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a XmlTree XmlTree
108 entityToXHTML env
109     = proc page
110     -> do SiteName   siteName   <- getSysConfA (envSysConf env) -< ()
111           BaseURI    baseURI    <- getSysConfA (envSysConf env) -< ()
112           StyleSheet styleSheet <- getSysConfA (envSysConf env) -< ()
113           GlobalLock isGLocked  <- getSysConfA (envSysConf env) -< ()
114
115           name     <- (getXPathTreesInDoc "/page/@name/text()" >>> getText) -< page
116           isLocked <- (getXPathTreesInDoc "/page/@isLocked/text()" >>> getText >>> parseYesOrNo) -< page
117
118           let cssHref   = [uriToString id (mkObjectURI baseURI styleSheet) ""]
119               scriptSrc = [uriToString id (baseURI { uriPath = uriPath baseURI </> "js" }) ""]
120
121           pageTitle    <- listA (readSubPage env) -< (name, Just page, "PageTitle")
122           leftSideBar  <- listA (readSubPage env) -< (name, Just page, "SideBar/Left")
123           rightSideBar <- listA (readSubPage env) -< (name, Just page, "SideBar/Right")
124           pageBody     <- listA (makeMainXHTML (envStorage env) (envSysConf env) (envInterpTable env)) -< page
125
126           ( eelem "/"
127             += ( eelem "html"
128                  += sattr "xmlns" "http://www.w3.org/1999/xhtml"
129                  += ( getXPathTreesInDoc "/page/@lang"
130                       `guards`
131                       qattr (mkQName "xml" "lang" "")
132                                 ( getXPathTreesInDoc "/page/@lang/text()" )
133                     )
134                  += ( eelem "head"
135                       += ( eelem "title"
136                            += txt siteName
137                            += txt " - "
138                            += getXPathTreesInDoc "/page/@name/text()"
139                          )
140                       += ( constL cssHref
141                            >>>
142                            eelem "link"
143                            += sattr "rel"  "stylesheet"
144                            += sattr "type" "text/css"
145                            += attr "href" (arr id >>> mkText)
146                          )
147                       += mkFeedList env
148                       += ( constL scriptSrc
149                            >>>
150                            eelem "script"
151                            += sattr "type" "text/javascript"
152                            += attr "src" (arr id >>> mkText)
153                          )
154                       += ( eelem "script"
155                            += sattr "type" "text/javascript"
156                            += txt ("Rakka.baseURI=\"" ++ uriToString id baseURI "" ++ "\";")
157                            += txt ("Rakka.isLocked=" ++ trueOrFalse isLocked ++ ";")
158                            += txt ("Rakka.isGlobalLocked=" ++ trueOrFalse isGLocked ++ ";")
159                          )
160                       += mkGlobalJSList env
161                     )
162                  += ( eelem "body"
163                       += ( eelem "div"
164                            += sattr "class" "header"
165                          )
166                       += ( eelem "div"
167                            += sattr "class" "center"
168                            += ( eelem "div"
169                                 += sattr "class" "title"
170                                 += constL pageTitle
171                               )
172                            += ( eelem "div"
173                                 += sattr "class" "body"
174                                 += constL pageBody
175                               )
176                          )
177                       += ( eelem "div"
178                            += sattr "class" "footer"
179                          )
180                       += ( eelem "div"
181                            += sattr "class" "left sideBar"
182                            += ( eelem "div"
183                                 += sattr "class" "content"
184                                 += constL leftSideBar
185                               )
186                          )
187                       += ( eelem "div"
188                            += sattr "class" "right sideBar"
189                            += ( eelem "div"
190                                 += sattr "class" "content"
191                                 += constL rightSideBar
192                               )
193                          )
194                     )
195                  >>>
196                  uniqueNamespacesFromDeclAndQNames
197                ) ) -<< page
198
199
200 entityToRSS :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a XmlTree XmlTree
201 entityToRSS env
202     = proc page
203     -> do SiteName   siteName   <- getSysConfA (envSysConf env) -< ()
204           BaseURI    baseURI    <- getSysConfA (envSysConf env) -< ()
205
206           name    <- (getXPathTreesInDoc "/page/@name/text()" >>> getText) -< page
207           summary <- maybeA (getXPathTreesInDoc "/page/summary/text()" >>> getText) -< page
208           pages   <- makePageLinkList (envStorage env) (envSysConf env) (envInterpTable env) -< page
209           
210           ( eelem "/"
211             += ( eelem "rdf:RDF"
212                  += sattr "xmlns"           "http://purl.org/rss/1.0/"
213                  += sattr "xmlns:rdf"       "http://www.w3.org/1999/02/22-rdf-syntax-ns#"
214                  += sattr "xmlns:dc"        "http://purl.org/dc/elements/1.1/"
215                  += sattr "xmlns:trackback" "http://madskills.com/public/xml/rss/module/trackback/"
216                  += ( eelem "channel"
217                       += sattr "rdf:about" (uriToString id (mkFeedURI baseURI name) "")
218                       += ( eelem "title"
219                            += txt siteName
220                            += txt " - "
221                            += getXPathTreesInDoc "/page/@name/text()"
222                          )
223                       += ( eelem "link"
224                            += txt (uriToString id baseURI "")
225                          )
226                       += ( eelem "description"
227                            += txt (case summary of
228                                      Nothing -> "RSS Feed for " ++ siteName
229                                      Just s  -> s)
230                          )
231                       += ( eelem "items"
232                            += ( eelem "rdf:Seq"
233                                 += ( constL pages
234                                      >>>
235                                      eelem "rdf:li"
236                                      += attr "resource" (arr (mkPageURIStr baseURI) >>> mkText)
237                                    )
238                               )
239                          )
240                     )
241                  += ( constL pages
242                       >>>
243                       arr (\ n -> (n, Nothing))
244                       >>>
245                       getPageA (envStorage env)
246                       >>>
247                       arr fromJust
248                       >>>
249                       eelem "item"
250                       += attr "rdf:about" (arr (mkPageURIStr baseURI . entityName) >>> mkText)
251                       += ( eelem "title"
252                            += (arr entityName >>> mkText)
253                          )
254                       += ( eelem "link"
255                            += (arr (mkPageURIStr baseURI . entityName) >>> mkText)
256                          )
257                       += ( arrL (\ p -> case entitySummary p of
258                                           Nothing -> []
259                                           Just s  -> [s])
260                            >>>
261                            eelem "description"
262                            += mkText
263                          )
264                       += ( eelem "dc:date"
265                            += ( arrIO (utcToLocalZonedTime . entityLastMod)
266                                 >>>
267                                 arr formatW3CDateTime
268                                 >>>
269                                 mkText
270                               )
271                          )
272                       += ( eelem "trackback:ping"
273                            += attr "rdf:resource" (arr (mkTrackbackURIStr baseURI . entityName) >>> mkText)
274                          )
275                     )
276                  >>>
277                  uniqueNamespacesFromDeclAndQNames
278                ) ) -<< page
279     where
280       mkPageURIStr :: URI -> PageName -> String
281       mkPageURIStr baseURI name
282             = uriToString id (mkPageURI baseURI name) ""
283
284       mkTrackbackURIStr :: URI -> PageName -> String
285       mkTrackbackURIStr baseURI name
286             = uriToString id (mkAuxiliaryURI baseURI ["trackback"] name) ""
287
288
289 readSubPage :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
290                Environment
291             -> a (PageName, Maybe XmlTree, PageName) XmlTree
292 readSubPage env
293     = proc (mainPageName, mainPage, subPageName) ->
294       do langM        <- case mainPage of
295                            Nothing
296                                -> returnA -< Nothing
297                            Just p
298                                -> maybeA (getXPathTreesInDoc "/page/@lang/text()" >>> getText) -< p
299          subPage      <- getPageA (envStorage env) >>> arr fromJust -< (subPageName, Nothing)
300          localSubPage <- case langM of
301                            Nothing
302                                -> returnA -< subPage
303                            Just l
304                                -> localize (envStorage env) -< (l, subPage)
305          subPageXml   <- xmlizePage -< localSubPage
306          subXHTML     <- makeSubXHTML (envStorage env) (envSysConf env) (envInterpTable env)
307                          -< (Just mainPageName, mainPage, subPageXml)
308          returnA -< subXHTML
309     where
310       localize :: (ArrowChoice a, ArrowIO a) => Storage -> a (LanguageTag, Page) Page
311       localize sto
312           = proc (lang, origPage)
313           -> do let otherLang = entityOtherLang origPage
314                     localName = M.lookup lang otherLang
315                 case localName of
316                   Nothing
317                       -> returnA -< origPage
318                   Just ln
319                       -> do localPage <- getPageA sto -< (ln, Nothing)
320                             returnA -< case localPage of
321                                          Nothing -> origPage
322                                          Just p  -> p
323
324
325 {-
326   <pageListing path="Foo">
327     <page name="Foo/Bar" />
328     <page name="Foo/Baz" />
329   </pageListing>
330 -}
331 handleGetPageListing :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a (PageName, [PageName]) (Resource ())
332 handleGetPageListing env
333     = proc (dir, items)
334     -> do tree <- ( eelem "/"
335                     += ( eelem "pageListing"
336                          += attr "path" (arr fst >>> mkText)
337                          += ( arrL snd
338                               >>> 
339                               ( eelem "page"
340                                 += attr "name" (arr id >>> mkText)
341                               )
342                             )
343                        )
344                   ) -< (dir, items)
345           returnA -< outputXmlPage' tree (pageListingToXHTML env) -- FIXME: rss 對應
346
347
348 pageListingToXHTML :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a XmlTree XmlTree
349 pageListingToXHTML env
350     = proc pageListing
351     -> do SiteName   siteName   <- getSysConfA (envSysConf env) -< ()
352           BaseURI    baseURI    <- getSysConfA (envSysConf env) -< ()
353           StyleSheet styleSheet <- getSysConfA (envSysConf env) -< ()
354           GlobalLock isGLocked  <- getSysConfA (envSysConf env) -< ()
355
356           name <- (getXPathTreesInDoc "/pageListing/@path/text()" >>> getText) -< pageListing
357
358           let cssHref   = [uriToString id (mkObjectURI baseURI styleSheet) ""]
359               scriptSrc = [uriToString id (baseURI { uriPath = uriPath baseURI </> "js" }) ""]
360
361           pageTitle    <- listA (readSubPage env) -< (name, Nothing, "PageTitle")
362           leftSideBar  <- listA (readSubPage env) -< (name, Nothing, "SideBar/Left")
363           rightSideBar <- listA (readSubPage env) -< (name, Nothing, "SideBar/Right")
364
365           ( eelem "/"
366             += ( eelem "html"
367                  += sattr "xmlns" "http://www.w3.org/1999/xhtml"
368                  += ( eelem "head"
369                       += ( eelem "title"
370                            += txt siteName
371                            += txt " - "
372                            += getXPathTreesInDoc "/pageListing/@path/text()"
373                          )
374                       += ( constL cssHref
375                            >>>
376                            eelem "link"
377                            += sattr "rel"  "stylesheet"
378                            += sattr "type" "text/css"
379                            += attr "href" (arr id >>> mkText)
380                          )
381                       += mkFeedList env
382                       += ( constL scriptSrc
383                            >>>
384                            eelem "script"
385                            += sattr "type" "text/javascript"
386                            += attr "src" (arr id >>> mkText)
387                          )
388                       += ( eelem "script"
389                            += sattr "type" "text/javascript"
390                            += txt ("Rakka.baseURI = \"" ++ uriToString id baseURI "" ++ "\";")
391                            += txt ("Rakka.isGlobalLocked=" ++ trueOrFalse isGLocked ++ ";")
392                          )
393                       += mkGlobalJSList env
394                     )
395                  += ( eelem "body"
396                       += ( eelem "div"
397                            += sattr "class" "header"
398                          )
399                       += ( eelem "div"
400                            += sattr "class" "center"
401                            += ( eelem "div"
402                                 += sattr "class" "title"
403                                 += constL pageTitle
404                               )
405                            += ( eelem "div"
406                                 += sattr "class" "body"
407                                 += ( eelem "ul"
408                                      += ( getXPathTreesInDoc "/pageListing/page/@name/text()"
409                                           >>>
410                                           eelem "li"
411                                           += ( eelem "a"
412                                                += attr "href" ( getText
413                                                                 >>>
414                                                                 arr (\ x -> uriToString id (mkPageURI baseURI x) "")
415                                                                 >>>
416                                                                 mkText
417                                                               )
418                                                += this
419                                              )
420                                         )
421                                    )
422                               )
423                          )
424                       += ( eelem "div"
425                            += sattr "class" "footer"
426                          )
427                       += ( eelem "div"
428                            += sattr "class" "left sideBar"
429                            += ( eelem "div"
430                                 += sattr "class" "content"
431                                 += constL leftSideBar
432                               )
433                          )
434                       += ( eelem "div"
435                            += sattr "class" "right sideBar"
436                            += ( eelem "div"
437                                 += sattr "class" "content"
438                                 += constL rightSideBar
439                               )
440                          )
441                     )
442                  >>>
443                  uniqueNamespacesFromDeclAndQNames
444                ) ) -<< pageListing
445
446
447 {-
448   <pageNotFound name="Foo/Bar" />
449 -}
450 handlePageNotFound :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a PageName (Resource ())
451 handlePageNotFound env
452     = proc name
453     -> do tree <- ( eelem "/"
454                     += ( eelem "pageNotFound"
455                          += attr "name" (arr id >>> mkText)
456                        )
457                   ) -< name
458           returnA -< do setStatus NotFound
459                         outputXmlPage' tree (notFoundToXHTML env)
460
461
462 notFoundToXHTML :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a XmlTree XmlTree
463 notFoundToXHTML env
464     = proc pageNotFound
465     -> do SiteName   siteName   <- getSysConfA (envSysConf env) -< ()
466           BaseURI    baseURI    <- getSysConfA (envSysConf env) -< ()
467           StyleSheet styleSheet <- getSysConfA (envSysConf env) -< ()
468           GlobalLock isGLocked  <- getSysConfA (envSysConf env) -< ()
469
470           name <- (getXPathTreesInDoc "/pageNotFound/@name/text()" >>> getText) -< pageNotFound
471
472           let cssHref   = [uriToString id (mkObjectURI baseURI styleSheet) ""]
473               scriptSrc = [uriToString id (baseURI { uriPath = uriPath baseURI </> "js" }) ""]
474
475           pageTitle    <- listA (readSubPage env) -< (name, Nothing, "PageTitle")
476           leftSideBar  <- listA (readSubPage env) -< (name, Nothing, "SideBar/Left")
477           rightSideBar <- listA (readSubPage env) -< (name, Nothing, "SideBar/Right")
478
479           ( eelem "/"
480             += ( eelem "html"
481                  += sattr "xmlns" "http://www.w3.org/1999/xhtml"
482                  += ( eelem "head"
483                       += ( eelem "title"
484                            += txt siteName
485                            += txt " - "
486                            += getXPathTreesInDoc "/pageNotFound/@name/text()"
487                          )
488                       += ( constL cssHref
489                            >>>
490                            eelem "link"
491                            += sattr "rel"  "stylesheet"
492                            += sattr "type" "text/css"
493                            += attr "href" (arr id >>> mkText)
494                          )
495                       += mkFeedList env
496                       += ( constL scriptSrc
497                            >>>
498                            eelem "script"
499                            += sattr "type" "text/javascript"
500                            += attr "src" (arr id >>> mkText)
501                          )
502                       += ( eelem "script"
503                            += sattr "type" "text/javascript"
504                            += txt ("Rakka.baseURI = \"" ++ uriToString id baseURI "" ++ "\";")
505                            += txt ("Rakka.isGlobalLocked=" ++ trueOrFalse isGLocked ++ ";")
506                          )
507                       += mkGlobalJSList env
508                     )
509                  += ( eelem "body"
510                       += ( eelem "div"
511                            += sattr "class" "header"
512                          )
513                       += ( eelem "div"
514                            += sattr "class" "center"
515                            += ( eelem "div"
516                                 += sattr "class" "title"
517                                 += constL pageTitle
518                               )
519                            += ( eelem "div"
520                                 += sattr "class" "body"
521                                 += txt "404 Not Found (FIXME)" -- FIXME
522                               )
523                          )
524                       += ( eelem "div"
525                            += sattr "class" "footer"
526                          )
527                       += ( eelem "div"
528                            += sattr "class" "left sideBar"
529                            += ( eelem "div"
530                                 += sattr "class" "content"
531                                 += constL leftSideBar
532                               )
533                          )
534                       += ( eelem "div"
535                            += sattr "class" "right sideBar"
536                            += ( eelem "div"
537                                 += sattr "class" "content"
538                                 += constL rightSideBar
539                               )
540                          )
541                     )
542                  >>>
543                  uniqueNamespacesFromDeclAndQNames
544                ) ) -<< pageNotFound
545
546
547 handlePut :: Environment -> PageName -> Resource ()
548 handlePut env name
549     = do userID <- getUserID env
550          runXmlA env "rakka-page-1.0.rng" $ proc tree
551              -> do page   <- parseXmlizedPage -< (name, tree)
552                    status <- putPageA (envStorage env) -< (userID, page)
553                    returnA  -< setStatus status
554
555
556 handleDelete :: Environment -> PageName -> Resource ()
557 handleDelete env name
558     = do userID <- getUserID env
559          status <- deletePage (envStorage env) userID name
560          setStatus status
561
562
563 mkFeedList :: (ArrowIO a, ArrowXml a) => Environment -> a b XmlTree
564 mkFeedList env
565     = proc _ -> do SiteName siteName <- getSysConfA (envSysConf env) -< ()
566                    BaseURI  baseURI  <- getSysConfA (envSysConf env) -< ()
567
568                    feed <- unlistA <<< arrIO0 (findFeeds $ envStorage env) -< ()
569                    
570                    ( eelem "link"
571                      += sattr "rel"   "alternate"
572                      += sattr "type"  "application/rss+xml"
573                      += attr  "title" (txt siteName <+> txt " - " <+> mkText)
574                      += attr  "href"  (arr (mkFeedURIStr baseURI) >>> mkText) ) -<< feed
575
576
577 findFeeds :: Storage -> IO [PageName]
578 findFeeds sto
579     = do cond <- newCondition
580          setPhrase   cond "[UVSET]"
581          addAttrCond cond "rakka:isFeed STREQ yes"
582          setOrder    cond "@uri STRA"
583          result <- searchPages sto cond
584          return (map hpPageName $ srPages result)
585
586
587 mkGlobalJSList :: (ArrowIO a, ArrowXml a, ArrowChoice a) => Environment -> a b XmlTree
588 mkGlobalJSList env
589     = proc _ -> do BaseURI baseURI  <- getSysConfA (envSysConf env) -< ()
590
591                    scriptName <- unlistA <<< arrIO0 (findJavaScripts $ envStorage env) -< ()
592                    pageM      <- getPageA (envStorage env) -< (scriptName, Nothing)
593
594                    case pageM of
595                      Nothing -> none -< ()
596                      Just page
597                          | isEntity page
598                              -> ( if entityIsBinary page then
599                                       ( eelem "script"
600                                         += sattr "type" "text/javascript"
601                                         += attr "src" (arr (mkObjectURIStr baseURI . pageName) >>> mkText) )
602                                   else
603                                       ( eelem "script"
604                                         += sattr "type" "text/javascript"
605                                         += (arr (UTF8.decode . L.unpack . entityContent) >>> mkText) )
606                                 ) -<< page
607                          | otherwise
608                              -> none -< ()
609
610
611 findJavaScripts :: Storage -> IO [PageName]
612 findJavaScripts sto
613     = do cond <- newCondition
614          setPhrase   cond "[UVSET]"
615          addAttrCond cond "@title STRBW Global/"
616          addAttrCond cond "@type  STRBW text/javascript"
617          setOrder    cond "@uri STRA"
618          result <- searchPages sto cond
619          return (map hpPageName $ srPages result)
620
621
622 mkFeedURIStr :: URI -> PageName -> String
623 mkFeedURIStr baseURI name
624     = uriToString id (mkFeedURI baseURI name) ""
625
626
627 mkObjectURIStr :: URI -> PageName -> String
628 mkObjectURIStr baseURI name
629     = uriToString id (mkObjectURI baseURI name) ""