= runIdempotentA $ proc ()
-> do pageM <- getPageA (envStorage env) -< (name, Nothing)
case pageM of
- Nothing -> handlePageNotFound env -< name
- Just page -> if isEntity page then
- handleGetEntity env -< page
- else
- handleRedirect env -< page
+ Nothing
+ -> do items <- getDirContentsA (envStorage env) -< (name, Nothing)
+ case items of
+ [] -> handlePageNotFound env -< name
+ _ -> handleGetPageListing env -< (name, items)
+ Just page
+ -> if isEntity page then
+ handleGetEntity env -< page
+ else
+ handleRedirect env -< page
{-
returnA -< subXHTML
+{-
+ <pageListing path="Foo">
+ <page name="Foo/Bar" />
+ <page name="Foo/Baz" />
+ </pageListing>
+-}
+handleGetPageListing :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a (PageName, [PageName]) (Resource ())
+handleGetPageListing env
+ = proc (dir, items)
+ -> do tree <- ( eelem "/"
+ += ( eelem "pageListing"
+ += attr "path" (arr fst >>> mkText)
+ += ( arrL snd
+ >>>
+ ( eelem "page"
+ += attr "name" (arr id >>> mkText)
+ )
+ )
+ )
+ ) -< (dir, items)
+ returnA -< outputXmlPage tree (pageListingToXHTML env)
+
+
+pageListingToXHTML :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a XmlTree XmlTree
+pageListingToXHTML env
+ = proc pageListing
+ -> do SiteName siteName <- getSysConfA (envSysConf env) -< ()
+ BaseURI baseURI <- getSysConfA (envSysConf env) -< ()
+ StyleSheet styleSheet <- getSysConfA (envSysConf env) -< ()
+ GlobalLock isGLocked <- getSysConfA (envSysConf env) -< ()
+
+ name <- (getXPathTreesInDoc "/pageListing/@path/text()" >>> getText) -< pageListing
+
+ let cssHref = [uriToString id (mkObjectURI baseURI styleSheet) ""]
+ scriptSrc = [uriToString id (baseURI { uriPath = uriPath baseURI </> "js" }) ""]
+
+ pageTitle <- listA (readSubPage env) -< (name, Nothing, "PageTitle")
+ leftSideBar <- listA (readSubPage env) -< (name, Nothing, "SideBar/Left")
+ rightSideBar <- listA (readSubPage env) -< (name, Nothing, "SideBar/Right")
+
+ ( eelem "/"
+ += ( eelem "html"
+ += sattr "xmlns" "http://www.w3.org/1999/xhtml"
+ += ( eelem "head"
+ += ( eelem "title"
+ += txt siteName
+ += txt " - "
+ += getXPathTreesInDoc "/pageListing/@path/text()"
+ )
+ += ( constL cssHref
+ >>>
+ eelem "link"
+ += sattr "rel" "stylesheet"
+ += sattr "type" "text/css"
+ += attr "href" (arr id >>> mkText)
+ )
+ += ( constL scriptSrc
+ >>>
+ eelem "script"
+ += sattr "type" "text/javascript"
+ += attr "src" (arr id >>> mkText)
+ )
+ += ( eelem "script"
+ += sattr "type" "text/javascript"
+ += txt ("Rakka.baseURI = \"" ++ uriToString id baseURI "" ++ "\";")
+ += txt ("Rakka.isGlobalLocked=" ++ trueOrFalse isGLocked ++ ";")
+ )
+ )
+ += ( eelem "body"
+ += ( eelem "div"
+ += sattr "class" "header"
+ )
+ += ( eelem "div"
+ += sattr "class" "center"
+ += ( eelem "div"
+ += sattr "class" "title"
+ += constL pageTitle
+ )
+ += ( eelem "div"
+ += sattr "class" "body"
+ += ( eelem "ul"
+ += ( getXPathTreesInDoc "/pageListing/page/@name/text()"
+ >>>
+ eelem "li"
+ += ( eelem "a"
+ += attr "href" ( getText
+ >>>
+ arr (\ x -> uriToString id (mkPageURI baseURI x) "")
+ >>>
+ mkText
+ )
+ += this
+ )
+ )
+ )
+ )
+ )
+ += ( eelem "div"
+ += sattr "class" "footer"
+ )
+ += ( eelem "div"
+ += sattr "class" "left sideBar"
+ += ( eelem "div"
+ += sattr "class" "content"
+ += constL leftSideBar
+ )
+ )
+ += ( eelem "div"
+ += sattr "class" "right sideBar"
+ += ( eelem "div"
+ += sattr "class" "content"
+ += constL rightSideBar
+ )
+ )
+ )
+ >>>
+ uniqueNamespacesFromDeclAndQNames
+ ) ) -<< pageListing
+
+
{-
<pageNotFound name="Foo/Bar" />
-}
, putPageA
, deletePageA
+ , getDirContents
+ , getDirContentsA
+
, searchPages
, rebuildIndex
deletePageA = arrIO2 . deletePage
+getDirContents :: MonadIO m => Storage -> PageName -> Maybe RevNum -> m [PageName]
+getDirContents = ((liftIO .) .) . getDirContents' . stoRepository
+
+
+getDirContentsA :: ArrowIO a => Storage -> a (PageName, Maybe RevNum) [PageName]
+getDirContentsA = arrIO2 . getDirContents
+
+
searchPages :: MonadIO m => Storage -> Condition -> m [(PageName, RevNum)]
searchPages sto cond
= liftIO $
module Rakka.Storage.DefaultPage
( findAllDefaultPages
+ , getDefaultDirContents
, loadDefaultPage
)
where
return . S.fromList . map (decodePageName . makeRelative dirPath . dropExtension)
+getDefaultDirContents :: PageName -> IO (Set PageName)
+getDefaultDirContents dir
+ -- ./defaultPages が存在するなら、その中を探す。無ければ Cabal で
+ -- defaultPages を探す。
+ = do localDirExists <- doesLocalDirExist
+ if localDirExists then
+ getDir' "defaultPages"
+ else
+ -- FIXME: この getDataFileName の使ひ方は undocumented
+ getDir' =<< getDataFileName "defaultPages"
+ where
+ getDir' :: FilePath -> IO (Set PageName)
+ getDir' dirPath
+ = getDirectoryContents (dirPath </> encodePageName dir)
+ >>=
+ return . S.fromList . map (m dirPath) . filter f
+
+ m :: FilePath -> FilePath -> PageName
+ m dirPath = (dir </>) . decodePageName . makeRelative dirPath . dropExtension
+
+ f :: FilePath -> Bool
+ f "." = False
+ f ".." = False
+ f _ = True
+
+
loadDefaultPage :: PageName -> IO (Maybe Page)
loadDefaultPage name
-- ./defaultPages が存在するなら、./defaultPages/Foo.xml を探す。無
( getPage'
, putPage'
, deletePage'
+ , getDirContents'
, startIndexManager
)
where
return . S.unions
+getDirContents' :: Repository -> PageName -> Maybe RevNum -> IO [PageName]
+getDirContents' repos name rev
+ = do reposPages <- getDirContentsInRevision repos name rev
+ defaultPages <- getDefaultDirContents name
+ return $ S.toList (reposPages `S.union` defaultPages)
+
+
getCurrentRevNum :: Repository -> IO RevNum
getCurrentRevNum repos
= getRepositoryFS repos >>= getYoungestRev
module Rakka.Storage.Repos
( findAllPagesInRevision
+ , getDirContentsInRevision
, findChangedPagesAtRevision
, loadPageInRepository
, putPageIntoRepository
= "/pages" </> encodePageName name <.> "page"
+mkDirPath :: PageName -> FilePath
+mkDirPath dir
+ = "/pages" </> encodePageName dir
+
+
findAllPagesInRevision :: Repository -> RevNum -> IO (Set PageName)
findAllPagesInRevision repos rev
= do fs <- getRepositoryFS repos
decodePath = decodePageName . makeRelative root . dropExtension
+getDirContentsInRevision :: Repository -> PageName -> Maybe RevNum -> IO (Set PageName)
+getDirContentsInRevision repos dir rev
+ = do fs <- getRepositoryFS repos
+ rev' <- case rev of
+ Nothing -> getYoungestRev fs
+ Just r -> return r
+ withRevision fs rev'
+ $ do exists <- isDirectory path
+ if exists then
+ return . S.fromList =<< getDir'
+ else
+ return S.empty
+ where
+ path :: FilePath
+ path = mkDirPath dir
+
+ getDir' :: Rev [PageName]
+ getDir' = getDirEntries path >>= return . map entToName
+
+ entToName :: DirEntry -> PageName
+ entToName = (dir </>) . decodePageName . dropExtension . entName
+
+
findChangedPagesAtRevision :: Repository -> RevNum -> IO (Set PageName)
findChangedPagesAtRevision repos rev
= do fs <- getRepositoryFS repos
Just r -> return r
withRevision fs rev'
$ do exists <- isFile path
- case exists of
- True
- -> return . Just =<< loadPage'
- False
- -> return Nothing
+ if exists then
+ return . Just =<< loadPage'
+ else
+ return Nothing
where
path :: FilePath
path = mkPagePath name
url : Rakka.baseURI + pageName + ".xml",
success: function (pageXml) {
Rakka.hideWaitingMessage();
-
- var $page = $(pageXml).find("page");
- var oldRevision = $page.attr("revision");
- var defaultType
- = $page.attr("isBinary") == "yes" ? "binary"
- : $page.attr("type") == "text/x-rakka" ? "rakka"
- : $page.attr("type") == "text/css" ? "css"
- : $page.attr("redirect") != null ? "redirect"
- : "unknown"
- ;
- var isLocked = $page.attr("isLocked") == "yes";
- var source
- = $page.attr("redirect") != null ? $page.attr("redirect")
- : $page.find("textData").text()
- ;
- var summary = $page.find("summary").text();
+
+ if (pageXml.documentElement.tagName == "page") {
+ var $page = $(pageXml).find("page");
+ var oldRevision = $page.attr("revision");
+ var defaultType
+ = $page.attr("isBinary") == "yes" ? "binary"
+ : $page.attr("type") == "text/x-rakka" ? "rakka"
+ : $page.attr("type") == "text/css" ? "css"
+ : $page.attr("redirect") != null ? "redirect"
+ : "unknown"
+ ;
+ var isLocked = $page.attr("isLocked") == "yes";
+ var source
+ = $page.attr("redirect") != null ? $page.attr("redirect")
+ : $page.find("textData").text()
+ ;
+ var summary = $page.find("summary").text();
- displayPageEditor(pageName, oldRevision, defaultType, isLocked, source, summary);
+ displayPageEditor(pageName, oldRevision, defaultType, isLocked, source, summary);
+ }
+ else {
+ displayPageEditor(pageName, null, "rakka", false, null, "");
+ }
},
error : function (req) {
Rakka.hideWaitingMessage();
projects / Rakka.git / commitdiff