Resurrection from slight bitrot.

Ignore-this: 6cb780fe5a80c70cca832813921f5dc

darcs-hash:20100209122226-62b54-0b1fd8978ddbc4a5c585fe55124b06dda61f1ac2.gz

diff --git a/Rakka.cabal b/Rakka.cabal
index 286572a3f95bb5898e600fdb67cdd8da609d9f5e..3717efad7a9b646a29e1f7303fce60342e08348a 100644 (file)
--- a/Rakka.cabal
+++ b/Rakka.cabal
@@ -57,8 +57,8 @@ Executable rakka
     Build-Depends:
         FileManip, HTTP, HUnit, HsHyperEstraier, HsOpenSSL, HsSVN >=
         0.3.2, Lucu, base, bytestring, containers, dataenc, directory,
-        utf8-string, filepath, hslogger, hxt, magic, mtl, network,
-        parsec, stm, time, unix, zlib
+        utf8-string, filepath, hslogger, hxt, hxt-xpath, magic, mtl,
+        network, parsec, stm, time, unix, zlib
     Main-Is:
         Main.hs
     Other-Modules:

diff --git a/Rakka/Authorization.hs b/Rakka/Authorization.hs
index adf2da54fc9a520db5273e38acdad9bd7c215876..97927c5e1252b855784df2c6528da73043d142cd 100644 (file)
--- a/Rakka/Authorization.hs
+++ b/Rakka/Authorization.hs
@@ -21,7 +21,6 @@ import           OpenSSL.EVP.Digest
 import           Rakka.SystemConfig
 import           System.Directory
 import           System.FilePath
-import           System.IO
 
 
 data AuthDB

diff --git a/Rakka/Environment.hs b/Rakka/Environment.hs
index 82694c257e9915fc464fe6b73ad1dc5f4ead3c22..ea82209885001648f23c2853750c9451ba7364fe 100644 (file)
--- a/Rakka/Environment.hs
+++ b/Rakka/Environment.hs
@@ -24,7 +24,6 @@ import qualified Rakka.Wiki.Interpreter.Outline   as Outline
 import           Subversion.Repository
 import           System.Directory
 import           System.FilePath
-import           System.IO
 import           System.Log.Logger
 import           Text.HyperEstraier
 import           Text.XML.HXT.Arrow.XmlIOStateArrow

diff --git a/Rakka/Page.hs b/Rakka/Page.hs
index 4dd5fcf246300e5e0172fe7db987c7156b8e4fac..ab2ae88f3b5dac6f34d22908638eb4de50ec7739 100644 (file)
--- a/Rakka/Page.hs
+++ b/Rakka/Page.hs
@@ -35,7 +35,6 @@ import qualified Data.ByteString.Lazy.Char8 as L8 hiding (ByteString)
 import           Data.Char
 import           Data.Map (Map)
 import qualified Data.Map as M
-import           Data.Maybe
 import           Data.Time
 import           Network.HTTP.Lucu hiding (redirect)
 import           Network.URI hiding (fragment)
@@ -45,7 +44,7 @@ import           Rakka.W3CDateTime
 import           Subversion.Types
 import           System.FilePath.Posix
 import           Text.XML.HXT.Arrow
-import           Text.XML.HXT.DOM.TypeDefs
+import           Text.XML.HXT.XPath
 
 
 type PageName = String
@@ -128,7 +127,6 @@ encodePageName = escapeURIString isSafeChar . UTF8.encodeString . fixPageName
       fixPageName = (\ (x:xs) -> toUpper x : xs) . map (\ c -> if c == ' ' then '_' else c)
 
 
--- URI unescape して UTF-8 から decode する。
 decodePageName :: FilePath -> PageName
 decodePageName = UTF8.decodeString . unEscapeString
 

diff --git a/Rakka/Resource/Object.hs b/Rakka/Resource/Object.hs
index b46a86a30a330bbdcdbb412f09def05d66c50d86..5f5b5c51625c97c6e7524ec8336ca05f379c0432 100644 (file)
--- a/Rakka/Resource/Object.hs
+++ b/Rakka/Resource/Object.hs
@@ -4,7 +4,6 @@ module Rakka.Resource.Object
     )
     where
 
-import           Data.Maybe
 import           Network.HTTP.Lucu
 import           Network.HTTP.Lucu.Utils
 import           Rakka.Environment

diff --git a/Rakka/Resource/PageEntity.hs b/Rakka/Resource/PageEntity.hs
index a9eff98ac6c1890741ca546d7e0028c935f157c5..690695e881bc73c58c6a4c1b127064112fb1e81a 100644 (file)
--- a/Rakka/Resource/PageEntity.hs
+++ b/Rakka/Resource/PageEntity.hs
@@ -11,7 +11,6 @@ import qualified Data.Map as M
 import           Data.Maybe
 import           Data.Time
 import           Network.HTTP.Lucu
-import           Network.HTTP.Lucu.Utils
 import           Network.URI hiding (path)
 import           Rakka.Environment
 import           Rakka.Page
@@ -21,11 +20,10 @@ import           Rakka.SystemConfig
 import           Rakka.Utils
 import           Rakka.W3CDateTime
 import           Rakka.Wiki.Engine
-import           System.FilePath
+import           System.FilePath.Posix
 import           Text.HyperEstraier hiding (getText)
 import           Text.XML.HXT.Arrow
-import           Text.XML.HXT.DOM.TypeDefs
-import           Text.XML.HXT.DOM.XmlKeywords
+import           Text.XML.HXT.XPath
 
 
 fallbackPageEntity :: Environment -> [String] -> IO (Maybe ResourceDef)
@@ -45,7 +43,7 @@ fallbackPageEntity env path
           }
     where
       toPageName :: [String] -> PageName
-      toPageName = decodePageName . dropExtension . joinWith "/"
+      toPageName = decodePageName . dropExtension . joinPath
 
 
 handleGet :: Environment -> PageName -> Resource ()

diff --git a/Rakka/Resource/Render.hs b/Rakka/Resource/Render.hs
index d99cb94ea11d858efb8a5bffcf9bfaff0e9a63a2..18a7dc59487dd646621324dc74f4e433894e424d 100644 (file)
--- a/Rakka/Resource/Render.hs
+++ b/Rakka/Resource/Render.hs
@@ -8,7 +8,6 @@ import           Control.Arrow.ArrowIO
 import           Control.Arrow.ArrowList
 import           Control.Monad.Trans
 import qualified Data.ByteString.Lazy as Lazy
-import           Data.Maybe
 import           Network.HTTP.Lucu
 import           Network.HTTP.Lucu.Utils
 import           OpenSSL.EVP.Base64

diff --git a/Rakka/Resource/Search.hs b/Rakka/Resource/Search.hs
index 3f5a869c4def3d64d3e5de0fdd0ae18df1b3754c..423bfdc3f32b921393c95892362dbf920f29431d 100644 (file)
--- a/Rakka/Resource/Search.hs
+++ b/Rakka/Resource/Search.hs
@@ -22,7 +22,7 @@ import           Rakka.Wiki.Engine
 import           System.FilePath
 import           Text.HyperEstraier hiding (getText)
 import           Text.XML.HXT.Arrow
-import           Text.XML.HXT.DOM.TypeDefs
+import           Text.XML.HXT.XPath
 
 
 resSearch :: Environment -> ResourceDef

diff --git a/Rakka/Resource/SystemConfig.hs b/Rakka/Resource/SystemConfig.hs
index 1a4b796b750912adf4f85516666c1056bc275b1e..cb19011b1f3c4b6746095b21e557668b57e41fca 100644 (file)
--- a/Rakka/Resource/SystemConfig.hs
+++ b/Rakka/Resource/SystemConfig.hs
@@ -9,6 +9,7 @@ import           Rakka.Environment
 import           Rakka.Resource
 import           Rakka.SystemConfig
 import           Text.XML.HXT.Arrow
+import           Text.XML.HXT.XPath
 
 
 -- FIXME:

diff --git a/Rakka/Storage.hs b/Rakka/Storage.hs
index 73bc73499b762fdcc3ed1b56f407562e5831c8c7..d67380855316e2bd655daf72c7161af8d57ae48d 100644 (file)
--- a/Rakka/Storage.hs
+++ b/Rakka/Storage.hs
@@ -30,16 +30,13 @@ module Rakka.Storage
 
 import           Control.Arrow.ArrowIO
 import           Control.Concurrent.STM
-import           Control.Monad
 import           Control.Monad.Trans
-import           Data.Maybe
 import           Network.HTTP.Lucu
 import           Rakka.Attachment
 import           Rakka.Page
 import           Rakka.Storage.Impl
 import           Rakka.Storage.Types
 import           Subversion.Types
-import           System.IO
 import           Subversion.Repository
 import           Text.HyperEstraier hiding (WriteLock)
 

diff --git a/Rakka/Storage/Impl.hs b/Rakka/Storage/Impl.hs
index e699163b6fcecdc5ee639f88c30868efa3b2a42c..e1bad11015a987b32d95d079594ae731550f85fb 100644 (file)
--- a/Rakka/Storage/Impl.hs
+++ b/Rakka/Storage/Impl.hs
@@ -107,7 +107,7 @@ startIndexManager :: FilePath -> Repository -> (Page -> IO Document) -> IO (TCha
 startIndexManager lsdir repos mkDraft
     = do chan  <- newTChanIO
          index <- openIndex indexDir revFile
-         forkIO (loop chan index)
+         _     <- forkIO (loop chan index)
          return chan
     where
       indexDir = lsdir </> "index"

diff --git a/Rakka/Storage/Repos.hs b/Rakka/Storage/Repos.hs
index 756740eb842540f30df5a47c26651cf07c4f28ff..a6977e67286e2b35d81ce71e710018616f926fc2 100644 (file)
--- a/Rakka/Storage/Repos.hs
+++ b/Rakka/Storage/Repos.hs
@@ -375,7 +375,7 @@ deletePageFromRepository repos userID name
                           else
                             return NotFound
          when (status == NoContent)
-             $ do doReposTxn repos
+             $ ( (doReposTxn repos
                              rev
                              "[Rakka]"
                              (Just "Automatic commit by Rakka for page deleting")
@@ -385,8 +385,8 @@ deletePageFromRepository repos userID name
                                   attachmentExists <- isDirectory attachmentPath
                                   when attachmentExists
                                       $ do deleteEntry attachmentPath
-                                           deleteEmptyParentDirectories attachmentPath
-                  return ()
+                                           deleteEmptyParentDirectories attachmentPath)
+                 >> return () )
          return status
 
 

diff --git a/Rakka/W3CDateTime.hs b/Rakka/W3CDateTime.hs
index e0c1c1baa6369e61ce50d8f199a7a20409864fb9..488cd2e08eabe75c3cd76750f10b3acaaa0c7166 100644 (file)
--- a/Rakka/W3CDateTime.hs
+++ b/Rakka/W3CDateTime.hs
@@ -77,11 +77,11 @@ w3cDateTime = do year <- liftM read (count 4 digit)
                  return zonedTime
     where
       time :: Parser (Int, Int, Double, Int)
-      time = do char 'T'
+      time = do _      <- char 'T'
                 hour   <- liftM read (count 2 digit)
-                char ':'
+                _      <- char ':'
                 min    <- liftM read (count 2 digit)
-                sec    <- option 0 $ do char ':'
+                sec    <- option 0 $ do _       <- char ':'
                                         secInt  <- count 2 digit
                                         secFrac <- option "" $ do c  <- char '.'
                                                                   cs <- many1 digit
@@ -93,7 +93,7 @@ w3cDateTime = do year <- liftM read (count 4 digit)
                                     <|>
                                     (char '-' >> return (-1))
                             h    <- liftM read (count 2 digit)
-                            char ':'
+                            _    <- 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 e135f15fa77591b06ce7bda94339c3504f445edd..17c2933852ee5273485ac80fcbb570c36f6bd080 100644 (file)
--- a/Rakka/Wiki/Engine.hs
+++ b/Rakka/Wiki/Engine.hs
@@ -28,7 +28,7 @@ import           Rakka.Wiki.Interpreter
 import           Text.HyperEstraier hiding (getText)
 import           Text.ParserCombinators.Parsec
 import           Text.XML.HXT.Arrow hiding (err)
-import           Text.XML.HXT.DOM.TypeDefs
+import           Text.XML.HXT.XPath
 
 
 type InterpTable = Map String Interpreter

diff --git a/Rakka/Wiki/Formatter.hs b/Rakka/Wiki/Formatter.hs
index 90687f4e8479a1c11593e770b6cf899fd67f71ee..5f7c7d8c10b952a1c7d7df404da7bc1667e2113c 100644 (file)
--- a/Rakka/Wiki/Formatter.hs
+++ b/Rakka/Wiki/Formatter.hs
@@ -7,8 +7,6 @@ import           Control.Arrow
 import           Control.Arrow.ArrowIf
 import           Control.Arrow.ArrowList
 import           Control.Arrow.ArrowTree
-import           Data.Char
-import           Data.List
 import           Data.Maybe
 import           Network.URI hiding (fragment)
 import           Rakka.Page

diff --git a/Rakka/Wiki/Interpreter/Base.hs b/Rakka/Wiki/Interpreter/Base.hs
index 8a3ada996290f8e1e1e2c00e7932974b52b50d95..ed81494e62e4c671e13d4f2ba682251752ce8904 100644 (file)
--- a/Rakka/Wiki/Interpreter/Base.hs
+++ b/Rakka/Wiki/Interpreter/Base.hs
@@ -11,6 +11,7 @@ import           Rakka.SystemConfig
 import           Rakka.Wiki
 import           Rakka.Wiki.Interpreter
 import           Text.XML.HXT.Arrow
+import           Text.XML.HXT.XPath
 
 
 interpreters :: [Interpreter]

diff --git a/Rakka/Wiki/Interpreter/Image.hs b/Rakka/Wiki/Interpreter/Image.hs
index 80cd6c318730a794f2f5403f307e78449884ca6c..00a55de056191ae9fb53b6713907bd2b75bc1b23 100644 (file)
--- a/Rakka/Wiki/Interpreter/Image.hs
+++ b/Rakka/Wiki/Interpreter/Image.hs
@@ -3,8 +3,6 @@ module Rakka.Wiki.Interpreter.Image
     )
     where
 
-import           Control.Monad
-import           Data.Maybe
 import           Network.URI
 import           Rakka.Page
 import           Rakka.SystemConfig

diff --git a/Rakka/Wiki/Parser.hs b/Rakka/Wiki/Parser.hs
index 19170b1fb1a941a9709968d24b2ae007c7563d37..1744570b1bd5a27d805523ff9252cdc8eaece0fc 100644 (file)
--- a/Rakka/Wiki/Parser.hs
+++ b/Rakka/Wiki/Parser.hs
@@ -48,7 +48,7 @@ heading = foldr (<|>) pzero (map heading' [1..5])
           "heading"
     where
       heading' :: Int -> Parser BlockElement
-      heading' n = do try $ do count n (char '=')
+      heading' n = do try $ do _ <- count n (char '=')
                                notFollowedBy (char '=')
                       ws
                       x  <- notFollowedBy (char '=') >> anyChar
@@ -63,8 +63,8 @@ heading = foldr (<|>) pzero (map heading' [1..5])
 
 
 horizontalLine :: Parser BlockElement
-horizontalLine = try ( do count 4 (char '-')
-                          many (char '-')
+horizontalLine = try ( do _ <- count 4 (char '-')
+                          _ <- many (char '-')
                           ws
                           eol
                           return HorizontalLine
@@ -87,15 +87,15 @@ listElement cmdTypeOf = listElement' []
       items stack = do xs     <- many1 $ inlineElement cmdTypeOf
                        nested <- option Nothing
                                  $ try $ do skipMany comment
-                                            newline
-                                            string stack
+                                            _ <- newline
+                                            _ <- string stack
                                             liftM Just (listElement' stack)
                        rest <- items stack
                        return $ (map Inline xs ++ map Block (catMaybes [nested])) : rest
                     <|>
                     (try $ do skipMany comment
-                              newline
-                              string stack
+                              _ <- newline
+                              _ <- string stack
                               ws
                               items stack
                     )
@@ -112,8 +112,8 @@ definitionList :: CommandTypeOf -> Parser BlockElement
 definitionList cmdTypeOf = liftM DefinitionList (many1 definition)
     where
       definition :: Parser Definition
-      definition = do char ';'
-                      ws
+      definition = do _     <- char ';'
+                      _     <- ws
                       tHead <- inlineElement cmdTypeOf
                       tRest <- term
                       d     <- description
@@ -137,9 +137,9 @@ definitionList cmdTypeOf = liftM DefinitionList (many1 definition)
                        xs <- description
                        return (x:xs)
                     <|>
-                    try ( do newline
-                             char ':'
-                             ws
+                    try ( do _  <- newline
+                             _  <- char ':'
+                             _  <- ws
                              xs <- description
                              return (Text "\n" : xs)
                         )
@@ -152,13 +152,13 @@ definitionList cmdTypeOf = liftM DefinitionList (many1 definition)
 
 
 verbatim :: Parser BlockElement
-verbatim = do try (string "<!verbatim[")
-              many (oneOf " \t\n")
+verbatim = do _ <- try (string "<!verbatim[")
+              _ <- many (oneOf " \t\n")
               x <- verbatim'
               return (Preformatted [Text x])
     where
       verbatim' :: Parser String
-      verbatim' = do try (many (oneOf " \t\n") >> string "]>")
+      verbatim' = do _ <- try (many (oneOf " \t\n") >> string "]>")
                      return []
                   <|>
                   do x  <- anyChar
@@ -192,21 +192,27 @@ paragraph cmdTypeOf = liftM Paragraph paragraph'
     where
       paragraph' :: Parser [InlineElement]
       paragraph' = do x  <- inlineElement cmdTypeOf
-                      xs <- try ( do newline
-                                     eof
+                      xs <- try ( do _ <- newline
+                                     _ <- eof
                                      return []
                                   -- \n で文字列が終はってゐたら、ここ
                                   -- で終了。
                                 )
                             <|>
-                            try ( do newline
-                                     ((oneOf ('\n':blockSymbols) >> pzero) <|> return ())
+                            try ( do _  <- newline
+                                     _  <- ((oneOf ('\n':blockSymbols) >> pzero) <|> return ())
                                      ys <- (paragraph' <|> return [])
                                      return (Text "\n" : ys)
                                   -- \n があり、その次に \n または
                                   -- blockSymbols があれば、fail して
                                   -- 最初の newline を讀んだ所まで卷き
                                   -- 戻す。
+
+                                  -- FIXME: 本當にそのやうな動作になつ
+                                  -- てゐるか？偶然動いてゐるだけではな
+                                  -- いか？確かにこの實裝でユニットテス
+                                  -- トは通るのだが、私の理解を越えてし
+                                  -- まったやうだ。
                                 )
                             <|>
                             paragraph'
@@ -290,7 +296,7 @@ nowiki :: Parser InlineElement
 nowiki = liftM Text (try (string "<!nowiki[") >> nowiki')
     where
       nowiki' :: Parser String
-      nowiki' = do try (string "]>")
+      nowiki' = do _ <- try (string "]>")
                    return []
                 <|>
                 do x  <- anyChar
@@ -337,18 +343,18 @@ apostrophes cmdTypeOf = foldr (<|>) pzero (map try [apos1, apos2, apos3, apos4,
 
 
 objLink :: Parser InlineElement
-objLink = do try (string "[[[")
+objLink = do _     <- try (string "[[[")
              page  <- many1 (noneOf "|]")
              label <- option Nothing
                       (liftM Just (char '|' >> many1 (satisfy (/= ']'))))
-             string "]]]"
+             _     <- string "]]]"
              return $ ObjectLink page label
           <?>
           "object link"
 
 
 pageLink :: Parser InlineElement
-pageLink = do try (string "[[")
+pageLink = do _        <- try (string "[[")
               page     <- option Nothing 
                           (liftM Just (many1 (noneOf "#|]")))
               fragment <- option Nothing
@@ -360,16 +366,16 @@ pageLink = do try (string "[[")
                 (Nothing, Nothing) -> pzero
                 (_, _)             -> return ()
 
-              string "]]"
+              _ <- string "]]"
               return $ PageLink page fragment label
            <?>
            "page link"
 
 
 extLink :: Parser InlineElement
-extLink = do char '['
+extLink = do _      <- char '['
              uriStr <- many1 (noneOf " \t]")
-             skipMany (oneOf " \t")
+             _      <- skipMany (oneOf " \t")
              label  <- option Nothing
                        (liftM Just (many1 (noneOf "]")))
              
@@ -421,48 +427,48 @@ inlineCmd cmdTypeOf
 
 
 openTag :: Parser (String, [Attribute])
-openTag = try $ do char '<'
-                   many space
+openTag = try $ do _     <- char '<'
+                   _     <- many space
                    name  <- many1 letter
-                   many space
+                   _     <- many space
                    attrs <- many $ do attr <- tagAttr
-                                      many space
+                                      _    <- many space
                                       return attr
-                   char '>'
+                   _     <- char '>'
                    return (name, attrs)
 
 
 emptyTag :: Parser (String, [Attribute])
-emptyTag = try $ do char '<'
-                    many space
+emptyTag = try $ do _     <- char '<'
+                    _     <- many space
                     name  <- many1 letter
-                    many space
+                    _     <- many space
                     attrs <- many $ do attr <- tagAttr
-                                       many space
+                                       _    <- many space
                                        return attr
-                    char '/'
-                    many space
-                    char '>'
+                    _     <- char '/'
+                    _     <- many space
+                    _     <- char '>'
                     return (name, attrs)
 
 
 closeTag :: String -> Parser ()
-closeTag name = try $ do char '<'
-                         many space
-                         char '/'
-                         many space
-                         string name
-                         many space
-                         char '>'
+closeTag name = try $ do _ <- char '<'
+                         _ <- many space
+                         _ <- char '/'
+                         _ <- many space
+                         _ <- string name
+                         _ <- many space
+                         _ <- char '>'
                          return ()
 
 
 tagAttr :: Parser (String, String)
 tagAttr = do name  <- many1 letter
-             char '='
-             char '"'
+             _     <- char '='
+             _     <- char '"'
              value <- many (satisfy (/= '"'))
-             char '"'
+             _     <- char '"'
              return (name, value)