From: pho Date: Tue, 9 Feb 2010 12:22:26 +0000 (+0900) Subject: Resurrection from slight bitrot. X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=fcddebcc3cc02ae8d1904b9338334d538019e74a;p=Rakka.git Resurrection from slight bitrot. Ignore-this: 6cb780fe5a80c70cca832813921f5dc darcs-hash:20100209122226-62b54-0b1fd8978ddbc4a5c585fe55124b06dda61f1ac2.gz --- diff --git a/Rakka.cabal b/Rakka.cabal index 286572a..3717efa 100644 --- 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 adf2da5..97927c5 100644 --- 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 82694c2..ea82209 100644 --- 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 4dd5fcf..ab2ae88 100644 --- 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 b46a86a..5f5b5c5 100644 --- 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 a9eff98..690695e 100644 --- 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 d99cb94..18a7dc5 100644 --- 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 3f5a869..423bfdc 100644 --- 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 1a4b796..cb19011 100644 --- 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 73bc734..d673808 100644 --- 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 e699163..e1bad11 100644 --- 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 756740e..a6977e6 100644 --- 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 e0c1c1b..488cd2e 100644 --- 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 e135f15..17c2933 100644 --- 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 90687f4..5f7c7d8 100644 --- 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 8a3ada9..ed81494 100644 --- 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 80cd6c3..00a55de 100644 --- 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 19170b1..1744570 100644 --- 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 "> 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') 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)