From: PHO Date: Tue, 14 Feb 2012 17:29:40 +0000 (+0900) Subject: merge branch origin/master X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Rakka.git;a=commitdiff_plain;h=45bce2c29948649f74ada71f2fa851bdb812e96c;hp=42f51754dea02201aececaacbf194d714cd58aaf merge branch origin/master --- diff --git a/.ditz-plugins b/.ditz-plugins new file mode 100644 index 0000000..2756e1e --- /dev/null +++ b/.ditz-plugins @@ -0,0 +1 @@ +- git diff --git a/.gitignore b/.gitignore index e42ea34..df6652b 100644 --- a/.gitignore +++ b/.gitignore @@ -8,6 +8,8 @@ configure Setup dist/ +.ditz-config + Rakka/Resource/JavaScript.hs js/packed.js js/yuicompressor-*.jar diff --git a/Main.hs b/Main.hs index cf4cf88..3df4d8b 100644 --- a/Main.hs +++ b/Main.hs @@ -8,7 +8,7 @@ import Data.List import Data.Maybe import Network.Socket import Network.HTTP.Lucu -import OpenSSL +import OpenSSL import Rakka.Environment import Rakka.Resource.CheckAuth import Rakka.Resource.DumpRepos @@ -19,11 +19,10 @@ import Rakka.Resource.Object import Rakka.Resource.Render import Rakka.Resource.Search import Rakka.Resource.SystemConfig --- import Rakka.Resource.TrackBack 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 @@ -166,7 +165,6 @@ resTree env , (["search.html" ], resSearch env) , (["search.xml" ], resSearch env) , (["systemConfig"], resSystemConfig env) - -- , (["trackback" ], resTrackBack env) , (["users" ], resUsers env) ] diff --git a/Rakka.cabal b/Rakka.cabal index 6345b45..9eeac5a 100644 --- a/Rakka.cabal +++ b/Rakka.cabal @@ -9,10 +9,12 @@ Author: PHO Maintainer: PHO Stability: experimental Homepage: http://rakka.cielonegro.org/ +Bug-Reports: http://static.cielonegro.org/ditz/Rakka/ Category: Web Tested-With: GHC == 6.12.1 Cabal-Version: >= 1.6 Build-Type: Custom + Data-Files: defaultPages/Feed.xml defaultPages/Help/SampleImage/Large.xml @@ -28,6 +30,7 @@ Data-Files: defaultPages/StyleSheet/Default.xml rc.d/NetBSD/rakka.in schemas/rakka-page-1.0.rng + Extra-Source-Files: Rakka.buildinfo.in configure @@ -61,16 +64,35 @@ Flag build-test-suite Executable rakka Build-Depends: + HsHyperEstraier == 0.4.*, + HsOpenSSL == 0.10.*, + HsSVN == 0.4.*, + Lucu == 0.7.*, + base == 4.*, base-unicode-symbols == 0.2.*, + bytestring == 0.9.*, case-insensitive == 0.4.*, + containers == 0.4.*, + dataenc == 0.14.*, + directory == 1.1.*, filemanip == 0.3.*, - text == 0.11.*, + filepath == 1.2.*, + hslogger == 1.1.*, + hxt == 9.2.*, hxt-relaxng == 9.1.*, + hxt-xpath == 9.1.*, + magic == 1.0.*, + mtl == 2.0.*, + network == 2.3.*, + parsec == 3.1.*, + stm == 2.2.*, + text == 0.11.*, + time == 1.2.*, time-http == 0.1.*, - 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 + time-w3c == 0.1.*, + unix == 2.4.*, + utf8-string == 0.3.*, + zlib == 0.5.* Main-Is: Main.hs @@ -90,7 +112,6 @@ Executable rakka Rakka.Resource.Render Rakka.Resource.Search Rakka.Resource.SystemConfig - Rakka.Resource.TrackBack Rakka.Resource.Users Rakka.Storage Rakka.Storage.DefaultPage @@ -98,16 +119,13 @@ Executable rakka Rakka.Storage.Types Rakka.Storage.Impl Rakka.SystemConfig - Rakka.TrackBack Rakka.Utils Rakka.Validation - Rakka.W3CDateTime Rakka.Wiki Rakka.Wiki.Interpreter Rakka.Wiki.Interpreter.Base Rakka.Wiki.Interpreter.Image Rakka.Wiki.Interpreter.PageList - Rakka.Wiki.Interpreter.Trackback Rakka.Wiki.Interpreter.Outline Rakka.Wiki.Engine Rakka.Wiki.Formatter @@ -119,13 +137,18 @@ Executable rakka Executable RakkaUnitTest if flag(build-test-suite) Buildable: True + Build-Depends: HUnit else Buildable: False + Main-Is: RakkaUnitTest.hs + Hs-Source-Dirs: ., tests + Other-Modules: WikiParserTest + GHC-Options: -Wall -Werror diff --git a/Rakka/Environment.hs b/Rakka/Environment.hs index c526c89..2de28b2 100644 --- a/Rakka/Environment.hs +++ b/Rakka/Environment.hs @@ -21,7 +21,6 @@ import Rakka.Wiki.Interpreter import qualified Rakka.Wiki.Interpreter.Base as Base import qualified Rakka.Wiki.Interpreter.Image as Image import qualified Rakka.Wiki.Interpreter.PageList as PageList ---import qualified Rakka.Wiki.Interpreter.Trackback as Trackback import qualified Rakka.Wiki.Interpreter.Outline as Outline import Subversion.Repository import System.Directory @@ -88,7 +87,6 @@ mkInterpTable = listToTable $ concat [ Base.interpreters , Image.interpreters , PageList.interpreters - --, Trackback.interpreters , Outline.interpreters ] where diff --git a/Rakka/Page.hs b/Rakka/Page.hs index f845f7e..b4c88fc 100644 --- a/Rakka/Page.hs +++ b/Rakka/Page.hs @@ -51,12 +51,12 @@ import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding 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 OpenSSL.EVP.Base64 import Prelude.Unicode import Rakka.Utils -import Rakka.W3CDateTime import Subversion.Types import System.FilePath.Posix import Text.XML.HXT.Arrow.XmlArrow @@ -67,7 +67,6 @@ type PageName = Text type LanguageTag = CI Text -- See RFC 3066: http://www.ietf.org/rfc/rfc3066.txt type LanguageName = Text -- i.e. "日本語" - data Page = Redirection { redirName :: !PageName @@ -94,7 +93,6 @@ data Page } deriving (Show, Eq) - data UpdateInfo = UpdateInfo { uiOldRevision :: !RevNum @@ -252,7 +250,7 @@ xmlizePage += sattr "redirect" (T.unpack $ 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 @@ -278,7 +276,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 @@ -378,14 +376,6 @@ parseEntity , entityContent = content , entityUpdateInfo = updateInfo } - where - dropWhitespace :: String -> String - dropWhitespace [] = [] - dropWhitespace (x:xs) - | x == ' ' || x == '\t' || x == '\n' - = dropWhitespace xs - | otherwise - = x : dropWhitespace xs parseUpdateInfo ∷ (ArrowXml (⇝), ArrowChoice (⇝)) ⇒ XmlTree ⇝ UpdateInfo parseUpdateInfo @@ -397,3 +387,7 @@ parseUpdateInfo uiOldRevision = oldRev , uiOldName = T.pack <$> oldName } + +dropWhitespace :: String -> String +{-# INLINE dropWhitespace #-} +dropWhitespace = filter ((¬) ∘ isSpace) diff --git a/Rakka/Resource/PageEntity.hs b/Rakka/Resource/PageEntity.hs index 1388f71..397f8d4 100644 --- a/Rakka/Resource/PageEntity.hs +++ b/Rakka/Resource/PageEntity.hs @@ -24,6 +24,7 @@ import Data.Maybe import Data.Monoid.Unicode import qualified Data.Text as T import Data.Time +import qualified Data.Time.W3C as W3C import Network.HTTP.Lucu import Network.URI hiding (path) import Prelude.Unicode @@ -33,7 +34,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) @@ -230,7 +230,6 @@ entityToRSS env += sattr "xmlns" "http://purl.org/rss/1.0/" += sattr "xmlns:rdf" "http://www.w3.org/1999/02/22-rdf-syntax-ns#" += sattr "xmlns:dc" "http://purl.org/dc/elements/1.1/" - += sattr "xmlns:trackback" "http://madskills.com/public/xml/rss/module/trackback/" += ( eelem "channel" += sattr "rdf:about" (uriToString id (mkFeedURI baseURI (T.pack name)) "") += ( eelem "title" @@ -278,14 +277,11 @@ entityToRSS env += ( eelem "dc:date" += ( arrIO (utcToLocalZonedTime . entityLastMod) ⋙ - arr formatW3CDateTime + arr W3C.format ⋙ mkText ) ) - += ( eelem "trackback:ping" - += attr "rdf:resource" (arr (mkTrackbackURIStr baseURI . entityName) ⋙ mkText) - ) ) ⋙ uniqueNamespacesFromDeclAndQNames @@ -295,10 +291,6 @@ entityToRSS env mkPageURIStr baseURI name = uriToString id (mkPageURI baseURI name) "" - mkTrackbackURIStr :: URI → PageName → String - mkTrackbackURIStr baseURI name - = uriToString id (mkAuxiliaryURI baseURI ["trackback"] name) "" - readSubPage ∷ (ArrowXml (⇝), ArrowChoice (⇝), ArrowIO (⇝)) ⇒ Environment → (PageName, Maybe XmlTree, PageName) ⇝ XmlTree diff --git a/Rakka/Resource/Search.hs b/Rakka/Resource/Search.hs index 56f99c0..2d076e8 100644 --- a/Rakka/Resource/Search.hs +++ b/Rakka/Resource/Search.hs @@ -17,12 +17,14 @@ import Control.Arrow.ArrowTree import Control.Arrow.Unicode import qualified Codec.Binary.UTF8.Generic as UTF8 import Control.Monad.Trans +import qualified Data.ByteString.Char8 as C8 import Data.Maybe import Data.Monoid.Unicode import Data.Text (Text) import qualified Data.Text as T import Data.Time import qualified Data.Time.RFC1123 as RFC1123 +import qualified Data.Time.W3C as W3C import Network.HTTP.Lucu import Network.URI hiding (query, fragment) import Prelude.Unicode @@ -32,7 +34,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) @@ -130,7 +131,7 @@ handleSearch env += attr "name" (arr (T.unpack ∘ hpPageName) ⋙ mkText) += attr "lastModified" ( arrIO (utcToLocalZonedTime ∘ hpLastMod) ⋙ - arr formatW3CDateTime + arr W3C.format ⋙ mkText ) @@ -290,7 +291,7 @@ searchResultToXHTML env += sattr "class" "date" += ( getAttrValue "lastModified" ⋙ - arr (zonedTimeToUTC . fromJust . parseW3CDateTime) + arr (zonedTimeToUTC . fromJust . W3C.parse) ⋙ arrIO utcToLocalZonedTime ⋙ @@ -375,15 +376,15 @@ searchResultToXHTML env = arr $ \ (query, (order, section)) -> baseURI { uriPath = uriPath baseURI "search.html" - , uriQuery = '?' : mkQueryString ( [ ("q" , query) - , ("from", show $ section * resultsPerSection) - , ("to" , show $ (section + 1) * resultsPerSection - 1) - ] - ++ - case order of - Just o -> [("order", o)] - Nothing -> [] - ) + , uriQuery = '?' : C8.unpack (mkQueryString ( [ ("q" , T.pack query) + , ("from", T.pack ∘ show $ section ⋅ resultsPerSection ) + , ("to" , T.pack ∘ show $ (section + 1) ⋅ resultsPerSection - 1) + ] + ++ + case order of + Just o -> [("order", T.pack o)] + Nothing -> [] + )) } uriToText :: ArrowXml a => a URI XmlTree diff --git a/Rakka/Resource/TrackBack.hs b/Rakka/Resource/TrackBack.hs deleted file mode 100644 index df1f5c3..0000000 --- a/Rakka/Resource/TrackBack.hs +++ /dev/null @@ -1,154 +0,0 @@ -module Rakka.Resource.TrackBack - ( resTrackBack - ) - where - -import qualified Codec.Binary.UTF8.String as UTF8 -import Control.Arrow -import Control.Arrow.ArrowList -import Control.Monad.Trans -import Data.List -import Data.Maybe -import Data.Time -import Network.Browser -import Network.HTTP -import Network.HTTP.Lucu -import Network.HTTP.Lucu.Response -import Network.URI -import Rakka.Environment -import Rakka.Page -import Rakka.Storage -import Rakka.SystemConfig -import Rakka.TrackBack -import Text.XML.HXT.Arrow.WriteDocument -import Text.XML.HXT.Arrow.XmlArrow -import Text.XML.HXT.Arrow.XmlIOStateArrow -import Text.XML.HXT.DOM.TypeDefs -import Text.XML.HXT.DOM.XmlKeywords - - -data TBResponse - = NoError - | Error !Int !String - deriving (Show, Eq) - - -resTrackBack :: Environment -> ResourceDef -resTrackBack env - = ResourceDef { - resUsesNativeThread = False - , resIsGreedy = True - , resGet = Nothing - , resHead = Nothing - , resPost = Just $ getPathInfo >>= handlePost env . toPageName - , resPut = Nothing - , resDelete = Nothing - } - where - toPageName :: [String] -> PageName - toPageName = UTF8.decodeString . joinPath - - -handlePost :: Environment -> PageName -> Resource () -handlePost env name - = do form <- inputForm defaultLimit - tbParamM <- validateTrackBack form - case tbParamM of - Nothing - -> return () - Just tbParam - -> do cited <- liftIO $ checkCitation tbParam name - if cited then - do pageM <- getPage (envStorage env) name Nothing - case pageM of - Nothing -> setStatus NotFound - Just page -> addTB tbParam page - else - outputResponse (Error 1 "Failed to confirm if your entry contains any citation to this page.") - where - addTB :: TrackBack -> Page -> Resource () - addTB tbParam page - | isRedirect page - = do BaseURI baseURI <- getSysConf (envSysConf env) - redirect TemporaryRedirect (mkPageURI baseURI $ redirName page) - | otherwise - = do tbListM <- return . fromMaybe [] =<< getAttachment (envStorage env) (pageName page) "trackbacks" Nothing - st <- putAttachment (envStorage env) Nothing Nothing (pageName page) "trackbacks" (tbParam : tbListM) - if isSuccessful st then - outputResponse NoError - else - setStatus st - - -validateTrackBack :: [(String, String)] -> Resource (Maybe TrackBack) -validateTrackBack form - = do let title = get' "title" - excerpt = get' "excerpt" - blogName = get' "blog_name" - case get' "url" of - Nothing - -> do outputResponse (Error 1 "Parameter `url' is missing.") - return Nothing - Just u - -> case parseURI u of - Nothing - -> do outputResponse (Error 1 "Parameter `url' is malformed.") - return Nothing - Just url - -> do time <- liftIO getCurrentTime - return $ Just TrackBack { - tbTitle = title - , tbExcerpt = excerpt - , tbURL = url - , tbBlogName = blogName - , tbTime = time - } - where - get' :: String -> Maybe String - get' = fmap UTF8.decodeString . flip lookup form - - -outputResponse :: TBResponse -> Resource () -outputResponse res - = do setContentType $ read "text/xml" - [xmlStr] <- liftIO $ runX ( setErrorMsgHandler False fail - >>> - mkResponseTree - >>> - writeDocumentToString [ (a_indent , v_1 ) - , (a_output_encoding, utf8) - , (a_no_xml_pi , v_0 ) ] - ) - output $ UTF8.encodeString xmlStr - where - mkResponseTree :: ArrowXml a => a b XmlTree - mkResponseTree - = proc _ - -> ( eelem "/" - += ( eelem "response" - += ( eelem "error" - += txt (case res of - NoError -> "0" - Error code _ -> show code) - ) - += ( case res of - NoError -> none - Error _ msg -> ( eelem "message" - += txt msg - ) - ) - ) - ) -< () - - -checkCitation :: TrackBack -> PageName -> IO Bool -checkCitation param name - = do (_, res) <- browse $ - do setAllowRedirects True - setErrHandler (\ _ -> return ()) - setOutHandler (\ _ -> return ()) - request $ defaultGETRequest $ tbURL param - case rspCode res of - (2, 0, 0) - -> return (encodePageName name `isInfixOf` rspBody res) - _ -> return False diff --git a/Rakka/Storage/Impl.hs b/Rakka/Storage/Impl.hs index 8b3cbeb..55bda71 100644 --- a/Rakka/Storage/Impl.hs +++ b/Rakka/Storage/Impl.hs @@ -25,6 +25,7 @@ import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T import Data.Time +import qualified Data.Time.W3C as W3C import Network.HTTP.Lucu import Network.HTTP.Lucu.Utils import Network.URI @@ -35,7 +36,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 @@ -221,7 +221,7 @@ searchIndex index cond read ∘ T.unpack ∘ fromJust <$> getDocAttr index docId "rakka:revision" lastMod ← unsafeInterleaveIO $ - zonedTimeToUTC ∘ fromJust ∘ parseW3CDateTime ∘ T.unpack ∘ fromJust + zonedTimeToUTC ∘ fromJust ∘ W3C.parse ∘ T.unpack ∘ 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 6a90ed6..05759d9 100644 --- a/Rakka/Storage/Repos.hs +++ b/Rakka/Storage/Repos.hs @@ -29,13 +29,13 @@ import Data.Set (Set) import qualified Data.Set as S hiding (Set) import qualified Data.Text as T import Data.Time +import qualified Data.Time.W3C as W3C import Network.HTTP.Lucu hiding (redirect) import Prelude.Unicode 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 @@ -172,7 +172,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 { @@ -206,7 +206,7 @@ loadPageInRepository repos name rev dest = T.pack ∘ 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 029d307..d15bc9d 100644 --- a/Rakka/SystemConfig.hs +++ b/Rakka/SystemConfig.hs @@ -230,9 +230,14 @@ instance SysConfValue BaseURI where defaultValue sc = let conf = scLucuConf sc host = C8.unpack $ LC.cnfServerHost conf - port = unsafePerformIO ∘ getServicePortNumber $ LC.cnfServerPort conf + 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/TrackBack.hs b/Rakka/TrackBack.hs deleted file mode 100644 index 8b1d2cb..0000000 --- a/Rakka/TrackBack.hs +++ /dev/null @@ -1,96 +0,0 @@ -module Rakka.TrackBack - ( TrackBack(..) - ) - where - -import Data.Maybe -import Data.Time -import Network.URI -import Rakka.Attachment -import Rakka.Utils -import Rakka.W3CDateTime -import Text.XML.HXT.Arrow -import Text.XML.HXT.DOM.TypeDefs - - -data TrackBack - = TrackBack { - tbTitle :: !(Maybe String) - , tbExcerpt :: !(Maybe String) - , tbURL :: !URI - , tbBlogName :: !(Maybe String) - , tbTime :: !UTCTime - } - deriving (Show, Eq) - - -{- - - - excerpt... - - ... - --} -instance Attachment [TrackBack] where - serializeToXmlTree - = proc trackbacks - -> ( eelem "/" - += ( eelem "trackbacks" - += ( arrL id - >>> - tbToTree - ) - ) - ) -< trackbacks - where - tbToTree :: ArrowXml a => a TrackBack XmlTree - tbToTree - = proc tb - -> let title = case tbTitle tb of - Nothing -> none - Just t -> sattr "title" t - excerpt = case tbExcerpt tb of - Nothing -> none - Just e -> txt e - url = sattr "url" (uriToString id (tbURL tb) "") - blogName = case tbBlogName tb of - Nothing -> none - Just n -> sattr "blogName" n - time = sattr "time" (formatW3CDateTime $ utcToZonedTime utc (tbTime tb)) - in - ( eelem "trackback" - += title - += url - += blogName - += time - += excerpt - ) -<< () - - deserializeFromXmlTree - = proc doc -> listA (getXPathTreesInDoc "/trackbacks/trackback" >>> treeToTb) -< doc - where - treeToTb :: (ArrowChoice a, ArrowXml a) => a XmlTree TrackBack - treeToTb - = proc tree - -> do title <- maybeA (getAttrValue0 "title") -< tree - url <- ( getAttrValue0 "url" - >>> - arr (fromJust . parseURI) - ) -< tree - time <- ( getAttrValue0 "time" - >>> - arr (zonedTimeToUTC . fromJust . parseW3CDateTime) - ) -< tree - blogName <- maybeA (getAttrValue0 "blogName") -< tree - excerpt <- maybeA ( getChildren - >>> - getText - ) -< tree - returnA -< TrackBack { - tbTitle = title - , tbExcerpt = excerpt - , tbURL = url - , tbBlogName = blogName - , tbTime = time - } diff --git a/Rakka/Utils.hs b/Rakka/Utils.hs index 3148c6b..717a606 100644 --- a/Rakka/Utils.hs +++ b/Rakka/Utils.hs @@ -16,18 +16,24 @@ module Rakka.Utils , mkQueryString ) where -import qualified Codec.Binary.UTF8.String as UTF8 -import Control.Arrow -import Control.Arrow.ArrowList -import qualified Data.ByteString.Lazy as Lazy (ByteString) -import qualified Data.ByteString.Lazy.Char8 as L8 hiding (ByteString) +import Control.Arrow +import Control.Arrow.ArrowList +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as C8 +import qualified Data.ByteString.Lazy as LS +import qualified Data.ByteString.Unsafe as BS +import Data.Char import Data.Monoid.Unicode import Data.String -import Magic -import Network.HTTP.Lucu -import Network.URI +import Data.Text (Text) +import Data.Text.Encoding +import Magic +import Network.HTTP.Lucu +import Network.URI +import Numeric import Prelude.Unicode -import System.IO.Unsafe +import System.IO.Unsafe yesOrNo ∷ Bool → String yesOrNo True = "yes" @@ -38,57 +44,90 @@ trueOrFalse True = "true" trueOrFalse False = "false" parseYesOrNo ∷ (Eq s, Show s, IsString s, ArrowChoice (⇝)) ⇒ s ⇝ Bool -parseYesOrNo - = proc str → - case str of - _ | str ≡ "yes" → returnA ⤙ True - | str ≡ "no" → returnA ⤙ False - | otherwise → returnA ⤙ error ("Expected yes or no: " ⊕ show str) +parseYesOrNo = arr f + where + f "yes" = True + f "no" = False + f str = error ("Expected yes or no: " ⊕ show str) -maybeA :: (ArrowList a, ArrowChoice a) => a b c -> a b (Maybe c) +maybeA ∷ (ArrowList a, ArrowChoice a) ⇒ a b c → a b (Maybe c) maybeA a = listA a >>> - proc xs -> case xs of - [] -> returnA -< Nothing - (x:_) -> returnA -< Just x - + proc xs → case xs of + [] → returnA ⤙ Nothing + (x:_) → returnA ⤙ Just x -deleteIfEmpty :: (ArrowList a, ArrowChoice a) => a String String +deleteIfEmpty ∷ (ArrowList a, ArrowChoice a) ⇒ a String String deleteIfEmpty - = proc str -> do case str of - "" -> none -< () - _ -> returnA -< str - + = proc str → do case str of + "" → none ⤙ () + _ → returnA ⤙ str -chomp :: String -> String -chomp = reverse . snd . break (/= '\n') . reverse +chomp ∷ String → String +{-# INLINE chomp #-} +chomp = reverse . snd . break (≢ '\n') . reverse - -guessMIMEType :: Lazy.ByteString -> MIMEType -guessMIMEType = read . unsafePerformIO . magicString magic . L8.unpack +guessMIMEType ∷ LS.ByteString → MIMEType +{-# INLINEABLE guessMIMEType #-} +guessMIMEType = read + ∘ unsafePerformIO + ∘ flip BS.unsafeUseAsCStringLen (magicCString magic) + ∘ BS.concat + ∘ LS.toChunks where - magic :: Magic + magic ∷ Magic + {-# NOINLINE magic #-} magic = unsafePerformIO - $ do m <- magicOpen [MagicMime] + $ do m ← magicOpen [MagicMime] magicLoadDefault m return m - -isSafeChar :: Char -> Bool +isSafeChar ∷ Char → Bool +{-# INLINEABLE isSafeChar #-} isSafeChar c - | c == '/' = True - | isReserved c = False - | c > ' ' && c <= '~' = True - | otherwise = False + | c ≡ '/' = True + | isReserved c = False + | c > ' ' ∧ c ≤ '~' = True + | otherwise = False +mkQueryString ∷ [(Text, Text)] → ByteString +{-# INLINEABLE mkQueryString #-} +mkQueryString = BS.intercalate (C8.singleton ';') ∘ map encodePair + where + encodePair ∷ (Text, Text) → ByteString + {-# INLINE encodePair #-} + encodePair (k, v) + = BS.intercalate (C8.singleton '=') [encodeText k, encodeText v] + + encodeText ∷ Text → ByteString + {-# INLINE encodeText #-} + encodeText = toURLEncoded ∘ encodeUtf8 -mkQueryString :: [(String, String)] -> String -mkQueryString [] = "" -mkQueryString ((k, v) : xs) = encode k ++ "=" ++ encode v ++ - if xs == [] then - "" - else - ';' : mkQueryString(xs) +toURLEncoded ∷ ByteString → ByteString +{-# INLINEABLE toURLEncoded #-} +toURLEncoded = C8.concatMap go where - encode :: String -> String - encode = escapeURIString isSafeChar . UTF8.encodeString \ No newline at end of file + go ∷ Char → ByteString + {-# INLINE go #-} + go c | c ≡ ' ' = C8.singleton '+' + | isReserved c = urlEncode c + | isUnreserved c = C8.singleton c + | otherwise = urlEncode c + + urlEncode ∷ Char → ByteString + {-# INLINE urlEncode #-} + urlEncode c = C8.pack ('%':toHex (ord c)) + + toHex ∷ Int → String + {-# INLINE toHex #-} + toHex n + = case showIntAtBase 16 toChrHex n "" of + [] → "00" + [c] → ['0', c] + cs → cs + + toChrHex ∷ Int → Char + {-# INLINE toChrHex #-} + toChrHex d + | d < 10 = chr (ord '0' + fromIntegral d ) + | otherwise = chr (ord 'A' + fromIntegral (d-10)) diff --git a/Rakka/W3CDateTime.hs b/Rakka/W3CDateTime.hs deleted file mode 100644 index 4ec4738..0000000 --- a/Rakka/W3CDateTime.hs +++ /dev/null @@ -1,99 +0,0 @@ --- FIXME: use time-w3c -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/Interpreter/PageList.hs b/Rakka/Wiki/Interpreter/PageList.hs index d94f67e..4faee0f 100644 --- a/Rakka/Wiki/Interpreter/PageList.hs +++ b/Rakka/Wiki/Interpreter/PageList.hs @@ -9,6 +9,7 @@ module Rakka.Wiki.Interpreter.PageList where import Control.Applicative import Control.Monad +import qualified Data.ByteString.Char8 as C8 import Data.Maybe import Data.Monoid.Unicode import qualified Data.Text as T @@ -39,9 +40,9 @@ recentUpdatesURLInterp = \ ctx _ -> do BaseURI baseURI <- getSysConf (ctxSysConf ctx) let uri = baseURI { uriPath = uriPath baseURI "search.html" - , uriQuery = '?' : mkQueryString [ ("q" , "[UVSET]") - , ("order", "@mdate NUMD") - ] + , uriQuery = '?' : C8.unpack (mkQueryString [ ("q" , "[UVSET]") + , ("order", "@mdate NUMD") + ]) } return $ ExternalLink uri (Just "List all pages") } diff --git a/Rakka/Wiki/Interpreter/Trackback.hs b/Rakka/Wiki/Interpreter/Trackback.hs deleted file mode 100644 index b5e5cf0..0000000 --- a/Rakka/Wiki/Interpreter/Trackback.hs +++ /dev/null @@ -1,75 +0,0 @@ -module Rakka.Wiki.Interpreter.Trackback - ( interpreters - ) - where - -import Data.Maybe -import Data.Time -import Network.HTTP.Lucu.RFC1123DateTime -import Rakka.Page -import Rakka.Storage -import Rakka.SystemConfig -import Rakka.TrackBack -import Rakka.Wiki -import Rakka.Wiki.Interpreter - - -interpreters :: [Interpreter] -interpreters = [ trackbackURLInterp - , trackbacksInterp - ] - - -trackbackURLInterp :: Interpreter -trackbackURLInterp - = InlineCommandInterpreter { - iciName = "trackbackURL" - , iciInterpret - = \ ctx _ -> case ctxPageName ctx of - Nothing - -> return (Text "No trackbacks for this page.") - Just name - -> do BaseURI baseURI <- getSysConf (ctxSysConf ctx) - let uri = mkAuxiliaryURI baseURI ["trackback"] name - return $ ExternalLink uri (Just "Trackback URL") - } - - -trackbacksInterp :: Interpreter -trackbacksInterp - = BlockCommandInterpreter { - bciName = "trackbacks" - , bciInterpret - = \ ctx _ -> - do trackbacks <- case ctxPageName ctx of - Nothing - -> return [] - Just name - -> liftM (fromMaybe []) - (getAttachment (ctxStorage ctx) name "trackbacks" Nothing) - items <- mapM mkListItem trackbacks - - let divElem = Div [("class", "trackbacks")] [list] - list = Block (List Bullet items) - - return divElem - } - where - mkListItem :: TrackBack -> IO ListItem - mkListItem tb - = do zonedTime <- utcToLocalZonedTime (tbTime tb) - - let anchor = Just (Inline (ExternalLink (tbURL tb) label)) - label = case (tbTitle tb, tbBlogName tb) of - (Nothing , Nothing ) -> Nothing - (Just title, Nothing ) -> Just title - (Nothing , Just blogName) -> Just blogName - (Just title, Just blogName) -> Just (title ++ " (" ++ blogName ++ ")") - date = Just ( Block ( Div [("class", "date")] - [Inline (Text (formatRFC1123DateTime zonedTime))] - ) - ) - excerpt = do e <- tbExcerpt tb - return $ Block $ Paragraph [Text e] - - return $ catMaybes [anchor, date, excerpt] \ No newline at end of file diff --git a/Rakka/Wiki/Parser.hs b/Rakka/Wiki/Parser.hs index 3b3d7c4..e7ca8eb 100644 --- a/Rakka/Wiki/Parser.hs +++ b/Rakka/Wiki/Parser.hs @@ -211,15 +211,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' diff --git a/bugs/issue-0b925fc6286aa2d52ebd379b4c4283b14dfec865.yaml b/bugs/issue-0b925fc6286aa2d52ebd379b4c4283b14dfec865.yaml new file mode 100644 index 0000000..f7d68f0 --- /dev/null +++ b/bugs/issue-0b925fc6286aa2d52ebd379b4c4283b14dfec865.yaml @@ -0,0 +1,21 @@ +--- !ditz.rubyforge.org,2008-03-06/issue +title: Allow guests to leave their comments on pages. +desc: |- + Such data should be stored as page attachments. + There should be a global flag to disallow comments. +type: :feature +component: Rakka +release: +reporter: PHO +status: :unstarted +disposition: +creation_time: 2010-03-02 13:03:04.294484 Z +references: [] + +id: 0b925fc6286aa2d52ebd379b4c4283b14dfec865 +log_events: +- - 2010-03-02 13:03:05.766604 Z + - PHO + - created + - "" +git_branch: diff --git a/bugs/issue-1c6bfe78f0f9ebd241b8650eb62939dc932cd6f0.yaml b/bugs/issue-1c6bfe78f0f9ebd241b8650eb62939dc932cd6f0.yaml new file mode 100644 index 0000000..7a78767 --- /dev/null +++ b/bugs/issue-1c6bfe78f0f9ebd241b8650eb62939dc932cd6f0.yaml @@ -0,0 +1,23 @@ +--- !ditz.rubyforge.org,2008-03-06/issue +title: Rakka is rather bitrotted +desc: We have to repair it ASAP. +type: :task +component: Rakka +release: "0.1" +reporter: PHO +status: :in_progress +disposition: +creation_time: 2011-07-29 14:12:39.862597 Z +references: [] + +id: 1c6bfe78f0f9ebd241b8650eb62939dc932cd6f0 +log_events: +- - 2011-07-29 14:12:40.853438 Z + - PHO + - created + - "" +- - 2011-07-29 14:13:16.762514 Z + - PHO + - changed status from unstarted to in_progress + - I'm working on this... +git_branch: diff --git a/bugs/issue-227c3bdad879b5f85aae08563b932f99b3f95cec.yaml b/bugs/issue-227c3bdad879b5f85aae08563b932f99b3f95cec.yaml new file mode 100644 index 0000000..573c7f5 --- /dev/null +++ b/bugs/issue-227c3bdad879b5f85aae08563b932f99b3f95cec.yaml @@ -0,0 +1,24 @@ +--- !ditz.rubyforge.org,2008-03-06/issue +title: Wouldn't it be cool if Rakka was totally pure-Haskell? +desc: |- + We currently use the following impure packages: + - HsHyperEstraier + - HsSVN + - HsOpenSSL + - magic +type: :task +component: Rakka +release: +reporter: PHO +status: :unstarted +disposition: +creation_time: 2010-03-02 13:28:59.008922 Z +references: [] + +id: 227c3bdad879b5f85aae08563b932f99b3f95cec +log_events: +- - 2010-03-02 13:29:00.177175 Z + - PHO + - created + - "" +git_branch: diff --git a/bugs/issue-44d0ce5b9aaba1b8249f4974dba3fc249d416322.yaml b/bugs/issue-44d0ce5b9aaba1b8249f4974dba3fc249d416322.yaml new file mode 100644 index 0000000..326d961 --- /dev/null +++ b/bugs/issue-44d0ce5b9aaba1b8249f4974dba3fc249d416322.yaml @@ -0,0 +1,19 @@ +--- !ditz.rubyforge.org,2008-03-06/issue +title: Make sure that dumpRepos isn't leaking space. +desc: See the title. +type: :task +component: Rakka +release: "0.1" +reporter: PHO +status: :unstarted +disposition: +creation_time: 2010-05-05 15:51:20.513633 Z +references: [] + +id: 44d0ce5b9aaba1b8249f4974dba3fc249d416322 +log_events: +- - 2010-05-05 15:51:23.889811 Z + - PHO + - created + - "" +git_branch: diff --git a/bugs/issue-5587f7535b16ea0a4765f3b953bd07ab318966af.yaml b/bugs/issue-5587f7535b16ea0a4765f3b953bd07ab318966af.yaml new file mode 100644 index 0000000..bbc8bcf --- /dev/null +++ b/bugs/issue-5587f7535b16ea0a4765f3b953bd07ab318966af.yaml @@ -0,0 +1,19 @@ +--- !ditz.rubyforge.org,2008-03-06/issue +title: View Page History +desc: Show a list of patches for one page. +type: :feature +component: Rakka +release: +reporter: PHO +status: :unstarted +disposition: +creation_time: 2010-03-02 13:43:37.174053 Z +references: [] + +id: 5587f7535b16ea0a4765f3b953bd07ab318966af +log_events: +- - 2010-03-02 13:43:40.998400 Z + - PHO + - created + - "" +git_branch: diff --git a/bugs/issue-5731bf94f62b6eaf8af7e1dff0da117a5ca2a0d7.yaml b/bugs/issue-5731bf94f62b6eaf8af7e1dff0da117a5ca2a0d7.yaml new file mode 100644 index 0000000..7a79396 --- /dev/null +++ b/bugs/issue-5731bf94f62b6eaf8af7e1dff0da117a5ca2a0d7.yaml @@ -0,0 +1,21 @@ +--- !ditz.rubyforge.org,2008-03-06/issue +title: Make browsers' Back and Forward buttons usable +desc: |- + We should find a way to make browsers' Back and Forward buttons usable. + URI fragments may help us, but how about internal state changes, like modified textarea? +type: :task +component: Rakka +release: +reporter: PHO +status: :unstarted +disposition: +creation_time: 2010-03-02 12:57:47.325591 Z +references: [] + +id: 5731bf94f62b6eaf8af7e1dff0da117a5ca2a0d7 +log_events: +- - 2010-03-02 12:57:48.765873 Z + - PHO + - created + - "" +git_branch: diff --git a/bugs/issue-6e437d5ba59c9e6e45a171d38a8a3e00dde0daac.yaml b/bugs/issue-6e437d5ba59c9e6e45a171d38a8a3e00dde0daac.yaml new file mode 100644 index 0000000..5196810 --- /dev/null +++ b/bugs/issue-6e437d5ba59c9e6e45a171d38a8a3e00dde0daac.yaml @@ -0,0 +1,21 @@ +--- !ditz.rubyforge.org,2008-03-06/issue +title: Write logs into localstatedir +desc: |- + The logger should send logs into localstatedir. + File rotation should be up to users. +type: :feature +component: Rakka +release: "0.1" +reporter: PHO +status: :unstarted +disposition: +creation_time: 2010-03-02 12:48:35.732250 Z +references: [] + +id: 6e437d5ba59c9e6e45a171d38a8a3e00dde0daac +log_events: +- - 2010-03-02 12:48:36.530186 Z + - PHO + - created + - "" +git_branch: diff --git a/bugs/issue-73be8ef0e6371216aad7134f681140b285daa6d1.yaml b/bugs/issue-73be8ef0e6371216aad7134f681140b285daa6d1.yaml new file mode 100644 index 0000000..65f392c --- /dev/null +++ b/bugs/issue-73be8ef0e6371216aad7134f681140b285daa6d1.yaml @@ -0,0 +1,19 @@ +--- !ditz.rubyforge.org,2008-03-06/issue +title: Use W3C File API for file uploading +desc: "See: http://www.w3.org/TR/FileAPI/" +type: :task +component: Rakka +release: "0.1" +reporter: PHO +status: :unstarted +disposition: +creation_time: 2011-07-28 13:19:57.240486 Z +references: [] + +id: 73be8ef0e6371216aad7134f681140b285daa6d1 +log_events: +- - 2011-07-28 13:19:58.041198 Z + - PHO + - created + - "" +git_branch: diff --git a/bugs/issue-7a12321e30fd891c30011330b31f825d7d4549f2.yaml b/bugs/issue-7a12321e30fd891c30011330b31f825d7d4549f2.yaml new file mode 100644 index 0000000..6b00233 --- /dev/null +++ b/bugs/issue-7a12321e30fd891c30011330b31f825d7d4549f2.yaml @@ -0,0 +1,19 @@ +--- !ditz.rubyforge.org,2008-03-06/issue +title: Daemonize by calling forkProcess +desc: forkProcess should work well on recent GHC. Let's make use of it. +type: :task +component: Rakka +release: +reporter: PHO +status: :unstarted +disposition: +creation_time: 2011-07-28 10:25:05.111304 Z +references: [] + +id: 7a12321e30fd891c30011330b31f825d7d4549f2 +log_events: +- - 2011-07-28 10:25:06.730757 Z + - PHO + - created + - "" +git_branch: diff --git a/bugs/issue-7bb656d7ef68651e449d8c66a4fdadd184256039.yaml b/bugs/issue-7bb656d7ef68651e449d8c66a4fdadd184256039.yaml new file mode 100644 index 0000000..b48959e --- /dev/null +++ b/bugs/issue-7bb656d7ef68651e449d8c66a4fdadd184256039.yaml @@ -0,0 +1,19 @@ +--- !ditz.rubyforge.org,2008-03-06/issue +title: View Source +desc: Page sources should be available for anyone, to help creating their own pages. +type: :feature +component: Rakka +release: +reporter: PHO +status: :unstarted +disposition: +creation_time: 2010-03-02 13:41:52.366561 Z +references: [] + +id: 7bb656d7ef68651e449d8c66a4fdadd184256039 +log_events: +- - 2010-03-02 13:41:53.822772 Z + - PHO + - created + - "" +git_branch: diff --git a/bugs/issue-9545180523678d2ab2e32f83ec05abafc291a2a9.yaml b/bugs/issue-9545180523678d2ab2e32f83ec05abafc291a2a9.yaml new file mode 100644 index 0000000..a837c3d --- /dev/null +++ b/bugs/issue-9545180523678d2ab2e32f83ec05abafc291a2a9.yaml @@ -0,0 +1,19 @@ +--- !ditz.rubyforge.org,2008-03-06/issue +title: Cabalize the test suite +desc: Cabal now supports integrated unit testing. Make use of it. +type: :task +component: Rakka +release: +reporter: PHO +status: :unstarted +disposition: +creation_time: 2011-07-28 13:23:38.025610 Z +references: [] + +id: 9545180523678d2ab2e32f83ec05abafc291a2a9 +log_events: +- - 2011-07-28 13:23:39.385643 Z + - PHO + - created + - "" +git_branch: diff --git a/bugs/issue-a4c1df68e9bc332385b9c9e425738e59a029fb69.yaml b/bugs/issue-a4c1df68e9bc332385b9c9e425738e59a029fb69.yaml new file mode 100644 index 0000000..8a23b9c --- /dev/null +++ b/bugs/issue-a4c1df68e9bc332385b9c9e425738e59a029fb69.yaml @@ -0,0 +1,19 @@ +--- !ditz.rubyforge.org,2008-03-06/issue +title: Implement account manipulation +desc: systemConfig has a missing feature to create or drop user accounts. +type: :feature +component: Rakka +release: "0.1" +reporter: PHO +status: :unstarted +disposition: +creation_time: 2010-03-02 12:45:47.445331 Z +references: [] + +id: a4c1df68e9bc332385b9c9e425738e59a029fb69 +log_events: +- - 2010-03-02 12:45:51.399236 Z + - PHO + - created + - "" +git_branch: diff --git a/bugs/issue-b48298a8f36cd22b796c114a3ebfb3cb21bb4c0e.yaml b/bugs/issue-b48298a8f36cd22b796c114a3ebfb3cb21bb4c0e.yaml new file mode 100644 index 0000000..1510fab --- /dev/null +++ b/bugs/issue-b48298a8f36cd22b796c114a3ebfb3cb21bb4c0e.yaml @@ -0,0 +1,21 @@ +--- !ditz.rubyforge.org,2008-03-06/issue +title: config/baseURI should not be in the SVN repository. +desc: |- + When it's in the repos, we can't easilly setup a new instance of Rakka. + It should be passed to the executable as a program argument. +type: :task +component: Rakka +release: "0.1" +reporter: PHO +status: :unstarted +disposition: +creation_time: 2011-07-28 10:29:09.012108 Z +references: [] + +id: b48298a8f36cd22b796c114a3ebfb3cb21bb4c0e +log_events: +- - 2011-07-28 10:29:11.998502 Z + - PHO + - created + - "" +git_branch: diff --git a/bugs/issue-d411223c56973e94b7c7754eaf81039a03bb0b4c.yaml b/bugs/issue-d411223c56973e94b7c7754eaf81039a03bb0b4c.yaml new file mode 100644 index 0000000..cae2c7f --- /dev/null +++ b/bugs/issue-d411223c56973e94b7c7754eaf81039a03bb0b4c.yaml @@ -0,0 +1,19 @@ +--- !ditz.rubyforge.org,2008-03-06/issue +title: Page templates +desc: There should be a way to load templates at the beginning of page creation. +type: :feature +component: Rakka +release: +reporter: PHO +status: :unstarted +disposition: +creation_time: 2010-03-02 13:13:26.600190 Z +references: [] + +id: d411223c56973e94b7c7754eaf81039a03bb0b4c +log_events: +- - 2010-03-02 13:13:31.370116 Z + - PHO + - created + - "" +git_branch: diff --git a/bugs/issue-d96e069d2394c7a1de663af67888efe61f938c89.yaml b/bugs/issue-d96e069d2394c7a1de663af67888efe61f938c89.yaml new file mode 100644 index 0000000..f545c82 --- /dev/null +++ b/bugs/issue-d96e069d2394c7a1de663af67888efe61f938c89.yaml @@ -0,0 +1,22 @@ +--- !ditz.rubyforge.org,2008-03-06/issue +title: "There should be a way to escape from data: scheme to http: scheme." +desc: |- + When we open an image page in Rakka, we can't easilly get out of html+data: to just an image. + We can't easily save it to the disk. + We can't easily scale it (especially when the image is large). +type: :task +component: Rakka +release: +reporter: PHO +status: :unstarted +disposition: +creation_time: 2010-03-02 13:25:59.810753 Z +references: [] + +id: d96e069d2394c7a1de663af67888efe61f938c89 +log_events: +- - 2010-03-02 13:26:01.442864 Z + - PHO + - created + - "" +git_branch: diff --git a/bugs/issue-fb986d0c30569e0026e9d14f887823a372d4f6c5.yaml b/bugs/issue-fb986d0c30569e0026e9d14f887823a372d4f6c5.yaml new file mode 100644 index 0000000..c6266e5 --- /dev/null +++ b/bugs/issue-fb986d0c30569e0026e9d14f887823a372d4f6c5.yaml @@ -0,0 +1,24 @@ +--- !ditz.rubyforge.org,2008-03-06/issue +title: IP address blacklisting +desc: There should be a way to disallow some people to make any changes. +type: :feature +component: Rakka +release: +reporter: PHO +status: :unstarted +disposition: +creation_time: 2010-03-02 13:06:23.750179 Z +references: [] + +id: fb986d0c30569e0026e9d14f887823a372d4f6c5 +log_events: +- - 2010-03-02 13:10:13.576295 Z + - PHO + - created + - |- + Shouldn't Lucu have a feature like this: + - Disallow POST, DELETE, PUT by 1.2.3.4/24 + - Disallow All by 10.11.12.13/30 + + Such banlist shall be configured dynamically by Lucu resources... +git_branch: diff --git a/bugs/project.yaml b/bugs/project.yaml new file mode 100644 index 0000000..deeeb23 --- /dev/null +++ b/bugs/project.yaml @@ -0,0 +1,16 @@ +--- !ditz.rubyforge.org,2008-03-06/project +name: Rakka +version: "0.5" +components: +- !ditz.rubyforge.org,2008-03-06/component + name: Rakka +releases: +- !ditz.rubyforge.org,2008-03-06/release + name: "0.1" + status: :unreleased + release_time: + log_events: + - - 2010-03-02 12:42:25.957028 Z + - PHO + - created + - This will be the first public release without complete documentations and features. diff --git a/cabal-package.mk b/cabal-package.mk index d8bbaad..2363b98 100644 --- a/cabal-package.mk +++ b/cabal-package.mk @@ -14,11 +14,14 @@ RM_RF ?= rm -rf SUDO ?= sudo AUTOCONF ?= autoconf HLINT ?= hlint +HPC ?= hpc +DITZ ?= ditz CONFIGURE_ARGS ?= --disable-optimization SETUP_FILE := $(wildcard Setup.*hs) CABAL_FILE := $(wildcard *.cabal) +PKG_NAME := $(CABAL_FILE:.cabal=) ifeq ($(shell ls configure.ac 2>/dev/null),configure.ac) AUTOCONF_AC_FILE := configure.ac @@ -40,6 +43,7 @@ all: build build: setup-config build-hook ./Setup build + $(RM_RF) *.tix build-hook: @@ -70,7 +74,7 @@ Setup: $(SETUP_FILE) $(GHC) --make Setup clean: clean-hook - $(RM_RF) dist Setup *.o *.hi .setup-config *.buildinfo + $(RM_RF) dist Setup *.o *.hi .setup-config *.buildinfo *.tix .hpc $(FIND) . -name '*~' -exec rm -f {} \; clean-hook: @@ -85,11 +89,42 @@ sdist: setup-config ./Setup sdist test: build + $(RM_RF) dist/test ./Setup test + if ls *.tix >/dev/null 2>&1; then \ + $(HPC) sum --output="merged.tix" --union --exclude=Main *.tix; \ + $(HPC) markup --destdir="dist/hpc" --fun-entry-count "merged.tix"; \ + fi + +ditz: + $(DITZ) html dist/ditz + +fixme: + @$(FIND) . \ + \( -name 'dist' -or -name '.git' -or -name '_darcs' \) -prune \ + -or \ + \( -name '*.c' -or -name '*.h' -or \ + -name '*.hs' -or -name '*.lhs' -or \ + -name '*.hsc' -or -name '*.cabal' \) \ + -exec egrep -i '(fixme|thinkme)' {} \+ \ + || echo 'No FIXME or THINKME found.' lint: - $(HLINT) . --report \ - --ignore="Use string literal" \ - --ignore="Use concatMap" - -.PHONY: build build-hook setup-config setup-config-hook run clean clean-hook install doc sdist test lint + $(HLINT) . --report + +push: doc ditz + if [ -d "_darcs" ]; then \ + darcs push; \ + elif [ -d ".git" ]; then \ + git push --all && git push --tags; \ + fi + if [ -d "dist/doc" ]; then \ + rsync -av --delete \ + dist/doc/html/$(PKG_NAME)/ \ + www@nem.cielonegro.org:static.cielonegro.org/htdocs/doc/$(PKG_NAME); \ + fi + rsync -av --delete \ + dist/ditz/ \ + www@nem.cielonegro.org:static.cielonegro.org/htdocs/ditz/$(PKG_NAME) + +.PHONY: build build-hook setup-config setup-config-hook run clean clean-hook install doc sdist test lint push diff --git a/defaultPages/StyleSheet/CieloNegro.xml b/defaultPages/StyleSheet/CieloNegro.xml index 6e41dda..ec8152f 100644 --- a/defaultPages/StyleSheet/CieloNegro.xml +++ b/defaultPages/StyleSheet/CieloNegro.xml @@ -422,8 +422,7 @@ input[type="button"][disabled]:active { text-indent: 0; } -.sideBar .recentUpdates p, -.sideBar .trackbacks p { +.sideBar .recentUpdates p { font-size: 90%; } diff --git a/defaultPages/StyleSheet/Default.xml b/defaultPages/StyleSheet/Default.xml index 499bf03..49c3e6e 100644 --- a/defaultPages/StyleSheet/Default.xml +++ b/defaultPages/StyleSheet/Default.xml @@ -392,8 +392,7 @@ input[type="button"][disabled]:active { text-indent: 0; } -.sideBar .recentUpdates p, -.sideBar .trackbacks p { +.sideBar .recentUpdates p { font-size: 90%; } @@ -422,7 +421,7 @@ input[type="button"][disabled]:active { -moz-border-radius: 10px; } -.sideBar .recentUpdates li, .sideBar .trackbacks li { +.sideBar .recentUpdates li { background-color: #e0e0e0; }