+
+
+putPageIntoRepository :: Repository -> Page -> IO StatusCode
+putPageIntoRepository repos page
+ = do let Just ui = pageUpdateInfo page
+ name = pageName page
+ ret <- doReposTxn
+ repos
+ (uiOldRevision ui)
+ "[Rakka]"
+ (Just "Automatic commit by Rakka for page updating")
+ $ do case uiOldName ui of
+ Nothing -> return ()
+ Just oldName -> renamePage oldName name
+ createPageIfNeeded name
+ updatePage name
+ case ret of
+ Left _ ->
+ return Conflict
+ Right _ ->
+ return Created
+ where
+ renamePage :: PageName -> PageName -> Txn ()
+ renamePage oldName newName
+ = fail "FIXME: renamePage: not implemented yet"
+
+ createPageIfNeeded :: PageName -> Txn ()
+ createPageIfNeeded name
+ = do let path = mkPagePath name
+ kind <- checkPath path
+ case kind of
+ NoNode -> do createParentDirectories path
+ makeFile path
+ FileNode -> return ()
+ DirNode -> fail ("createPageIfNeeded: already exists a directory: " ++ path)
+
+ createParentDirectories :: FilePath -> Txn ()
+ createParentDirectories path
+ = do let parentPath = takeDirectory path
+ kind <- checkPath parentPath
+ case kind of
+ NoNode -> createParentDirectories parentPath
+ FileNode -> fail ("createParentDirectories: already exists a file: " ++ parentPath)
+ DirNode -> return ()
+
+ updatePage :: PageName -> Txn ()
+ updatePage name
+ | isRedirect page = updatePageRedirect name
+ | isEntity page = updatePageEntity name
+ | otherwise = fail "neither redirection nor page"
+
+ updatePageRedirect :: PageName -> Txn ()
+ updatePageRedirect name
+ = fail "FIXME: updatePageRedirect: not implemented yet"
+
+ updatePageEntity :: PageName -> Txn ()
+ updatePageEntity name
+ = do let path = mkPagePath name
+ setNodeProp path "svn:mime-type" ((Just . show . entityType) page)
+ setNodeProp path "rakka:lang" (entityLanguage page)
+ setNodeProp path "rakka:fileName" (entityFileName page)
+ setNodeProp path "rakka:isTheme" (encodeFlag $ entityIsTheme page)
+ setNodeProp path "rakka:isFeed" (encodeFlag $ entityIsFeed page)
+ setNodeProp path "rakka:isLocked" (encodeFlag $ entityIsLocked page)
+ setNodeProp path "rakka:isBoring" (encodeFlag $ entityIsBoring page)
+ setNodeProp path "rakka:isBinary" (encodeFlag $ entityIsBinary page)
+ setNodeProp path "rakka:summary" (entitySummary page)
+ setNodeProp path "rakka:otherLang" (let otherLang = entityOtherLang page
+ in
+ if M.null otherLang then
+ Nothing
+ else
+ Just (serializeStringPairs $ M.toList otherLang))
+ applyTextLBS path Nothing (entityContent page)
+
+ encodeFlag :: Bool -> Maybe String
+ encodeFlag True = Just "*\n"
+ encodeFlag False = Nothing