From: PHO Date: Tue, 16 Mar 2010 06:05:20 +0000 (+0900) Subject: Use time-w3c instead of Rakka.W3CDateTime X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=223d4df57fa1371945075d4d2714e5f36c1fc5dd;p=Rakka.git Use time-w3c instead of Rakka.W3CDateTime --- diff --git a/Main.hs b/Main.hs index 430fdfc..866fe5d 100644 --- a/Main.hs +++ b/Main.hs @@ -3,7 +3,7 @@ import Control.Exception import Control.Monad import Data.List import Data.Maybe -import Network +import Network.Socket import Network.HTTP.Lucu import OpenSSL import Rakka.Environment @@ -20,7 +20,7 @@ import Rakka.Resource.SystemConfig import Rakka.Resource.Users import Rakka.Storage import Subversion -import System.Console.GetOpt +import System.Console.GetOpt -- FIXME: Use better library than this. import System.Directory import System.Environment import System.Exit @@ -40,7 +40,7 @@ logger = "Main" data CmdOpt - = OptPortNum PortNumber + = OptPortNum ServiceName | OptLSDir FilePath | OptUserName String | OptGroupName String @@ -51,8 +51,8 @@ data CmdOpt deriving (Eq, Show) -defaultPort :: PortNumber -defaultPort = toEnum 8080 +defaultPort :: ServiceName +defaultPort = "8080" defaultLocalStateDir :: FilePath defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP @@ -70,8 +70,8 @@ defaultLogLevel = NOTICE options :: [OptDescr CmdOpt] options = [ Option ['p'] ["port"] - (ReqArg (OptPortNum . toEnum . read) "NUM") - ("Port number to listen. (default: " ++ show defaultPort ++ ")") + (ReqArg OptPortNum "NUM") + ("Port number to listen. (default: " ++ defaultPort ++ ")") , Option ['d'] ["localstatedir"] (ReqArg OptLSDir "DIR") @@ -168,7 +168,7 @@ resTree env ] -getPortNum :: [CmdOpt] -> IO PortNumber +getPortNum :: [CmdOpt] -> IO ServiceName getPortNum opts = do let xs = mapMaybe (\ x -> case x of OptPortNum n -> Just n diff --git a/Rakka.cabal b/Rakka.cabal index 66117ce..f9cd261 100644 --- a/Rakka.cabal +++ b/Rakka.cabal @@ -61,10 +61,31 @@ Flag build-test-suite Executable rakka Build-Depends: - FileManip, HTTP, HUnit, HsHyperEstraier, HsOpenSSL, HsSVN >= - 0.3.2, Lucu, base, bytestring, containers, dataenc, directory, - utf8-string, filepath, hslogger, hxt, hxt-xpath, magic, mtl, - network, parsec, stm, time, unix, zlib + FileManip, + HTTP, + HsHyperEstraier, + HsOpenSSL, + HsSVN >= 0.3.2, + Lucu >= 0.5, + base, + bytestring, + containers, + dataenc, + directory, + filepath, + utf8-string, + hslogger, + hxt, + hxt-xpath, + magic, + mtl, + network, + parsec, + stm, + time, + time-w3c, + unix, + zlib Main-Is: Main.hs Other-Modules: @@ -93,7 +114,6 @@ Executable rakka Rakka.TrackBack Rakka.Utils Rakka.Validation - Rakka.W3CDateTime Rakka.Wiki Rakka.Wiki.Interpreter Rakka.Wiki.Interpreter.Base @@ -113,6 +133,7 @@ Executable rakka Executable RakkaUnitTest if flag(build-test-suite) Buildable: True + Build-Depends: HUnit else Buildable: False Main-Is: diff --git a/Rakka/Environment.hs b/Rakka/Environment.hs index ea82209..8d3c16c 100644 --- a/Rakka/Environment.hs +++ b/Rakka/Environment.hs @@ -8,7 +8,7 @@ module Rakka.Environment import Control.Arrow import Control.Arrow.ArrowList import qualified Data.Map as M -import Network +import Network.Socket import qualified Network.HTTP.Lucu.Config as LC import Rakka.Authorization import Rakka.Page @@ -44,10 +44,10 @@ data Environment = Environment { } -setupEnv :: FilePath -> PortNumber -> IO Environment +setupEnv :: FilePath -> ServiceName -> IO Environment setupEnv lsdir portNum = do let lucuConf = LC.defaultConfig { - LC.cnfServerPort = PortNumber portNum + LC.cnfServerPort = portNum } reposPath = lsdir "repos" interpTable = mkInterpTable diff --git a/Rakka/Page.hs b/Rakka/Page.hs index ab2ae88..f0a7a77 100644 --- a/Rakka/Page.hs +++ b/Rakka/Page.hs @@ -36,11 +36,11 @@ import Data.Char import Data.Map (Map) import qualified Data.Map as M import Data.Time +import qualified Data.Time.W3C as W3C import Network.HTTP.Lucu hiding (redirect) import Network.URI hiding (fragment) import OpenSSL.EVP.Base64 import Rakka.Utils -import Rakka.W3CDateTime import Subversion.Types import System.FilePath.Posix import Text.XML.HXT.Arrow @@ -237,7 +237,7 @@ xmlizePage += sattr "redirect" (redirDest page) += sattr "isLocked" (yesOrNo $ redirIsLocked page) += sattr "revision" (show $ redirRevision page) - += sattr "lastModified" (formatW3CDateTime lastMod) + += sattr "lastModified" (W3C.format lastMod) )) -<< () xmlizeEntity :: (ArrowXml a, ArrowChoice a, ArrowIO a) => a Page XmlTree @@ -263,7 +263,7 @@ xmlizePage += sattr "isLocked" (yesOrNo $ entityIsLocked page) += sattr "isBinary" (yesOrNo $ entityIsBinary page) += sattr "revision" (show $ entityRevision page) - += sattr "lastModified" (formatW3CDateTime lastMod) + += sattr "lastModified" (W3C.format lastMod) += ( case entitySummary page of Just s -> eelem "summary" += txt s Nothing -> none diff --git a/Rakka/Resource/PageEntity.hs b/Rakka/Resource/PageEntity.hs index a1d4b02..7476d0e 100644 --- a/Rakka/Resource/PageEntity.hs +++ b/Rakka/Resource/PageEntity.hs @@ -10,6 +10,7 @@ import Data.Char import qualified Data.Map as M import Data.Maybe import Data.Time +import qualified Data.Time.W3C as W3C import Network.HTTP.Lucu import Network.URI hiding (path) import Rakka.Environment @@ -18,7 +19,6 @@ import Rakka.Resource import Rakka.Storage import Rakka.SystemConfig import Rakka.Utils -import Rakka.W3CDateTime import Rakka.Wiki.Engine import System.FilePath.Posix import Text.HyperEstraier hiding (getText) @@ -263,7 +263,7 @@ entityToRSS env += ( eelem "dc:date" += ( arrIO (utcToLocalZonedTime . entityLastMod) >>> - arr formatW3CDateTime + arr W3C.format >>> mkText ) diff --git a/Rakka/Resource/Search.hs b/Rakka/Resource/Search.hs index 423bfdc..993788d 100644 --- a/Rakka/Resource/Search.hs +++ b/Rakka/Resource/Search.hs @@ -8,6 +8,7 @@ import Control.Monad.Trans import Data.List import Data.Maybe import Data.Time +import qualified Data.Time.W3C as W3C import Network.HTTP.Lucu import Network.HTTP.Lucu.RFC1123DateTime import Network.URI hiding (query, fragment) @@ -17,7 +18,6 @@ import Rakka.Resource import Rakka.Storage import Rakka.SystemConfig import Rakka.Utils -import Rakka.W3CDateTime import Rakka.Wiki.Engine import System.FilePath import Text.HyperEstraier hiding (getText) @@ -116,7 +116,7 @@ handleSearch env += attr "name" (arr hpPageName >>> mkText) += attr "lastModified" ( arrIO (utcToLocalZonedTime . hpLastMod) >>> - arr formatW3CDateTime + arr W3C.format >>> mkText ) @@ -281,7 +281,7 @@ searchResultToXHTML env += sattr "class" "date" += ( getAttrValue "lastModified" >>> - arr (zonedTimeToUTC . fromJust . parseW3CDateTime) + arr (zonedTimeToUTC . fromJust . W3C.parse) >>> arrIO utcToLocalZonedTime >>> diff --git a/Rakka/Storage/Impl.hs b/Rakka/Storage/Impl.hs index bedc9ea..304b817 100644 --- a/Rakka/Storage/Impl.hs +++ b/Rakka/Storage/Impl.hs @@ -18,6 +18,7 @@ import Data.Maybe import Data.Set (Set) import qualified Data.Set as S import Data.Time +import qualified Data.Time.W3C as W3C import Network.HTTP.Lucu import Network.HTTP.Lucu.Utils import Network.URI @@ -27,7 +28,6 @@ import Rakka.Page import Rakka.Storage.DefaultPage import Rakka.Storage.Repos import Rakka.Storage.Types -import Rakka.W3CDateTime import Subversion.Types import Subversion.FileSystem import Subversion.Repository @@ -212,7 +212,7 @@ searchIndex index cond liftM (read . fromJust) (getDocAttr index docId "rakka:revision") lastMod <- unsafeInterleaveIO $ - liftM (zonedTimeToUTC . fromJust . parseW3CDateTime . fromJust) + liftM (zonedTimeToUTC . fromJust . W3C.parse . fromJust) (getDocAttr index docId "@mdate") summary <- unsafeInterleaveIO $ getDocAttr index docId "rakka:summary" diff --git a/Rakka/Storage/Repos.hs b/Rakka/Storage/Repos.hs index a6977e6..05d02c2 100644 --- a/Rakka/Storage/Repos.hs +++ b/Rakka/Storage/Repos.hs @@ -19,12 +19,12 @@ import Data.Maybe import Data.Set (Set) import qualified Data.Set as S hiding (Set) import Data.Time +import qualified Data.Time.W3C as W3C import Network.HTTP.Lucu hiding (redirect) import Rakka.Attachment import Rakka.Page import Rakka.SystemConfig import Rakka.Utils -import Rakka.W3CDateTime import Subversion.FileSystem import Subversion.FileSystem.DirEntry import Subversion.FileSystem.Revision @@ -163,7 +163,7 @@ loadPageInRepository repos name rev $ fmap chomp (lookup "svn:mime-type" props) lastMod <- unsafeIOToFS $ - liftM (fromJust . parseW3CDateTime . chomp . fromJust) + liftM (fromJust . W3C.parse . chomp . fromJust) (getRevisionProp' fs pageRev "svn:date") return Entity { @@ -198,7 +198,7 @@ loadPageInRepository repos name rev dest = chomp $ decodeString content lastMod <- unsafeIOToFS $ - liftM (fromJust . parseW3CDateTime . chomp . fromJust) + liftM (fromJust . W3C.parse . chomp . fromJust) (getRevisionProp' fs pageRev "svn:date") isLocked <- liftM isJust (getNodeProp path "rakka:isLocked") diff --git a/Rakka/SystemConfig.hs b/Rakka/SystemConfig.hs index aa1e579..4978b46 100644 --- a/Rakka/SystemConfig.hs +++ b/Rakka/SystemConfig.hs @@ -34,7 +34,7 @@ import Data.Map (Map) import qualified Data.Map as M import Data.Maybe import GHC.Conc (unsafeIOToSTM) -import Network +import Network.BSD import qualified Network.HTTP.Lucu.Config as LC import Network.HTTP.Lucu.Utils import Network.HTTP.Lucu hiding (Config) @@ -48,6 +48,7 @@ import Subversion.FileSystem.Transaction import Subversion.Repository import Subversion.Types import System.FilePath.Posix +import System.IO.Unsafe import System.Log.Logger @@ -225,11 +226,14 @@ instance SysConfValue BaseURI where defaultValue sc = let conf = scLucuConf sc host = C8.unpack $ LC.cnfServerHost conf - port = case LC.cnfServerPort conf of - PortNumber num -> fromIntegral num :: Int - _ -> undefined + port = unsafePerformIO $ + do ent <- getServiceByName (LC.cnfServerPort conf) "tcp" + return (servicePort ent) + -- FIXME: There should be a way to change configurations + -- without web interface nor direct repository + -- modification. defaultURI - = "http://" ++ host ++ -- FIXME: consider IPv6 address + = "http://" ++ host ++ (if port == 80 then "" else ':' : show port) ++ "/" diff --git a/Rakka/W3CDateTime.hs b/Rakka/W3CDateTime.hs deleted file mode 100644 index 488cd2e..0000000 --- a/Rakka/W3CDateTime.hs +++ /dev/null @@ -1,99 +0,0 @@ -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/Parser.hs b/Rakka/Wiki/Parser.hs index 1744570..aae3a78 100644 --- a/Rakka/Wiki/Parser.hs +++ b/Rakka/Wiki/Parser.hs @@ -204,15 +204,11 @@ paragraph cmdTypeOf = liftM Paragraph paragraph' ys <- (paragraph' <|> return []) return (Text "\n" : ys) -- \n があり、その次に \n または - -- blockSymbols があれば、fail して - -- 最初の newline を讀んだ所まで卷き - -- 戻す。 - - -- FIXME: 本當にそのやうな動作になつ - -- てゐるか？偶然動いてゐるだけではな - -- いか？確かにこの實裝でユニットテス - -- トは通るのだが、私の理解を越えてし - -- まったやうだ。 + -- blockSymbols があれば、fail して最 + -- 初の newline を讀んだ所まで卷き戻 + -- す。oneOf が一文字消費しているので、 + -- <|> は右辺を適用せずに try まで戻 + -- る。 ) <|> paragraph'