From 9ff4eb243ae1545c62a5ab2eaf8dcb2f7c40b20d Mon Sep 17 00:00:00 2001 From: pho Date: Sun, 11 Nov 2007 16:05:14 +0900 Subject: [PATCH] Many improvements darcs-hash:20071111070514-62b54-43383f5ee0ff7790f8fc682316f98736e011fd80.gz --- Rakka.cabal | 2 + Rakka/Storage/Impl.hs | 18 +++++--- Rakka/Storage/Repos.hs | 86 ++++++++++++++++++++++++++++++++++++ Rakka/SystemConfig.hs | 3 ++ Rakka/Utils.hs | 46 -------------------- Rakka/W3CDateTime.hs | 99 ++++++++++++++++++++++++++++++++++++++++++ Rakka/Wiki/Engine.hs | 1 + 7 files changed, 202 insertions(+), 53 deletions(-) create mode 100644 Rakka/Storage/Repos.hs create mode 100644 Rakka/W3CDateTime.hs diff --git a/Rakka.cabal b/Rakka.cabal index 80c3cb2..d54dfd8 100644 --- a/Rakka.cabal +++ b/Rakka.cabal @@ -55,11 +55,13 @@ Executable rakka Rakka.Resource.PageEntity Rakka.Storage Rakka.Storage.DefaultPage + Rakka.Storage.Repos Rakka.Storage.Types Rakka.Storage.Impl Rakka.SystemConfig Rakka.Utils Rakka.Validation + Rakka.W3CDateTime Rakka.Wiki Rakka.Wiki.Interpreter Rakka.Wiki.Interpreter.Base diff --git a/Rakka/Storage/Impl.hs b/Rakka/Storage/Impl.hs index c324692..44df20d 100644 --- a/Rakka/Storage/Impl.hs +++ b/Rakka/Storage/Impl.hs @@ -14,8 +14,11 @@ import qualified Data.Set as S import Network.URI import Rakka.Page import Rakka.Storage.DefaultPage +import Rakka.Storage.Repos import Rakka.Storage.Types import Subversion.Types +import Subversion.FileSystem +import Subversion.Repository import System.Directory import System.FilePath import System.IO @@ -23,8 +26,6 @@ import System.Log.Logger import System.Posix.Files import System.Posix.Types import System.Posix.IO -import Subversion.FileSystem -import Subversion.Repository import Text.HyperEstraier hiding (WriteLock) @@ -33,20 +34,23 @@ logger = "Rakka.Storage" getPage' :: Repository -> PageName -> Maybe RevNum -> IO (Maybe Page) -getPage' _repos name _rev - = loadDefaultPage name -- FIXME +getPage' repos name rev + = do page <- loadPageInRepository repos name rev + case page of + Nothing -> loadDefaultPage name + p -> return p findAllPages :: Repository -> RevNum -> IO (Set PageName) findAllPages _ 0 = findAllDefaultPages -findAllPages _repos _rev +findAllPages repos rev = findAllDefaultPages -- FIXME findChangedPages :: Repository -> RevNum -> RevNum -> IO (Set PageName) findChangedPages repos 0 newRev = findAllPages repos newRev -findChangedPages _repos _oldRev _newRev - = fail "FIXME: not impl" +findChangedPages repos oldRev newRev + = findAllPages repos newRev -- FIXME getCurrentRevNum :: Repository -> IO RevNum diff --git a/Rakka/Storage/Repos.hs b/Rakka/Storage/Repos.hs new file mode 100644 index 0000000..92fa6b8 --- /dev/null +++ b/Rakka/Storage/Repos.hs @@ -0,0 +1,86 @@ +module Rakka.Storage.Repos + ( loadPageInRepository + ) + where + +import qualified Data.Map as M +import Data.Maybe +import Data.Time +import Network.HTTP.Lucu hiding (redirect) +import Rakka.Page +import Rakka.SystemConfig +import Rakka.Utils +import Rakka.W3CDateTime +import Subversion.Types +import Subversion.FileSystem +import Subversion.FileSystem.Revision +import Subversion.FileSystem.Root +import Subversion.Repository +import System.FilePath.Posix + + +loadPageInRepository :: Repository -> PageName -> Maybe RevNum -> IO (Maybe Page) +loadPageInRepository repos name rev + = do fs <- getRepositoryFS repos + rev' <- case rev of + Nothing -> getYoungestRev fs + Just r -> return r + withRevision fs rev' + $ do exists <- isFile path + case exists of + True + -> return . Just =<< loadPage' + False + -> return Nothing + where + path :: FilePath + path = "pages" encodePageName name + + loadPage' :: Rev Page + loadPage' = do redirect <- getNodeProp path "rakka:redirect" + case redirect of + Nothing + -> loadPageEntity + Just _ + -> loadPageRedirect + + loadPageEntity :: Rev Page + loadPageEntity + = do props <- getNodePropList path + hist <- getNodeHistory True path + content <- getFileContentsLBS path + + let pageRev = fst $ head hist + mimeType = read + $ fromMaybe "text/x-rakka" + $ fmap chomp (lookup "svn:mime-type" props) + + lastMod <- getRevisionProp "svn:date" + >>= return . fromJust . parseW3CDateTime . chomp . fromJust + + return Entity { + pageName = name + , pageType = mimeType + , pageLanguage = fmap chomp (lookup "rakka:lang" props) + , pageFileName = fmap chomp (lookup "rakka:fileName" props) + , pageIsTheme = any ((== "rakka:isTheme") . fst) props + , pageIsFeed = any ((== "rakka:isFeed") . fst) props + , pageIsLocked = any ((== "rakka:isLocked") . fst) props + , pageIsBoring = any ((== "rakka:isBoring") . fst) props + , pageIsBinary = case mimeType of + MIMEType "text" _ _ + -> any ((== "rakka:isBinary") . fst) props + _ + -> True + , pageRevision = pageRev + , pageLastMod = zonedTimeToUTC lastMod + , pageSummary = lookup "rakka:summary" props + , pageOtherLang = fromMaybe M.empty + $ fmap + (M.fromList . fromJust . deserializeStringPairs) + (lookup "rakka:otherLang" props) + , pageContent = content + } + + loadPageRedirect :: Rev Page + loadPageRedirect = fail "FIXME: loadPageRedirect: not implemented" diff --git a/Rakka/SystemConfig.hs b/Rakka/SystemConfig.hs index 10b39b3..eb526fb 100644 --- a/Rakka/SystemConfig.hs +++ b/Rakka/SystemConfig.hs @@ -12,6 +12,9 @@ module Rakka.SystemConfig , DefaultPage(..) , StyleSheet(..) , Languages(..) + + , serializeStringPairs + , deserializeStringPairs ) where diff --git a/Rakka/Utils.hs b/Rakka/Utils.hs index f58a0b8..9eb667c 100644 --- a/Rakka/Utils.hs +++ b/Rakka/Utils.hs @@ -3,15 +3,12 @@ module Rakka.Utils , parseYesOrNo , maybeA , deleteIfEmpty - , formatW3CDateTime , chomp ) where import Control.Arrow import Control.Arrow.ArrowList -import Data.Time -import Text.Printf yesOrNo :: Bool -> String @@ -42,48 +39,5 @@ deleteIfEmpty _ -> returnA -< str -formatW3CDateTime :: ZonedTime -> String -formatW3CDateTime zonedTime - = formatLocalTime (zonedTimeToLocalTime zonedTime) - ++ - formatTimeZone (zonedTimeZone zonedTime) - where - formatLocalTime :: LocalTime -> String - formatLocalTime localTime - = let (year, month, day) = toGregorian (localDay localTime) - timeOfDay = localTimeOfDay localTime - (secInt, secFrac) = properFraction (todSec timeOfDay) - in - (printf "%04d-%02d-%02dT%02d:%02d:%02d" - year - month - day - (todHour timeOfDay) - (todMin timeOfDay) - (secInt :: Int)) - ++ - (if secFrac == 0 - then "" - else tail (show secFrac)) - - formatTimeZone :: TimeZone -> String - formatTimeZone tz - = case timeZoneMinutes tz of - offset | offset < 0 -> '-':(showTZ $ negate offset) - | offset == 0 -> "Z" - | otherwise -> '+':(showTZ offset) - - showTZ :: Int -> String - showTZ offset - = let hour = offset `div` 60 - minute = offset - hour * 60 - in - show2 hour ++ ":" ++ show2 minute - - show2 :: Int -> String - show2 n | n < 10 = '0':(show n) - | otherwise = show n - - chomp :: String -> String chomp = reverse . snd . break (/= '\n') . reverse diff --git a/Rakka/W3CDateTime.hs b/Rakka/W3CDateTime.hs new file mode 100644 index 0000000..85af47a --- /dev/null +++ b/Rakka/W3CDateTime.hs @@ -0,0 +1,99 @@ +module Rakka.W3CDateTime + ( formatW3CDateTime + , parseW3CDateTime + ) + where + +import Control.Monad +import Data.Time +import Prelude hiding (min) +import Text.ParserCombinators.Parsec +import Text.Printf + + +formatW3CDateTime :: ZonedTime -> String +formatW3CDateTime zonedTime + = formatLocalTime (zonedTimeToLocalTime zonedTime) + ++ + formatTimeZone (zonedTimeZone zonedTime) + where + formatLocalTime :: LocalTime -> String + formatLocalTime localTime + = let (year, month, day) = toGregorian (localDay localTime) + timeOfDay = localTimeOfDay localTime + (secInt, secFrac) = properFraction (todSec timeOfDay) + in + (printf "%04d-%02d-%02dT%02d:%02d:%02d" + year + month + day + (todHour timeOfDay) + (todMin timeOfDay) + (secInt :: Int)) + ++ + (if secFrac == 0 + then "" + else tail (show secFrac)) + + formatTimeZone :: TimeZone -> String + formatTimeZone tz + = case timeZoneMinutes tz of + offset | offset < 0 -> '-':(showTZ $ negate offset) + | offset == 0 -> "Z" + | otherwise -> '+':(showTZ offset) + + showTZ :: Int -> String + showTZ offset + = let hour = offset `div` 60 + minute = offset - hour * 60 + in + show2 hour ++ ":" ++ show2 minute + + show2 :: Int -> String + show2 n | n < 10 = '0':(show n) + | otherwise = show n + + +parseW3CDateTime :: String -> Maybe ZonedTime +parseW3CDateTime src + = case parse w3cDateTime "" src of + Right zt -> Just zt + Left _ -> Nothing + +w3cDateTime :: Parser ZonedTime +w3cDateTime = do year <- liftM read (count 4 digit) + mon <- option 1 (char '-' >> liftM read (count 2 digit)) + day <- option 1 (char '-' >> liftM read (count 2 digit)) + (hour, min, sec, offMin) + <- option (0, 0, 0, 0) time + eof + + let julianDay = fromGregorian year mon day + timeOfDay = TimeOfDay hour min (fromRational $ toRational sec) + localTime = LocalTime julianDay timeOfDay + timeZone = minutesToTimeZone offMin + zonedTime = ZonedTime localTime timeZone + + return zonedTime + where + time :: Parser (Int, Int, Double, Int) + time = do char 'T' + hour <- liftM read (count 2 digit) + char ':' + min <- liftM read (count 2 digit) + sec <- option 0 $ do char ':' + secInt <- count 2 digit + secFrac <- option "" $ do c <- char '.' + cs <- many1 digit + return (c:cs) + return $ read (secInt ++ secFrac) + offMin <- (char 'Z' >> return 0) + <|> + (do sign <- (char '+' >> return 1) + <|> + (char '-' >> return (-1)) + h <- liftM read (count 2 digit) + char ':' + m <- liftM read (count 2 digit) + return $ sign * h * 60 + m) + return (hour, min, sec, offMin) \ No newline at end of file diff --git a/Rakka/Wiki/Engine.hs b/Rakka/Wiki/Engine.hs index 54d0ff7..3b9c6e9 100644 --- a/Rakka/Wiki/Engine.hs +++ b/Rakka/Wiki/Engine.hs @@ -23,6 +23,7 @@ import Rakka.Page import Rakka.Storage import Rakka.SystemConfig import Rakka.Utils +import Rakka.W3CDateTime import Rakka.Wiki import Rakka.Wiki.Parser import Rakka.Wiki.Formatter -- 2.40.0