+
+
+createParentDirectories :: FilePath -> Txn ()
+createParentDirectories path
+ = do let parentPath = takeDirectory path
+ kind <- checkPath parentPath
+ case kind of
+ NoNode -> do createParentDirectories parentPath
+ makeDirectory parentPath
+ FileNode -> fail ("createParentDirectories: already exists a file: " ++ parentPath)
+ DirNode -> return ()
+
+
+deletePageFromRepository :: Repository -> Maybe String -> PageName -> IO StatusCode
+deletePageFromRepository repos userID name
+ = do let pagePath = mkPagePath name
+ attachmentPath = mkAttachmentDirPath name
+ fs <- getRepositoryFS repos
+ rev <- getYoungestRev fs
+ status <- withRevision fs rev
+ $ do exists <- isFile pagePath
+ if exists then
+ do prop <- getNodeProp pagePath "rakka:isLocked"
+ return $ case prop of
+ Just _
+ -> if isNothing userID then
+ -- 施錠されてゐるので匿名では駄目
+ Forbidden
+ else
+ NoContent
+ Nothing
+ -> NoContent
+ else
+ return NotFound
+ when (status == NoContent)
+ $ ( (doReposTxn repos
+ rev
+ "[Rakka]"
+ (Just "Automatic commit by Rakka for page deleting")
+ $ do deleteEntry pagePath
+ deleteEmptyParentDirectories pagePath
+
+ attachmentExists <- isDirectory attachmentPath
+ when attachmentExists
+ $ do deleteEntry attachmentPath
+ deleteEmptyParentDirectories attachmentPath)
+ >> return () )
+ return status
+
+
+deleteEmptyParentDirectories :: FilePath -> Txn ()
+deleteEmptyParentDirectories path
+ = do let parentPath = takeDirectory path
+ contents <- getDirEntries parentPath
+ when (null contents)
+ $ do deleteEntry parentPath
+ deleteEmptyParentDirectories parentPath
+
+
+loadAttachmentInRepository :: forall a. Attachment a =>
+ Repository
+ -> PageName
+ -> String
+ -> Maybe RevNum
+ -> IO (Maybe a)
+loadAttachmentInRepository repos pName aName rev
+ = do fs <- getRepositoryFS repos
+ rev' <- case rev of
+ Nothing -> getYoungestRev fs
+ Just r -> return r
+ withRevision fs rev'
+ $ do exists <- isFile path
+ if exists then
+ return . Just =<< loadAttachment'
+ else
+ return Nothing
+ where
+ path :: FilePath
+ path = mkAttachmentPath pName aName
+
+ loadAttachment' :: Rev a
+ loadAttachment' = liftM (deserializeFromString . decodeString) (getFileContents path)
+
+
+putAttachmentIntoRepository :: Attachment a =>
+ Repository
+ -> Maybe String
+ -> Maybe RevNum
+ -> PageName
+ -> String
+ -> a
+ -> IO StatusCode
+putAttachmentIntoRepository repos userID oldRev pName aName attachment
+ = do let author = fromMaybe "[Rakka]" userID
+ path = mkAttachmentPath pName aName
+ fs <- getRepositoryFS repos
+ oldRev' <- case oldRev of
+ Nothing -> getYoungestRev fs
+ Just r -> return r
+ ret <- doReposTxn
+ repos
+ oldRev'
+ author
+ (Just "Automatic commit by Rakka for putting attachment")
+ $ do exists <- isFile path
+ unless exists
+ $ do createParentDirectories path
+ makeFile path
+ applyText path Nothing (encodeString $ serializeToString attachment)
+ case ret of
+ Left _ -> return Conflict
+ Right _ -> return NoContent