code relocation

[Rakka.git] / Rakka / Wiki / Engine.hs

diff --git a/Rakka/Wiki/Engine.hs b/Rakka/Wiki/Engine.hs
index a4b70d79b6c3b8b4ecca2a19b72c7072f6360a16..7c4487a3ed178e20518c821861258ba2bae59c19 100644 (file)
--- a/Rakka/Wiki/Engine.hs
+++ b/Rakka/Wiki/Engine.hs
@@ -7,13 +7,9 @@ module Rakka.Wiki.Engine
     )
     where
 
-import qualified Codec.Binary.Base64 as B64
 import           Control.Arrow
 import           Control.Arrow.ArrowIO
 import           Control.Arrow.ArrowList
-import qualified Data.ByteString.Lazy as L
-import           Data.Encoding
-import           Data.Encoding.UTF8
 import           Data.Map (Map)
 import qualified Data.Map as M
 import           Data.Maybe
@@ -29,7 +25,7 @@ import           Rakka.Wiki.Formatter
 import           Rakka.Wiki.Interpreter
 import           Text.HyperEstraier hiding (getText)
 import           Text.ParserCombinators.Parsec
-import           Text.XML.HXT.Arrow.XmlArrow
+import           Text.XML.HXT.Arrow.XmlArrow hiding (err)
 import           Text.XML.HXT.Arrow.XmlNodeSet
 import           Text.XML.HXT.DOM.TypeDefs
 
@@ -37,89 +33,6 @@ import           Text.XML.HXT.DOM.TypeDefs
 type InterpTable = Map String Interpreter
 
 
-{-
-  <page name="Foo/Bar"
-        type="text/x-rakka"
-        lang="ja"            -- 存在しない場合もある
-        fileName="bar.rakka" -- 存在しない場合もある
-        isTheme="no"         -- text/css の場合のみ存在
-        isFeed="no"          -- text/x-rakka の場合のみ存在
-        isLocked="no"
-        isBinary="no"
-        revision="112">      -- デフォルトでない場合のみ存在
-        lastModified="2000-01-01T00:00:00">
-
-    <summary>
-        blah blah...
-    </summary> -- 存在しない場合もある
-
-    <otherLang> -- 存在しない場合もある
-      <link lang="ja" page="Bar/Baz" />
-    </otherLang>
-
-    <!-- 何れか一方のみ -->
-    <textData>
-      blah blah...
-    </textData>
-    <binaryData>
-      SKJaHKS8JK/DH8KS43JDK2aKKaSFLLS...
-    </binaryData>
-  </page>
--}
-xmlizePage :: (ArrowXml a, ArrowChoice a) => a Page XmlTree
-xmlizePage 
-    = proc page
-    -> (eelem "/"
-        += ( eelem "page"
-             += sattr "name" (pageName page)
-             += sattr "type" (show $ pageType page)
-             += ( case pageLanguage page of
-                    Just x  -> sattr "lang" x
-                    Nothing -> none
-                )
-             += ( case pageFileName page of
-                    Just x  -> sattr "fileName" x
-                    Nothing -> none
-                )
-             += ( case pageType page of
-                    MIMEType "text" "css" _
-                        -> sattr "isTheme" (yesOrNo $ pageIsTheme page)
-                    MIMEType "text" "x-rakka" _
-                        -> sattr "isFeed"  (yesOrNo $ pageIsFeed page)
-                    _
-                        -> none
-                )
-             += sattr "isLocked" (yesOrNo $ pageIsLocked page)
-             += sattr "isBoring" (yesOrNo $ pageIsBoring page)
-             += sattr "isBinary" (yesOrNo $ pageIsBinary page)
-             += sattr "revision" (show $ pageRevision page)
-             += sattr "lastModified" (formatW3CDateTime $ pageLastMod page)
-             += ( case pageSummary page of
-                    Just s  -> eelem "summary" += txt s
-                    Nothing -> none
-                )
-             += ( if M.null (pageOtherLang page) then
-                      none
-                  else
-                      selem "otherLang"
-                                [ eelem "link"
-                                  += sattr "lang" lang
-                                  += sattr "page" page
-                                      | (lang, page) <- M.toList (pageOtherLang page) ]
-                )
-             += ( if pageIsBinary page then
-                      ( eelem "binaryData"
-                        += txt (B64.encode $ L.unpack $ pageContent page)
-                      )
-                  else
-                      ( eelem "textData"
-                        += txt (decodeLazy UTF8 $ pageContent page)
-                      )
-                )
-           )
-       ) -<< ()
-
-
 wikifyPage :: (ArrowXml a, ArrowChoice a) => InterpTable -> a XmlTree WikiPage
 wikifyPage interpTable
     = proc tree
@@ -328,8 +241,8 @@ makeDraft interpTable
            MIMEType "text" "x-rakka" _
                -- wikify して興味のある部分を addText する。
                -> do arrIO2 (flip setAttribute "rakka:isFeed") -< (doc, pIsFeed)
-                     wikiPage <- wikifyPage interpTable -< tree
-                     arrIO2 (mapM_ . addBlockText) -< (doc, wikiPage)
+                     wiki <- wikifyPage interpTable -< tree
+                     arrIO2 (mapM_ . addBlockText) -< (doc, wiki)
 
            MIMEType _ _ _
                -> returnA -< ()
@@ -372,7 +285,7 @@ makeDraft interpTable
                                                                case alt of
                                                                  Just text -> addHiddenText doc text
                                                                  Nothing   -> return ()
-      addInlineText doc (Anchor attrs inlines)            = mapM_ (addInlineText doc) inlines
+      addInlineText doc (Anchor _ inlines)                = mapM_ (addInlineText doc) inlines
       addInlineText _   (Input _)                         = return ()
       addInlineText _    EmptyInline                      = return ()
       addInlineText doc (InlineCmd icmd)                  = addInlineCmdText doc icmd