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
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
import System.Posix.Files
import System.Posix.Types
import System.Posix.IO
-import Subversion.FileSystem
-import Subversion.Repository
import Text.HyperEstraier hiding (WriteLock)
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
--- /dev/null
+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"
, DefaultPage(..)
, StyleSheet(..)
, Languages(..)
+
+ , serializeStringPairs
+ , deserializeStringPairs
)
where
, parseYesOrNo
, maybeA
, deleteIfEmpty
- , formatW3CDateTime
, chomp
)
where
import Control.Arrow
import Control.Arrow.ArrowList
-import Data.Time
-import Text.Printf
yesOrNo :: Bool -> String
_ -> 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
--- /dev/null
+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
import Rakka.Storage
import Rakka.SystemConfig
import Rakka.Utils
+import Rakka.W3CDateTime
import Rakka.Wiki
import Rakka.Wiki.Parser
import Rakka.Wiki.Formatter
projects / Rakka.git / commitdiff