Exodus to GHC 6.8.1

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

diff --git a/Rakka/Wiki/Engine.hs b/Rakka/Wiki/Engine.hs
index a4b70d79b6c3b8b4ecca2a19b72c7072f6360a16..54d0ff77b8e83e19d9618df36a03260e5b404f62 100644 (file)
--- a/Rakka/Wiki/Engine.hs
+++ b/Rakka/Wiki/Engine.hs
@@ -8,15 +8,15 @@ module Rakka.Wiki.Engine
     where
 
 import qualified Codec.Binary.Base64 as B64
+import           Codec.Binary.UTF8.String
 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
+import           Data.Time
 import           Network.HTTP.Lucu
 import           Network.URI
 import           Rakka.Page
@@ -29,7 +29,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
 
@@ -66,58 +66,58 @@ type InterpTable = Map String Interpreter
     </binaryData>
   </page>
 -}
-xmlizePage :: (ArrowXml a, ArrowChoice a) => a Page XmlTree
+xmlizePage :: (ArrowXml a, ArrowChoice a, ArrowIO 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)
-                      )
-                )
-           )
-       ) -<< ()
+    -> do lastMod <- arrIO (utcToLocalZonedTime . pageLastMod) -< 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 lastMod)
+                 += ( 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" name
+                                          | (lang, name) <- M.toList (pageOtherLang page) ]
+                    )
+                 += ( if pageIsBinary page then
+                          ( eelem "binaryData"
+                            += txt (B64.encode $ L.unpack $ pageContent page)
+                          )
+                      else
+                          ( eelem "textData"
+                            += txt (decode $ L.unpack $ pageContent page)
+                          )
+                    )
+               )) -<< ()
 
 
 wikifyPage :: (ArrowXml a, ArrowChoice a) => InterpTable -> a XmlTree WikiPage
@@ -328,8 +328,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 +372,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