Use time-w3c instead of Rakka.W3CDateTime

diff --git a/Main.hs b/Main.hs
index 430fdfc62d1281f5e23d6a78344ffde065c37df8..866fe5d097b92bc9832446ec359242b6279ac9d8 100644 (file)
--- 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 66117ced4b5f5f8d2c7889578dea4281cb42f094..f9cd261cc84764cc3bb2ed098f254c26e8a3c71b 100644 (file)
--- 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 ea82209885001648f23c2853750c9451ba7364fe..8d3c16c04fec4e430a286ff91643b579ec7b8341 100644 (file)
--- 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 ab2ae88f3b5dac6f34d22908638eb4de50ec7739..f0a7a77be6962bc538d94b75411ab016dddeb27d 100644 (file)
--- 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 a1d4b02e85da6c2430dad72d61c60d7a7d7d2097..7476d0eeee2d2e9f0ced84370c37df1e1ee4181b 100644 (file)
--- 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 423bfdc3f32b921393c95892362dbf920f29431d..993788ded4b17001ce8cc75047549330ebdce3fe 100644 (file)
--- 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 bedc9eaa2808d3142e5d4abf91cd00d724369401..304b8178384463fc05dd86eba72daa0035f2c2ea 100644 (file)
--- 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 a6977e67286e2b35d81ce71e710018616f926fc2..05d02c29b3c2175e9cc30b8608aae4157dd6227d 100644 (file)
--- 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 aa1e5798d24ee387bac9582797fc97d492d79a17..4978b46d131bc853271438120e860b5ac17f5fdc 100644 (file)
--- 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 (file)
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 1744570b1bd5a27d805523ff9252cdc8eaece0fc..aae3a78eb6b1e1fe9a6c60f277f5b2d4c40939c2 100644 (file)
--- 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'