From 65c7f9f0643c7e8884e4a02567b77c169167c093 Mon Sep 17 00:00:00 2001 From: pho Date: Wed, 31 Oct 2007 11:30:07 +0900 Subject: [PATCH] Record before chucking Data.Generics. It's way too slow. darcs-hash:20071031023007-62b54-0068627704a20e0153d10ff0bfa7700e0787b370.gz --- Rakka/Wiki.hs | 2 +- Rakka/Wiki/Engine.hs | 19 +++++++++++-------- Rakka/Wiki/Formatter.hs | 4 +++- Rakka/Wiki/Interpreter/Image.hs | 4 ++-- defaultPages/Help/Syntax | 12 +++++------- defaultPages/MainPage | 7 ++----- js/editPage.js | 2 +- 7 files changed, 25 insertions(+), 25 deletions(-) diff --git a/Rakka/Wiki.hs b/Rakka/Wiki.hs index af50afb..c1b7c7d 100644 --- a/Rakka/Wiki.hs +++ b/Rakka/Wiki.hs @@ -74,7 +74,7 @@ data InlineElement | LineBreak ![Attribute] | Span ![Attribute] ![InlineElement] | Image { - imgSource :: !(PageName) + imgSource :: !(Either URI PageName) , imgAlt :: !(Maybe String) } | Anchor ![Attribute] ![InlineElement] diff --git a/Rakka/Wiki/Engine.hs b/Rakka/Wiki/Engine.hs index 1f24e37..1d05d50 100644 --- a/Rakka/Wiki/Engine.hs +++ b/Rakka/Wiki/Engine.hs @@ -126,9 +126,11 @@ wikifyPage interpTable = proc tree -> do pName <- getXPathTreesInDoc "/page/@name/text()" >>> getText -< tree pType <- getXPathTreesInDoc "/page/@type/text()" >>> getText >>> arr read -< tree - pIsBinary <- getXPathTreesInDoc "/page/@isBinary/text()" >>> getText -< tree pFileName <- maybeA (getXPathTreesInDoc "/page/fileName/text()" >>> getText) -< tree textData <- maybeA (getXPathTreesInDoc "/page/textData/text()" >>> getText) -< tree + base64Data <- maybeA (getXPathTreesInDoc "/page/binaryData/text()" >>> getText) -< tree + + let dataURI = fmap (binToURI pType) base64Data case pType of MIMEType "text" "x-rakka" _ @@ -137,13 +139,14 @@ wikifyPage interpTable Right xs -> returnA -< xs MIMEType "image" _ _ - -> returnA -< [ Paragraph [Image pName Nothing] ] - - _ -> if pIsBinary == "yes" then - returnA -< [ Paragraph [ ObjectLink { - objLinkPage = pName - , objLinkText = Just $ fromMaybe (defaultFileName pType pName) pFileName - } + -- + -> returnA -< [ Paragraph [Image (Left $ fromJust dataURI) Nothing] ] + + _ -> if isJust dataURI then + -- foo.zip + returnA -< [ Paragraph [ Anchor + [("href", show dataURI)] + [Text (fromMaybe (defaultFileName pType pName) pFileName)] ] ] else diff --git a/Rakka/Wiki/Formatter.hs b/Rakka/Wiki/Formatter.hs index 969c228..4b483db 100644 --- a/Rakka/Wiki/Formatter.hs +++ b/Rakka/Wiki/Formatter.hs @@ -241,7 +241,9 @@ formatPageLink formatImage :: (ArrowXml a) => a (URI, InlineElement) XmlTree formatImage = proc (baseURI, Image src alt) - -> let uri = mkObjectURI baseURI src + -> let uri = case src of + Left uri -> uri + Right name -> mkObjectURI baseURI name href = uriToString id uri "" in ( eelem "img" diff --git a/Rakka/Wiki/Interpreter/Image.hs b/Rakka/Wiki/Interpreter/Image.hs index 5482d8c..97ffc8e 100644 --- a/Rakka/Wiki/Interpreter/Image.hs +++ b/Rakka/Wiki/Interpreter/Image.hs @@ -41,7 +41,7 @@ imageInterp Just others -> error ("unknown \"float\" attribute: " ++ others) anchorAttrs = [hrefAttr, classAttr] - return (Anchor anchorAttrs [Image pageName alt]) + return (Anchor anchorAttrs [Image (Right pageName) alt]) } @@ -76,7 +76,7 @@ imgFrameInterp return (Div [classAttr] [ Block (Div [("class", "imageData")] [ Inline (Anchor [hrefAttr] - [ Image pageName Nothing ]) ]) + [ Image (Right pageName) Nothing ]) ]) , Block (Div [("class", "imageCaption")] [ Block x | x <- inside ]) ] diff --git a/defaultPages/Help/Syntax b/defaultPages/Help/Syntax index 5e54aed..ed2b90c 100644 --- a/defaultPages/Help/Syntax +++ b/defaultPages/Help/Syntax @@ -1,13 +1,11 @@ + isBoring="yes" + lang="en"> - - The description of syntax of Rakka - - -- John Doe + --> == Listing == @@ -99,7 +98,6 @@ blah blah blah blah...
example
- ]]>
diff --git a/defaultPages/MainPage b/defaultPages/MainPage index b6e177b..cdfb7d6 100644 --- a/defaultPages/MainPage +++ b/defaultPages/MainPage @@ -1,16 +1,13 @@ + isBoring="yes" + lang="en"> - - The main page to be shown as an index page. -