X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FResource%2FPageEntity.hs;h=8fd0ed4d4024b39cc851a6ec88b4441225ef8c8b;hb=b82b7cb90c3c3666ada1e2a2777c902850f831a2;hp=3ff0bba4a9ff9529926f464cd587bf5a8779f3b1;hpb=cac96112c79075ff03dd38616a314dd293699170;p=Rakka.git

diff --git a/Rakka/Resource/PageEntity.hs b/Rakka/Resource/PageEntity.hs
index 3ff0bba..8fd0ed4 100644
--- a/Rakka/Resource/PageEntity.hs
+++ b/Rakka/Resource/PageEntity.hs
@@ -3,10 +3,6 @@ module Rakka.Resource.PageEntity
     )
     where
 
-import           Control.Arrow
-import           Control.Arrow.ArrowIO
-import           Control.Arrow.ArrowIf
-import           Control.Arrow.ArrowList
 import           Control.Monad.Trans
 import           Data.Char
 import qualified Data.Map as M
@@ -25,11 +21,7 @@ import           Rakka.W3CDateTime
 import           Rakka.Wiki.Engine
 import           System.FilePath
 import           Text.HyperEstraier hiding (getText)
-import           Text.XML.HXT.Arrow.Namespace
-import           Text.XML.HXT.Arrow.WriteDocument
-import           Text.XML.HXT.Arrow.XmlArrow
-import           Text.XML.HXT.Arrow.XmlIOStateArrow
-import           Text.XML.HXT.Arrow.XmlNodeSet
+import           Text.XML.HXT.Arrow
 import           Text.XML.HXT.DOM.TypeDefs
 import           Text.XML.HXT.DOM.XmlKeywords
 
@@ -124,7 +116,8 @@ entityToXHTML env
           let cssHref   = [uriToString id (mkObjectURI baseURI styleSheet) ""]
               scriptSrc = [uriToString id (baseURI { uriPath = uriPath baseURI </> "js" }) ""]
 
-          feeds <- arrIO0 (findFeeds (envStorage env)) -< ()
+          feeds       <- arrIO0 (findFeeds (envStorage env)) -< ()
+          javaScripts <- arrIO0 (findJavaScripts (envStorage env)) -< ()
 
           pageTitle    <- listA (readSubPage env) -< (name, Just page, "PageTitle")
           leftSideBar  <- listA (readSubPage env) -< (name, Just page, "SideBar/Left")
@@ -172,6 +165,12 @@ entityToXHTML env
                            += txt ("Rakka.isLocked=" ++ trueOrFalse isLocked ++ ";")
                            += txt ("Rakka.isGlobalLocked=" ++ trueOrFalse isGLocked ++ ";")
                          )
+                      += ( constL javaScripts
+                           >>>
+                           eelem "script"
+                           += sattr "type" "text/javascript"
+                           += attr "src" (arr (mkObjectURIStr baseURI) >>> mkText)
+                         )
                     )
                  += ( eelem "body"
                       += ( eelem "div"
@@ -372,6 +371,9 @@ pageListingToXHTML env
           let cssHref   = [uriToString id (mkObjectURI baseURI styleSheet) ""]
               scriptSrc = [uriToString id (baseURI { uriPath = uriPath baseURI </> "js" }) ""]
 
+          feeds       <- arrIO0 (findFeeds (envStorage env)) -< ()
+          javaScripts <- arrIO0 (findJavaScripts (envStorage env)) -< ()
+
           pageTitle    <- listA (readSubPage env) -< (name, Nothing, "PageTitle")
           leftSideBar  <- listA (readSubPage env) -< (name, Nothing, "SideBar/Left")
           rightSideBar <- listA (readSubPage env) -< (name, Nothing, "SideBar/Right")
@@ -392,6 +394,14 @@ pageListingToXHTML env
                            += sattr "type" "text/css"
                            += attr "href" (arr id >>> mkText)
                          )
+                      += ( constL feeds
+                           >>>
+                           eelem "link"
+                           += sattr "rel"   "alternate"
+                           += sattr "type"  "application/rss+xml"
+                           += attr  "title" (txt siteName <+> txt " - " <+> mkText)
+                           += attr  "href"  (arr (mkFeedURIStr baseURI) >>> mkText)
+                         )
                       += ( constL scriptSrc
                            >>>
                            eelem "script"
@@ -403,6 +413,12 @@ pageListingToXHTML env
                            += txt ("Rakka.baseURI = \"" ++ uriToString id baseURI "" ++ "\";")
                            += txt ("Rakka.isGlobalLocked=" ++ trueOrFalse isGLocked ++ ";")
                          )
+                      += ( constL javaScripts
+                           >>>
+                           eelem "script"
+                           += sattr "type" "text/javascript"
+                           += attr "src" (arr (mkObjectURIStr baseURI) >>> mkText)
+                         )
                     )
                  += ( eelem "body"
                       += ( eelem "div"
@@ -484,6 +500,9 @@ notFoundToXHTML env
           let cssHref   = [uriToString id (mkObjectURI baseURI styleSheet) ""]
               scriptSrc = [uriToString id (baseURI { uriPath = uriPath baseURI </> "js" }) ""]
 
+          feeds       <- arrIO0 (findFeeds (envStorage env)) -< ()
+          javaScripts <- arrIO0 (findJavaScripts (envStorage env)) -< ()
+
           pageTitle    <- listA (readSubPage env) -< (name, Nothing, "PageTitle")
           leftSideBar  <- listA (readSubPage env) -< (name, Nothing, "SideBar/Left")
           rightSideBar <- listA (readSubPage env) -< (name, Nothing, "SideBar/Right")
@@ -504,6 +523,14 @@ notFoundToXHTML env
                            += sattr "type" "text/css"
                            += attr "href" (arr id >>> mkText)
                          )
+                      += ( constL feeds
+                           >>>
+                           eelem "link"
+                           += sattr "rel"   "alternate"
+                           += sattr "type"  "application/rss+xml"
+                           += attr  "title" (txt siteName <+> txt " - " <+> mkText)
+                           += attr  "href"  (arr (mkFeedURIStr baseURI) >>> mkText)
+                         )
                       += ( constL scriptSrc
                            >>>
                            eelem "script"
@@ -515,6 +542,12 @@ notFoundToXHTML env
                            += txt ("Rakka.baseURI = \"" ++ uriToString id baseURI "" ++ "\";")
                            += txt ("Rakka.isGlobalLocked=" ++ trueOrFalse isGLocked ++ ";")
                          )
+                      += ( constL javaScripts
+                           >>>
+                           eelem "script"
+                           += sattr "type" "text/javascript"
+                           += attr "src" (arr (mkObjectURIStr baseURI) >>> mkText)
+                         )
                     )
                  += ( eelem "body"
                       += ( eelem "div"
@@ -580,6 +613,22 @@ findFeeds sto
          return (map hpPageName $ srPages result)
 
 
+findJavaScripts :: Storage -> IO [PageName]
+findJavaScripts sto
+    = do cond <- newCondition
+         setPhrase   cond "[UVSET]"
+         addAttrCond cond "@title STRBW Global/"
+         addAttrCond cond "@type  STRBW text/javascript"
+         setOrder    cond "@uri STRA"
+         result <- searchPages sto cond
+         return (map hpPageName $ srPages result)
+
+
 mkFeedURIStr :: URI -> PageName -> String
 mkFeedURIStr baseURI name
-    = uriToString id (mkFeedURI baseURI name) ""
\ No newline at end of file
+    = uriToString id (mkFeedURI baseURI name) ""
+
+
+mkObjectURIStr :: URI -> PageName -> String
+mkObjectURIStr baseURI name
+    = uriToString id (mkObjectURI baseURI name) ""