X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FResource%2FRender.hs;h=e9929903e75fce46e92bd45fc717bbb0632c6666;hb=1647278f9393f7382b6e8b8a5e9e14ce50aae718;hp=668d814b4394c0c35a11902d0a48b3b4213dbb07;hpb=8a7556db44cd91ac0bb52279472bcc2abaa3f18e;p=Rakka.git

diff --git a/Rakka/Resource/Render.hs b/Rakka/Resource/Render.hs
index 668d814..e992990 100644
--- a/Rakka/Resource/Render.hs
+++ b/Rakka/Resource/Render.hs
@@ -4,7 +4,6 @@ module Rakka.Resource.Render
     where
 
 import           Control.Arrow
-import           Control.Arrow.ArrowIf
 import           Control.Arrow.ArrowIO
 import           Control.Arrow.ArrowList
 import           Data.Char
@@ -72,11 +71,8 @@ handleRedirect env
 
 
 {-
-  [pageIsBinary が False の場合]
-
   <page site="CieloNegro"
-        baseURI="http://example.org/"
-        styleSheet="StyleSheet/Default"
+        styleSheet="http://example.org/object/StyleSheet/Default"
         name="Foo/Bar"
         type="text/x-rakka"
         isTheme="no"        -- text/css の場合のみ存在
@@ -97,11 +93,6 @@ handleRedirect env
       blah blah...
     </content>
   </page>
-
-  
-  [pageIsBinary が True の場合: content 要素の代はりに object 要素]
-  
-  <object data="/object/Foo/Bar" /> -- data 屬性に URI
 -}
 handleGetEntity :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a Page (Resource ())
 handleGetEntity env
@@ -115,8 +106,7 @@ handleGetEntity env
                 tree <- ( eelem "/"
                           += ( eelem "page"
                                += sattr "site"       siteName
-                               += sattr "baseURI"    (uriToString id baseURI "")
-                               += sattr "styleSheet" cssName
+                               += sattr "styleSheet" (uriToString id (mkObjectURI baseURI cssName) "")
                                += sattr "name"       (pageName page)
                                += sattr "type"       (show $ pageType page)
                                += ( case pageType page of
@@ -149,13 +139,8 @@ handleGetEntity env
                                               += sattr "page" page
                                                   | (lang, page) <- xs ]
                                   )
-                                                  
-                               += ( case pageIsBinary page of
-                                      False -> eelem "content"
-                                               += (constA page >>> formatPage)
-
-                                      True  -> eelem "object"
-                                               += sattr "data" (uriToString id (mkObjectURI baseURI $ pageName page) "")
+                               += ( eelem "content"
+                                    += (constA page >>> formatPage env )
                                   )
                                >>>
                                uniqueNamespacesFromDeclAndQNames
@@ -182,24 +167,11 @@ entityToXHTML
                      += txt " - "
                      += getXPathTreesInDoc "/page/@name/text()"
                    )
-                += ( eelem "base"
-                     += attr "href"
-                            ( getXPathTreesInDoc "/page/@baseURI/text()" )
-                   )
                 += ( eelem "link"
                      += sattr "rel"  "stylesheet"
                      += sattr "type" "text/css"
                      += attr "href"
-                            ( txt "./object/"
-                              <+>
-                              getXPathTreesInDoc "/page/@styleSheet/text()"
-                              >>>
-                              getText
-                              >>>
-                              arr encodePageName
-                              >>>
-                              mkText
-                            )
+                            ( getXPathTreesInDoc "/page/@styleSheet/text()" )
                    )
               )
            += ( eelem "body"
@@ -214,12 +186,6 @@ entityToXHTML
                      += ( eelem "div"
                           += sattr "class" "body"
                           += getXPathTreesInDoc "/page/content/*"
-                          += ( getXPathTreesInDoc "/page/object"
-                               `guards`
-                               eelem "object"
-                               += attr "data"
-                                      ( getXPathTreesInDoc "/page/object/@data/text()" )
-                             )
                         )
                    )
                 += ( eelem "div"