Implemented inline images and framed images

[Rakka.git] / Rakka / Resource / Render.hs

diff --git a/Rakka/Resource/Render.hs b/Rakka/Resource/Render.hs
index 668d814b4394c0c35a11902d0a48b3b4213dbb07..6aee49f684dbe0f63f5122aa5f85049439bc5e72 100644 (file)
--- 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
@@ -163,10 +148,16 @@ handleGetEntity env
                         ) -<< ()
 
                 returnA -< do let lastMod = toClockTime $ pageLastMod page
-
-                              case pageRevision page of
-                                Nothing  -> foundTimeStamp lastMod
-                                Just rev -> foundEntity (strongETag $ show rev) lastMod
+                              
+                              -- text/x-rakka の場合は、内容が動的に生
+                              -- 成されてゐる可能性があるので、ETag も
+                              -- Last-Modified も返す事が出來ない。
+                              case pageType page of
+                                MIMEType "text" "x-rakka" _
+                                    -> return ()
+                                _   -> case pageRevision page of
+                                         Nothing  -> foundTimeStamp lastMod
+                                         Just rev -> foundEntity (strongETag $ show rev) lastMod
 
                               outputXmlPage tree entityToXHTML
 
@@ -182,24 +173,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,25 +192,19 @@ entityToXHTML
                      += ( eelem "div"
                           += sattr "class" "body"
                           += getXPathTreesInDoc "/page/content/*"
-                          += ( getXPathTreesInDoc "/page/object"
-                               `guards`
-                               eelem "object"
-                               += attr "data"
-                                      ( getXPathTreesInDoc "/page/object/@data/text()" )
-                             )
                         )
                    )
                 += ( eelem "div"
                      += sattr "class" "footer"
                    )
                 += ( eelem "div"
-                     += sattr "class" "left side-bar"
+                     += sattr "class" "left sideBar"
                      += ( eelem "div"
                           += sattr "class" "content"
                         )
                    )
                 += ( eelem "div"
-                     += sattr "class" "right side-bar"
+                     += sattr "class" "right sideBar"
                      += ( eelem "div"
                           += sattr "class" "content"
                         )