From: PHO <pho@cielonegro.org>
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=HEAD;hp=-c

merge branch origin/master
---

45bce2c29948649f74ada71f2fa851bdb812e96c
diff --combined Main.hs
index cf4cf88,8ea4e99..3df4d8b
--- a/Main.hs
+++ b/Main.hs
@@@ -1,14 -1,10 +1,14 @@@
 -{-# LANGUAGE CPP #-}
 +{-# LANGUAGE
 +    CPP
 +  , UnicodeSyntax
 +  #-}
  import           Control.Exception
  import           Control.Monad
  import           Data.List
  import           Data.Maybe
 -import           Network.Socket
 +import Network.Socket
  import           Network.HTTP.Lucu
- import           OpenSSL
++import OpenSSL
  import           Rakka.Environment
  import           Rakka.Resource.CheckAuth
  import           Rakka.Resource.DumpRepos
@@@ -19,11 -15,10 +19,10 @@@ import           Rakka.Resource.Objec
  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
@@@ -54,7 -49,7 +53,7 @@@ data CmdOp
      deriving (Eq, Show)
  
  
 -defaultPort :: ServiceName
 +defaultPort ∷ ServiceName
  defaultPort = "8080"
  
  defaultLocalStateDir :: FilePath
@@@ -146,7 -141,7 +145,7 @@@ main = withOpenSSL 
            withSystemLock (lsdir </> "lock") $
              withPidFile (lsdir </> "pid") $
                do setupLogger opts
 -                 env <- setupEnv lsdir portNum
 +                 env ← setupEnv lsdir portNum
  
                   rebuildIndexIfRequested env opts
  
@@@ -166,19 -161,21 +165,18 @@@ resTree en
                  , (["search.html" ], resSearch       env)
                  , (["search.xml"  ], resSearch       env)
                  , (["systemConfig"], resSystemConfig env)
--                -- , (["trackback"   ], resTrackBack    env)
  		, (["users"       ], resUsers        env)
                  ]
  
 -
 -getPortNum :: [CmdOpt] -> IO ServiceName
 +getPortNum ∷ [CmdOpt] → IO ServiceName
  getPortNum opts
 -    = do let xs = mapMaybe (\ x -> case x of
 -                                     OptPortNum n -> Just n
 -                                     _            -> Nothing) opts
 +    = do let xs = mapMaybe (\x → case x of
 +                                   OptPortNum n → Just n
 +                                   _            → Nothing) opts
           case xs of
 -           []     -> return defaultPort
 -           (x:[]) -> return x
 -           _      -> error "too many --port options."
 -
 +           []     → return defaultPort
 +           (x:[]) → return x
 +           _      → error "too many --port options."
  
  getUserID :: [CmdOpt] -> IO UserID
  getUserID opts
diff --combined Rakka.cabal
index 6345b45,cda8dc9..9eeac5a
--- a/Rakka.cabal
+++ b/Rakka.cabal
@@@ -9,10 -9,12 +9,12 @@@ Author:        PHO <pho at cielonegro d
  Maintainer:    PHO <pho at cielonegro dot org>
  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 +30,7 @@@
      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,32 +64,35 @@@ Flag build-test-suit
  
  Executable rakka
      Build-Depends:
+         HsHyperEstraier      == 0.4.*,
++        HsOpenSSL            == 0.10.*,
+         HsSVN                == 0.4.*,
+         Lucu                 == 0.7.*,
 -        ascii                == 0.0.*,
 -        base                 == 4.3.*,
++        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.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 -109,6 +112,6 @@@
          Rakka.Resource.Render
          Rakka.Resource.Search
          Rakka.Resource.SystemConfig
-         Rakka.Resource.TrackBack
          Rakka.Resource.Users
          Rakka.Storage
          Rakka.Storage.DefaultPage
@@@ -98,16 -116,13 +119,13 @@@
          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 -134,18 +137,18 @@@
  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 --combined Rakka/Environment.hs
index c526c89,9a6df3a..2de28b2
--- a/Rakka/Environment.hs
+++ b/Rakka/Environment.hs
@@@ -1,16 -1,14 +1,16 @@@
 +{-# LANGUAGE
 +    UnicodeSyntax
 +  #-}
  module Rakka.Environment
      ( Environment(..)
      , InterpTable
      , setupEnv
      )
      where
 -
 -import           Control.Arrow
 -import           Control.Arrow.ArrowList
 +import Control.Arrow.ArrowList
 +import Control.Arrow.Unicode
  import qualified Data.Map as M
 -import           Network.Socket
 +import Network.Socket
  import qualified Network.HTTP.Lucu.Config as LC
  import           Rakka.Authorization
  import           Rakka.Page
@@@ -21,14 -19,13 +21,13 @@@ import           Rakka.Wiki.Interprete
  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
  import           System.FilePath
  import           System.Log.Logger
  import           Text.HyperEstraier
 -
 +import Text.XML.HXT.Arrow.XmlState
  
  logger :: String
  logger = "Rakka.Environment"
@@@ -44,13 -41,15 +43,13 @@@ data Environment = Environment 
      , envAuthDB        :: !AuthDB
      }
  
 -
 -setupEnv :: FilePath -> ServiceName -> IO Environment
 -setupEnv lsdir portNum
 +setupEnv ∷ FilePath → ServiceName → IO Environment
 +setupEnv lsdir port
      = do let lucuConf    = LC.defaultConfig {
 -                             LC.cnfServerPort = portNum
 +                             LC.cnfServerPort = port
                             }
               reposPath   = lsdir </> "repos"
               interpTable = mkInterpTable
 -         
           reposExist  <- doesDirectoryExist reposPath
           repos       <- if reposExist then
                              do debugM logger ("Found a subversion repository on " ++ reposPath)
@@@ -61,6 -60,7 +60,6 @@@
           sysConf     <- mkSystemConfig lucuConf repos
           storage     <- mkStorage lsdir repos (makeDraft' interpTable)
           authDB      <- mkAuthDB lsdir
 -
           return Environment {
                        envLocalStateDir = lsdir
                      , envLucuConf      = lucuConf
@@@ -71,27 -71,28 +70,26 @@@
                      , envAuthDB        = authDB
                      }
      where
 -      makeDraft' :: InterpTable -> Page -> IO Document
 +      makeDraft' ∷ InterpTable → Page → IO Document
        makeDraft' interpTable page
 -          = do [doc] <- runX ( setErrorMsgHandler False fail
 -                               >>>
 -                               constA page
 -                               >>>
 -                               xmlizePage
 -                               >>>
 -                               makeDraft interpTable
 -                             )
 +          = do [doc] ← runX ( setErrorMsgHandler False fail
 +                              ⋙
 +                              constA page
 +                              ⋙
 +                              xmlizePage
 +                              ⋙
 +                              makeDraft interpTable
 +                            )
                 return doc
  
 -
 -mkInterpTable :: InterpTable
 +mkInterpTable ∷ InterpTable
  mkInterpTable = listToTable $
 -                foldl (++) [] [ Base.interpreters
 -                              , Image.interpreters
 -                              , PageList.interpreters
 -                              --, Trackback.interpreters
 -                              , Outline.interpreters
 -                              ]
 +                concat [ Base.interpreters
 +                       , Image.interpreters
 +                       , PageList.interpreters
-                        --, Trackback.interpreters
 +                       , Outline.interpreters
 +                       ]
      where
 -      listToTable :: [Interpreter] -> InterpTable
 +      listToTable ∷ [Interpreter] → InterpTable
        listToTable xs
 -          = M.fromList [ (commandName x, x) | x <- xs ]
 +          = M.fromList [ (commandName x, x) | x ← xs ]
diff --combined Rakka/Page.hs
index f845f7e,24f037b..b4c88fc
--- a/Rakka/Page.hs
+++ b/Rakka/Page.hs
@@@ -1,6 -1,6 +1,6 @@@
 --- -*- coding: utf-8 -*-
  {-# LANGUAGE
      Arrows
 +  , TypeOperators
    , UnicodeSyntax
    #-}
  module Rakka.Page
@@@ -32,42 -32,33 +32,41 @@@
      , parseXmlizedPage
      )
      where
 +import Control.Applicative
  import Control.Arrow
 -import qualified Data.Ascii as Ascii
 -import qualified Data.Text as T
 +import Control.Arrow.ArrowIO
 +import Control.Arrow.ArrowList
 +import Control.Arrow.Unicode
 +import qualified Codec.Binary.UTF8.String as UTF8
 +import qualified Data.ByteString.Char8 as B8
  import qualified Data.ByteString.Lazy as Lazy (ByteString)
  import qualified Data.ByteString.Lazy as L hiding (ByteString)
  import qualified Data.ByteString.Lazy.Char8 as L8 hiding (ByteString)
 -import Data.Char
 -import Data.Map (Map)
 +import Data.CaseInsensitive (CI)
 +import qualified Data.CaseInsensitive as CI
 +import           Data.Char
 +import           Data.Map (Map)
  import qualified Data.Map as M
 -import Data.Time
 +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 Rakka.Utils
 -import Subversion.Types
 -import System.FilePath.Posix
 +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
  import Text.XML.HXT.DOM.TypeDefs
  import Text.XML.HXT.XPath
 -import Text.XML.HXT.Arrow.XmlArrow
 -import Prelude.Unicode
 -
 -type PageName = T.Text
 -
 -type LanguageTag  = Ascii -- See RFC 3066: http://www.ietf.org/rfc/rfc3066.txt
 -type LanguageName = T.Text -- i.e. "日本語"
  
 +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 -85,7 +93,6 @@@
        }
      deriving (Show, Eq)
  
--
  data UpdateInfo
      = UpdateInfo {
          uiOldRevision :: !RevNum
@@@ -135,37 -126,37 +133,37 @@@ pageRevision 
  
  
  -- UTF-8 に encode してから 0x20 - 0x7E の範圍を除いて URI escape する。
 -encodePageName :: PageName -> FilePath
 -encodePageName = escapeURIString isSafeChar . UTF8.encodeString . fixPageName
 +encodePageName ∷ PageName → FilePath
 +encodePageName = escapeURIString isSafeChar ∘ UTF8.encodeString ∘ fixPageName ∘ T.unpack
      where
 -      fixPageName :: PageName -> PageName
 -      fixPageName = (\ (x:xs) -> toUpper x : xs) . map (\ c -> if c == ' ' then '_' else c)
 -
 -
 -decodePageName :: FilePath -> PageName
 -decodePageName = UTF8.decodeString . unEscapeString
 +      fixPageName ∷ String → String
 +      fixPageName = capitalizeHead ∘ map (\c → if c ≡ ' ' then '_' else c)
  
 +      capitalizeHead ∷ String → String
 +      capitalizeHead []     = (⊥)
 +      capitalizeHead (x:xs) = toUpper x : xs
  
 -encodeFragment :: String -> String
 -encodeFragment = escapeURIString isSafeChar . UTF8.encodeString
 +-- FIXME: use system-filepath
 +decodePageName ∷ FilePath → PageName
 +decodePageName = T.pack ∘ UTF8.decodeString ∘ unEscapeString
  
 +encodeFragment ∷ Text → String
 +encodeFragment = escapeURIString isSafeChar ∘ B8.unpack ∘ encodeUtf8
  
 -mkPageURI :: URI -> PageName -> URI
 +mkPageURI ∷ URI → PageName → URI
  mkPageURI baseURI name
      = baseURI {
          uriPath = uriPath baseURI </> encodePageName name <.> "html"
        }
  
 -
 -mkPageFragmentURI :: URI -> PageName -> String -> URI
 +mkPageFragmentURI ∷ URI → PageName → Text → URI
  mkPageFragmentURI baseURI name fragment
      = baseURI {
          uriPath     = uriPath baseURI </> encodePageName name <.> "html"
        , uriFragment = ('#' : encodeFragment fragment)
        }
  
 -
 -mkFragmentURI :: String -> URI
 +mkFragmentURI ∷ Text → URI
  mkFragmentURI fragment
      = nullURI {
          uriFragment = ('#' : encodeFragment fragment)
@@@ -248,11 -239,11 +246,11 @@@ xmlizePag
            -> do lastMod <- arrIO (utcToLocalZonedTime . redirLastMod) -< page
                  ( eelem "/"
                    += ( eelem "page"
 -                       += sattr "name"     (redirName page)
 -                       += sattr "redirect" (redirDest page)
 -                       += sattr "isLocked" (yesOrNo $ redirIsLocked page)
 -                       += sattr "revision" (show $ redirRevision page)
 +                       += sattr "name"     (T.unpack $ redirName page    )
 +                       += 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
@@@ -261,10 -252,10 +259,10 @@@
            -> do lastMod <- arrIO (utcToLocalZonedTime . entityLastMod) -< page
                  ( eelem "/"
                    += ( eelem "page"
 -                       += sattr "name" (pageName page)
 +                       += sattr "name" (T.unpack $ pageName page)
                         += sattr "type" (show $ entityType page)
                         += ( case entityLanguage page of
 -                              Just x  -> sattr "lang" x
 +                              Just x  -> sattr "lang" (T.unpack $ CI.foldedCase x)
                                Nothing -> none
                            )
                         += ( case entityType page of
@@@ -278,7 -269,7 +276,7 @@@
                         += 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
@@@ -288,9 -279,9 +286,9 @@@
                              else
                                  selem "otherLang"
                                            [ eelem "link"
 -                                            += sattr "lang" lang
 -                                            += sattr "page" name
 -                                                | (lang, name) <- M.toList (entityOtherLang page) ]
 +                                            += sattr "lang" (T.unpack $ CI.foldedCase lang)
 +                                            += sattr "page" (T.unpack name)
 +                                                | (lang, name) ← M.toList (entityOtherLang page) ]
                            )
                         += ( if entityIsBinary page then
                                  ( eelem "binaryData"
@@@ -303,23 -294,25 +301,23 @@@
                            )
                       )) -<< ()
  
 -
 -parseXmlizedPage :: (ArrowXml a, ArrowChoice a) => a (PageName, XmlTree) Page
 +parseXmlizedPage ∷ (ArrowXml (⇝), ArrowChoice (⇝)) ⇒ (PageName, XmlTree) ⇝ Page
  parseXmlizedPage 
      = proc (name, tree)
 -    -> do updateInfo <- maybeA parseUpdateInfo -< tree
 -          redirect   <- maybeA (getXPathTreesInDoc "/page/@redirect/text()" >>> getText) -< tree
 -          isLocked   <- (withDefault (getXPathTreesInDoc "/page/@isLocked/text()" >>> getText) "no"
 -                         >>> parseYesOrNo) -< tree
 -          case redirect of
 -            Nothing   -> parseEntity -< (name, tree)
 -            Just dest -> returnA     -< (Redirection {
 -                                           redirName       = name
 -                                         , redirDest       = dest
 -                                         , redirIsLocked   = isLocked
 -                                         , redirRevision   = undefined
 -                                         , redirLastMod    = undefined
 -                                         , redirUpdateInfo = updateInfo
 -                                         })
 -            
 +    → do updateInfo ← maybeA parseUpdateInfo ⤙ tree
 +         redirect   ← maybeA (getXPathTreesInDoc "/page/@redirect/text()" ⋙ getText) ⤙ tree
 +         isLocked   ← (withDefault (getXPathTreesInDoc "/page/@isLocked/text()" ⋙ getText) "no"
 +                       ⋙ parseYesOrNo) ⤙ tree
 +         case redirect of
 +           Nothing   → parseEntity ⤙ (name, tree)
 +           Just dest → returnA     ⤙ Redirection {
 +                                        redirName       = name
 +                                      , redirDest       = T.pack dest
 +                                      , redirIsLocked   = isLocked
 +                                      , redirRevision   = undefined
 +                                      , redirLastMod    = undefined
 +                                      , redirUpdateInfo = updateInfo
 +                                      }
  
  parseEntity :: (ArrowXml a, ArrowChoice a) => a (PageName, XmlTree) Page
  parseEntity
@@@ -356,17 -349,18 +354,17 @@@
                        (Nothing  , Just binary) -> (True , L8.pack $ decodeBase64 $ dropWhitespace binary)
                        _                        -> error "one of textData or binaryData is required"
                mimeType
 -                  =  if isBinary then
 -                         if null mimeTypeStr then
 -                             guessMIMEType content
 -                         else
 -                             read mimeTypeStr
 -                     else
 -                         read mimeTypeStr
 -
 -          returnA -< Entity {
 +                  = if isBinary then
 +                        if null mimeTypeStr then
 +                            guessMIMEType content
 +                        else
 +                            read mimeTypeStr
 +                    else
 +                        read mimeTypeStr
 +          returnA ⤙ Entity {
                          entityName       = name
                        , entityType       = mimeType
 -                      , entityLanguage   = lang
 +                      , entityLanguage   = CI.mk ∘ T.pack <$> lang
                        , entityIsTheme    = isTheme
                        , entityIsFeed     = isFeed
                        , entityIsLocked   = isLocked
@@@ -374,26 -368,22 +372,22 @@@
                        , entityRevision   = undefined
                        , entityLastMod    = undefined
                        , entitySummary    = summary
 -                      , entityOtherLang  = M.fromList otherLang
 +                      , entityOtherLang  = M.fromList ((CI.mk ∘ T.pack ⁂ T.pack) <$> otherLang)
                        , 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 
 +    = proc tree
 +    -> do uInfo   ← getXPathTreesInDoc "/page/updateInfo" ⤙ tree
 +          oldRev  ← (getAttrValue0 "oldRevision" ⋙ arr read) ⤙ uInfo
 +          oldName ← maybeA (getXPathTrees "/updateInfo/move/@from/text()" ⋙ getText) ⤙ uInfo
 +          returnA ⤙ UpdateInfo {
 +                       uiOldRevision = oldRev
 +                     , uiOldName     = T.pack <$> oldName
 +                     }
++
+ dropWhitespace :: String -> String
+ {-# INLINE dropWhitespace #-}
+ dropWhitespace = filter ((¬) ∘ isSpace)
 -
 -parseUpdateInfo :: (ArrowXml a, ArrowChoice a) => a XmlTree UpdateInfo
 -parseUpdateInfo 
 -    = proc tree
 -    -> do uInfo   <- getXPathTreesInDoc "/page/updateInfo" -< tree
 -          oldRev  <- (getAttrValue0 "oldRevision" >>> arr read) -< uInfo
 -          oldName <- maybeA (getXPathTrees "/updateInfo/move/@from/text()" >>> getText) -< uInfo
 -          returnA -< UpdateInfo {
 -                        uiOldRevision = oldRev
 -                      , uiOldName     = oldName
 -                      }
diff --combined Rakka/Resource/PageEntity.hs
index 1388f71,c805ae5..397f8d4
--- a/Rakka/Resource/PageEntity.hs
+++ b/Rakka/Resource/PageEntity.hs
@@@ -1,55 -1,34 +1,55 @@@
 +{-# LANGUAGE
 +    Arrows
 +  , OverloadedStrings
 +  , TypeOperators
 +  , UnicodeSyntax
 +  #-}
  module Rakka.Resource.PageEntity
      ( fallbackPageEntity
      )
      where
 +import Control.Applicative
 +import Control.Arrow
 +import Control.Arrow.ArrowIO
 +import Control.Arrow.ArrowIf
 +import Control.Arrow.ArrowList
 +import Control.Arrow.Unicode
 +import qualified Codec.Binary.UTF8.String as UTF8
  import           Control.Monad.Trans
  import qualified Data.ByteString.Lazy as L hiding (ByteString)
 +import qualified Data.CaseInsensitive as CI
  import           Data.Char
  import qualified Data.Map as M
  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
  import           Rakka.Environment
  import           Rakka.Page
  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)
 -import           Text.XML.HXT.XPath
 -
 -
 -fallbackPageEntity :: Environment -> [String] -> IO (Maybe ResourceDef)
 +import Text.XML.HXT.Arrow.Namespace
 +import Text.XML.HXT.Arrow.WriteDocument
 +import Text.XML.HXT.Arrow.XmlArrow
 +import Text.XML.HXT.Arrow.XmlState
 +import Text.XML.HXT.DOM.TypeDefs
 +import Text.XML.HXT.XPath
 +
 +fallbackPageEntity ∷ Environment → [String] → IO (Maybe ResourceDef)
  fallbackPageEntity env path
 -    | null name           = return Nothing
 -    | isLower $ head name = return Nothing -- 先頭の文字が小文字であってはならない
 +    | T.null name           = return Nothing
 +    | isLower $ T.head name = return Nothing -- 先頭の文字が小文字であってはならない
      | otherwise
 -        = return $ Just $ ResourceDef {
 +        = pure $ Just ResourceDef {
              resUsesNativeThread = False
            , resIsGreedy         = True
            , resGet              = Just $ handleGet    env name
@@@ -59,8 -38,9 +59,8 @@@
            , resDelete           = Just $ handleDelete env name
            }
      where
 -      name :: PageName
 -      name = (dropExtension . UTF8.decodeString . joinPath) path
 -
 +      name ∷ PageName
 +      name = T.pack ∘ dropExtension ∘ UTF8.decodeString $ joinPath path
  
  handleGet :: Environment -> PageName -> Resource ()
  handleGet env name
@@@ -79,36 -59,37 +79,36 @@@
                              else
                                  handleRedirect env -< page
  
 -
  {-
    HTTP/1.1 302 Found
    Location: http://example.org/Destination.html#Redirect:Source
  -}
 -handleRedirect :: (ArrowXml a, ArrowIO a) => Environment -> a Page (Resource ())
 +handleRedirect ∷ (ArrowXml (⇝), ArrowIO (⇝)) ⇒ Environment → Page ⇝ Resource ()
  handleRedirect env
      = proc redir
 -    -> returnA -< do mType <- getEntityType
 -                     case mType of
 -                       MIMEType "text" "xml" _
 -                           -> do setContentType mType
 -                                 [resultStr] <- liftIO $ runX ( setErrorMsgHandler False fail
 -                                                                >>>
 -                                                                constA redir
 -                                                                >>>
 -                                                                xmlizePage
 -                                                                >>>
 -                                                                writeDocumentToString [ (a_indent         , v_1 )
 -                                                                                      , (a_output_encoding, utf8)
 -                                                                                      , (a_no_xml_pi      , v_0 ) ]
 -                                                              )
 -                                 output resultStr
 -
 -                       _   -> do BaseURI baseURI <- getSysConf (envSysConf env)
 -                                 let uri = mkPageFragmentURI
 -                                           baseURI
 -                                           (redirDest redir)
 -                                           ("Redirect:" ++ redirName redir)
 -                                 redirect Found uri
 -
 +    → returnA ⤙ do mType ← getEntityType
 +                   case mType of
 +                     MIMEType "text" "xml" _
 +                         → do setContentType mType
 +                              [resultStr] ← liftIO $
 +                                            runX ( setErrorMsgHandler False fail
 +                                                   ⋙
 +                                                   constA redir
 +                                                   ⋙
 +                                                   xmlizePage
 +                                                   ⋙
 +                                                   writeDocumentToString
 +                                                   [ withIndent yes
 +                                                   , withXmlPi  yes
 +                                                   ]
 +                                                 )
 +                              output $ UTF8.encodeString resultStr
 +                     _   → do BaseURI baseURI ← getSysConf (envSysConf env)
 +                              let uri = mkPageFragmentURI
 +                                        baseURI
 +                                        (redirDest redir)
 +                                        ("Redirect:" ⊕ redirName redir)
 +                              redirect Found uri
  
  handleGetEntity :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a Page (Resource ())
  handleGetEntity env
@@@ -119,220 -100,222 +119,212 @@@
                                          ]
  
  
 -entityToXHTML :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a XmlTree XmlTree
 +entityToXHTML ∷ (ArrowXml (⇝), ArrowChoice (⇝), ArrowIO (⇝))
 +              ⇒ Environment
 +              → XmlTree ⇝ XmlTree
  entityToXHTML env
      = proc page
 -    -> do SiteName   siteName   <- getSysConfA (envSysConf env) -< ()
 -          BaseURI    baseURI    <- getSysConfA (envSysConf env) -< ()
 -          StyleSheet styleSheet <- getSysConfA (envSysConf env) -< ()
 -          GlobalLock isGLocked  <- getSysConfA (envSysConf env) -< ()
 -
 -          name     <- (getXPathTreesInDoc "/page/@name/text()" >>> getText) -< page
 -          isLocked <- (getXPathTreesInDoc "/page/@isLocked/text()" >>> getText >>> parseYesOrNo) -< page
 -
 -          let cssHref   = [uriToString id (mkObjectURI baseURI styleSheet) ""]
 -              scriptSrc = [uriToString id (baseURI { uriPath = uriPath baseURI </> "js" }) ""]
 -
 -          pageTitle    <- listA (readSubPage env) -< (name, Just page, "PageTitle")
 -          leftSideBar  <- listA (readSubPage env) -< (name, Just page, "SideBar/Left")
 -          rightSideBar <- listA (readSubPage env) -< (name, Just page, "SideBar/Right")
 -          pageBody     <- listA (makeMainXHTML (envStorage env) (envSysConf env) (envInterpTable env)) -< page
 -
 -          ( eelem "/"
 -            += ( eelem "html"
 -                 += sattr "xmlns" "http://www.w3.org/1999/xhtml"
 -                 += ( getXPathTreesInDoc "/page/@lang"
 -                      `guards`
 -                      qattr (mkQName "xml" "lang" "")
 -                                ( getXPathTreesInDoc "/page/@lang/text()" )
 -                    )
 -                 += ( eelem "head"
 -                      += ( eelem "title"
 -                           += txt siteName
 -                           += txt " - "
 -                           += getXPathTreesInDoc "/page/@name/text()"
 -                         )
 -                      += ( constL cssHref
 -                           >>>
 -                           eelem "link"
 -                           += sattr "rel"  "stylesheet"
 -                           += sattr "type" "text/css"
 -                           += attr "href" (arr id >>> mkText)
 -                         )
 -                      += mkFeedList env
 -                      += ( constL scriptSrc
 -                           >>>
 -                           eelem "script"
 -                           += sattr "type" "text/javascript"
 -                           += attr "src" (arr id >>> mkText)
 -                         )
 -                      += ( eelem "script"
 -                           += sattr "type" "text/javascript"
 -                           += txt ("Rakka.baseURI=\"" ++ uriToString id baseURI "" ++ "\";")
 -                           += txt ("Rakka.isLocked=" ++ trueOrFalse isLocked ++ ";")
 -                           += txt ("Rakka.isGlobalLocked=" ++ trueOrFalse isGLocked ++ ";")
 -                         )
 -                      += mkGlobalJSList env
 -                    )
 -                 += ( eelem "body"
 -                      += ( eelem "div"
 -                           += sattr "class" "header"
 -                         )
 -                      += ( eelem "div"
 -                           += sattr "class" "center"
 -                           += ( eelem "div"
 -                                += sattr "class" "title"
 -                                += constL pageTitle
 -                              )
 -                           += ( eelem "div"
 -                                += sattr "class" "body"
 -                                += constL pageBody
 -                              )
 -                         )
 -                      += ( eelem "div"
 -                           += sattr "class" "footer"
 -                         )
 -                      += ( eelem "div"
 -                           += sattr "class" "left sideBar"
 -                           += ( eelem "div"
 -                                += sattr "class" "content"
 -                                += constL leftSideBar
 -                              )
 -                         )
 -                      += ( eelem "div"
 -                           += sattr "class" "right sideBar"
 -                           += ( eelem "div"
 -                                += sattr "class" "content"
 -                                += constL rightSideBar
 -                              )
 -                         )
 -                    )
 -                 >>>
 -                 uniqueNamespacesFromDeclAndQNames
 -               ) ) -<< page
 -
 -
 -entityToRSS :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a XmlTree XmlTree
 +    → do SiteName   siteName   ← getSysConfA (envSysConf env) ⤙ ()
 +         BaseURI    baseURI    ← getSysConfA (envSysConf env) ⤙ ()
 +         StyleSheet styleSheet ← getSysConfA (envSysConf env) ⤙ ()
 +         GlobalLock isGLocked  ← getSysConfA (envSysConf env) ⤙ ()
 +
 +         name     ← (getXPathTreesInDoc "/page/@name/text()" ⋙ getText) ⤙ page
 +         isLocked ← (getXPathTreesInDoc "/page/@isLocked/text()" ⋙ getText ⋙ parseYesOrNo) ⤙ page
 +
 +         let cssHref   = [uriToString id (mkObjectURI baseURI styleSheet) ""]
 +             scriptSrc = [uriToString id (baseURI { uriPath = uriPath baseURI </> "js" }) ""]
 +
 +         pageTitle    ← listA (readSubPage env) ⤙ (T.pack name, Just page, "PageTitle")
 +         leftSideBar  ← listA (readSubPage env) ⤙ (T.pack name, Just page, "SideBar/Left")
 +         rightSideBar ← listA (readSubPage env) ⤙ (T.pack name, Just page, "SideBar/Right")
 +         pageBody     ← listA (makeMainXHTML (envStorage env) (envSysConf env) (envInterpTable env)) ⤙ page
 +
 +         ( eelem "/"
 +           += ( eelem "html"
 +                += sattr "xmlns" "http://www.w3.org/1999/xhtml"
 +                += ( getXPathTreesInDoc "/page/@lang"
 +                     `guards`
 +                     qattr (mkQName "xml" "lang" "")
 +                               ( getXPathTreesInDoc "/page/@lang/text()" )
 +                   )
 +                += ( eelem "head"
 +                     += ( eelem "title"
 +                          += txt (T.unpack siteName)
 +                          += txt " - "
 +                          += getXPathTreesInDoc "/page/@name/text()"
 +                        )
 +                     += ( constL cssHref
 +                          ⋙
 +                          eelem "link"
 +                          += sattr "rel"  "stylesheet"
 +                          += sattr "type" "text/css"
 +                          += attr "href" (arr id ⋙ mkText)
 +                        )
 +                     += mkFeedList env
 +                     += ( constL scriptSrc
 +                          ⋙
 +                          eelem "script"
 +                          += sattr "type" "text/javascript"
 +                          += attr "src" (arr id ⋙ mkText)
 +                        )
 +                     += ( eelem "script"
 +                          += sattr "type" "text/javascript"
 +                          += txt ("Rakka.baseURI=\""      ⊕ uriToString id baseURI "" ⊕ "\";")
 +                          += txt ("Rakka.isLocked="       ⊕ trueOrFalse isLocked      ⊕ ";"  )
 +                          += txt ("Rakka.isGlobalLocked=" ⊕ trueOrFalse isGLocked     ⊕ ";"  )
 +                        )
 +                     += mkGlobalJSList env
 +                   )
 +                += ( eelem "body"
 +                     += ( eelem "div"
 +                          += sattr "class" "header"
 +                        )
 +                     += ( eelem "div"
 +                          += sattr "class" "center"
 +                          += ( eelem "div"
 +                               += sattr "class" "title"
 +                               += constL pageTitle
 +                             )
 +                          += ( eelem "div"
 +                               += sattr "class" "body"
 +                               += constL pageBody
 +                             )
 +                        )
 +                     += ( eelem "div"
 +                          += sattr "class" "footer"
 +                        )
 +                     += ( eelem "div"
 +                          += sattr "class" "left sideBar"
 +                          += ( eelem "div"
 +                               += sattr "class" "content"
 +                               += constL leftSideBar
 +                             )
 +                        )
 +                     += ( eelem "div"
 +                          += sattr "class" "right sideBar"
 +                          += ( eelem "div"
 +                               += sattr "class" "content"
 +                               += constL rightSideBar
 +                             )
 +                        )
 +                   )
 +                ⋙
 +                uniqueNamespacesFromDeclAndQNames
 +              ) ) ⤛ page
 +
 +entityToRSS ∷ (ArrowXml (⇝), ArrowChoice (⇝), ArrowIO (⇝))
 +            ⇒ Environment
 +            → XmlTree ⇝ XmlTree
  entityToRSS env
      = proc page
 -    -> do SiteName   siteName   <- getSysConfA (envSysConf env) -< ()
 -          BaseURI    baseURI    <- getSysConfA (envSysConf env) -< ()
 +    → do SiteName siteName ← getSysConfA (envSysConf env) ⤙ ()
 +         BaseURI  baseURI  ← getSysConfA (envSysConf env) ⤙ ()
  
 -          name    <- (getXPathTreesInDoc "/page/@name/text()" >>> getText) -< page
 -          summary <- maybeA (getXPathTreesInDoc "/page/summary/text()" >>> getText) -< page
 -          pages   <- makePageLinkList (envStorage env) (envSysConf env) (envInterpTable env) -< page
 +         name    ← (getXPathTreesInDoc "/page/@name/text()" ⋙ getText) ⤙ page
 +         summary ← maybeA (getXPathTreesInDoc "/page/summary/text()" ⋙ getText) ⤙ page
 +         pages   ← makePageLinkList (envStorage env) (envSysConf env) (envInterpTable env) ⤙ page
            
 -          ( eelem "/"
 -            += ( eelem "rdf:RDF"
 -                 += 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 name) "")
 -                      += ( eelem "title"
 -                           += txt siteName
 -                           += txt " - "
 -                           += getXPathTreesInDoc "/page/@name/text()"
 -                         )
 -                      += ( eelem "link"
 -                           += txt (uriToString id baseURI "")
 -                         )
 -                      += ( eelem "description"
 -                           += txt (case summary of
 -                                     Nothing -> "RSS Feed for " ++ siteName
 -                                     Just s  -> s)
 -                         )
 -                      += ( eelem "items"
 -                           += ( eelem "rdf:Seq"
 -                                += ( constL pages
 -                                     >>>
 -                                     eelem "rdf:li"
 -                                     += attr "resource" (arr (mkPageURIStr baseURI) >>> mkText)
 -                                   )
 -                              )
 -                         )
 -                    )
 -                 += ( constL pages
 -                      >>>
 -                      arr (\ n -> (n, Nothing))
 -                      >>>
 -                      getPageA (envStorage env)
 -                      >>>
 -                      arr fromJust
 -                      >>>
 -                      eelem "item"
 -                      += attr "rdf:about" (arr (mkPageURIStr baseURI . entityName) >>> mkText)
 -                      += ( eelem "title"
 -                           += (arr entityName >>> mkText)
 -                         )
 -                      += ( eelem "link"
 -                           += (arr (mkPageURIStr baseURI . entityName) >>> mkText)
 -                         )
 -                      += ( arrL (\ p -> case entitySummary p of
 -                                          Nothing -> []
 -                                          Just s  -> [s])
 -                           >>>
 -                           eelem "description"
 -                           += mkText
 -                         )
 -                      += ( eelem "dc:date"
 -                           += ( arrIO (utcToLocalZonedTime . entityLastMod)
 -                                >>>
 -                                arr W3C.format
 -                                >>>
 -                                mkText
 -                              )
 -                         )
 -                      += ( eelem "trackback:ping"
 -                           += attr "rdf:resource" (arr (mkTrackbackURIStr baseURI . entityName) >>> mkText)
 -                         )
 -                    )
 -                 >>>
 -                 uniqueNamespacesFromDeclAndQNames
 -               ) ) -<< page
 +         ( eelem "/"
 +           += ( eelem "rdf:RDF"
 +                += 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"
 +                          += txt (T.unpack siteName)
 +                          += txt " - "
 +                          += getXPathTreesInDoc "/page/@name/text()"
 +                        )
 +                     += ( eelem "link"
 +                          += txt (uriToString id baseURI "")
 +                        )
 +                     += ( eelem "description"
 +                          += txt (case summary of
 +                                    Nothing → "RSS Feed for " ⊕ T.unpack siteName
 +                                    Just s  → s)
 +                        )
 +                     += ( eelem "items"
 +                          += ( eelem "rdf:Seq"
 +                               += ( constL pages
 +                                    ⋙
 +                                    eelem "rdf:li"
 +                                    += attr "resource" (arr (mkPageURIStr baseURI) ⋙ mkText) ) ) ) )
 +                += ( constL pages
 +                     ⋙
 +                     arr (\n → (n, Nothing))
 +                     ⋙
 +                     getPageA (envStorage env)
 +                     ⋙
 +                     arr fromJust
 +                     ⋙
 +                     eelem "item"
 +                     += attr "rdf:about" (arr (mkPageURIStr baseURI ∘ entityName) ⋙ mkText)
 +                     += ( eelem "title"
 +                          += (arr (T.unpack ∘ entityName) ⋙ mkText)
 +                        )
 +                     += ( eelem "link"
 +                          += (arr (mkPageURIStr baseURI ∘ entityName) ⋙ mkText)
 +                        )
 +                     += ( arrL (\p → case entitySummary p of
 +                                       Nothing → []
 +                                       Just s  → [s])
 +                          ⋙
 +                          eelem "description"
 +                          += mkText
 +                        )
 +                     += ( eelem "dc:date"
 +                          += ( arrIO (utcToLocalZonedTime . entityLastMod)
 +                               ⋙
-                                arr formatW3CDateTime
++                               arr W3C.format
 +                               ⋙
 +                               mkText
 +                             )
 +                        )
-                      += ( eelem "trackback:ping"
-                           += attr "rdf:resource" (arr (mkTrackbackURIStr baseURI . entityName) ⋙ mkText)
-                         )
 +                   )
 +                ⋙
 +                uniqueNamespacesFromDeclAndQNames
 +              ) ) ⤛ page
      where
 -      mkPageURIStr :: URI -> PageName -> String
 +      mkPageURIStr :: URI → PageName → String
        mkPageURIStr baseURI name
              = uriToString id (mkPageURI baseURI name) ""
  
-       mkTrackbackURIStr :: URI → PageName → String
 -      mkTrackbackURIStr :: URI -> PageName -> String
--      mkTrackbackURIStr baseURI name
--            = uriToString id (mkAuxiliaryURI baseURI ["trackback"] name) ""
 -
--
 -readSubPage :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
 -               Environment
 -            -> a (PageName, Maybe XmlTree, PageName) XmlTree
 +readSubPage ∷ (ArrowXml (⇝), ArrowChoice (⇝), ArrowIO (⇝))
 +            ⇒ Environment
 +            → (PageName, Maybe XmlTree, PageName) ⇝ XmlTree
  readSubPage env
 -    = proc (mainPageName, mainPage, subPageName) ->
 -      do langM        <- case mainPage of
 +    = proc (mainPageName, mainPage, subPageName) →
 +      do langM        ← case mainPage of
                             Nothing
 -                               -> returnA -< Nothing
 +                               → returnA ⤙ Nothing
                             Just p
 -                               -> maybeA (getXPathTreesInDoc "/page/@lang/text()" >>> getText) -< p
 -         subPage      <- getPageA (envStorage env) >>> arr fromJust -< (subPageName, Nothing)
 -         localSubPage <- case langM of
 +                               → maybeA (getXPathTreesInDoc "/page/@lang/text()" ⋙ getText) ⤙ p
 +         subPage      ← getPageA (envStorage env) ⋙ arr fromJust ⤙ (subPageName, Nothing)
 +         localSubPage ← case langM of
                             Nothing
 -                               -> returnA -< subPage
 +                               → returnA ⤙ subPage
                             Just l
 -                               -> localize (envStorage env) -< (l, subPage)
 -         subPageXml   <- xmlizePage -< localSubPage
 -         subXHTML     <- makeSubXHTML (envStorage env) (envSysConf env) (envInterpTable env)
 -                         -< (Just mainPageName, mainPage, subPageXml)
 -         returnA -< subXHTML
 +                               → localize (envStorage env) ⤙ (CI.mk $ T.pack l, subPage)
 +         subPageXml   ← xmlizePage ⤙ localSubPage
 +         subXHTML     ← makeSubXHTML (envStorage env) (envSysConf env) (envInterpTable env)
 +                         ⤙ (Just mainPageName, mainPage, subPageXml)
 +         returnA ⤙ subXHTML
      where
 -      localize :: (ArrowChoice a, ArrowIO a) => Storage -> a (LanguageTag, Page) Page
 +      localize ∷ (ArrowChoice (⇝), ArrowIO (⇝)) ⇒ Storage → (LanguageTag, Page) ⇝ Page
        localize sto
            = proc (lang, origPage)
 -          -> do let otherLang = entityOtherLang origPage
 -                    localName = M.lookup lang otherLang
 -                case localName of
 -                  Nothing
 -                      -> returnA -< origPage
 -                  Just ln
 -                      -> do localPage <- getPageA sto -< (ln, Nothing)
 -                            returnA -< case localPage of
 -                                         Nothing -> origPage
 -                                         Just p  -> p
 +          → do let otherLang = entityOtherLang origPage
 +                   localName = M.lookup lang otherLang
 +               case localName of
 +                 Nothing
 +                     → returnA ⤙ origPage
 +                 Just ln
 +                     → do localPage ← getPageA sto ⤙ (ln, Nothing)
 +                          returnA ⤙ case localPage of
 +                                       Nothing → origPage
 +                                       Just p  → p
  
  
  {-
@@@ -341,247 -324,251 +333,247 @@@
      <page name="Foo/Baz" />
    </pageListing>
  -}
 -handleGetPageListing :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a (PageName, [PageName]) (Resource ())
 +handleGetPageListing ∷ (ArrowXml (⇝), ArrowChoice (⇝), ArrowIO (⇝))
 +                     ⇒ Environment
 +                     → (PageName, [PageName]) ⇝ Resource ()
  handleGetPageListing env
      = proc (dir, items)
 -    -> do tree <- ( eelem "/"
 -                    += ( eelem "pageListing"
 -                         += attr "path" (arr fst >>> mkText)
 -                         += ( arrL snd
 -                              >>> 
 -                              ( eelem "page"
 -                                += attr "name" (arr id >>> mkText)
 -                              )
 +    → do tree ← ( eelem "/"
 +                  += ( eelem "pageListing"
 +                       += attr "path" (arr (T.unpack ∘ fst) ⋙ mkText)
 +                       += ( arrL snd
 +                            ⋙ 
 +                            ( eelem "page"
 +                              += attr "name" (arr (T.unpack ∘ id) ⋙ mkText)
                              )
 -                       )
 -                  ) -< (dir, items)
 -          returnA -< outputXmlPage' tree (pageListingToXHTML env) -- FIXME: rss 對應
 -
 -
 -pageListingToXHTML :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a XmlTree XmlTree
 +                          )
 +                     )
 +                ) ⤙ (dir, items)
 +         returnA ⤙ outputXmlPage' tree (pageListingToXHTML env) -- FIXME: rss 對應
 +
 +pageListingToXHTML ∷ (ArrowXml (⇝), ArrowChoice (⇝), ArrowIO (⇝))
 +                   ⇒ Environment
 +                   → XmlTree ⇝ XmlTree
  pageListingToXHTML env
      = proc pageListing
 -    -> do SiteName   siteName   <- getSysConfA (envSysConf env) -< ()
 -          BaseURI    baseURI    <- getSysConfA (envSysConf env) -< ()
 -          StyleSheet styleSheet <- getSysConfA (envSysConf env) -< ()
 -          GlobalLock isGLocked  <- getSysConfA (envSysConf env) -< ()
 -
 -          name <- (getXPathTreesInDoc "/pageListing/@path/text()" >>> getText) -< pageListing
 -
 -          let cssHref   = [uriToString id (mkObjectURI baseURI styleSheet) ""]
 -              scriptSrc = [uriToString id (baseURI { uriPath = uriPath baseURI </> "js" }) ""]
 -
 -          pageTitle    <- listA (readSubPage env) -< (name, Nothing, "PageTitle")
 -          leftSideBar  <- listA (readSubPage env) -< (name, Nothing, "SideBar/Left")
 -          rightSideBar <- listA (readSubPage env) -< (name, Nothing, "SideBar/Right")
 -
 -          ( eelem "/"
 -            += ( eelem "html"
 -                 += sattr "xmlns" "http://www.w3.org/1999/xhtml"
 -                 += ( eelem "head"
 -                      += ( eelem "title"
 -                           += txt siteName
 -                           += txt " - "
 -                           += getXPathTreesInDoc "/pageListing/@path/text()"
 -                         )
 -                      += ( constL cssHref
 -                           >>>
 -                           eelem "link"
 -                           += sattr "rel"  "stylesheet"
 -                           += sattr "type" "text/css"
 -                           += attr "href" (arr id >>> mkText)
 -                         )
 -                      += mkFeedList env
 -                      += ( constL scriptSrc
 -                           >>>
 -                           eelem "script"
 -                           += sattr "type" "text/javascript"
 -                           += attr "src" (arr id >>> mkText)
 -                         )
 -                      += ( eelem "script"
 -                           += sattr "type" "text/javascript"
 -                           += txt ("Rakka.baseURI = \"" ++ uriToString id baseURI "" ++ "\";")
 -                           += txt ("Rakka.isGlobalLocked=" ++ trueOrFalse isGLocked ++ ";")
 -                         )
 -                      += mkGlobalJSList env
 -                    )
 -                 += ( eelem "body"
 -                      += ( eelem "div"
 -                           += sattr "class" "header"
 -                         )
 -                      += ( eelem "div"
 -                           += sattr "class" "center"
 -                           += ( eelem "div"
 -                                += sattr "class" "title"
 -                                += constL pageTitle
 -                              )
 -                           += ( eelem "div"
 -                                += sattr "class" "body"
 -                                += ( eelem "ul"
 -                                     += ( getXPathTreesInDoc "/pageListing/page/@name/text()"
 -                                          >>>
 -                                          eelem "li"
 -                                          += ( eelem "a"
 -                                               += attr "href" ( getText
 -                                                                >>>
 -                                                                arr (\ x -> uriToString id (mkPageURI baseURI x) "")
 -                                                                >>>
 -                                                                mkText
 -                                                              )
 -                                               += this
 -                                             )
 -                                        )
 -                                   )
 -                              )
 -                         )
 -                      += ( eelem "div"
 -                           += sattr "class" "footer"
 -                         )
 -                      += ( eelem "div"
 -                           += sattr "class" "left sideBar"
 -                           += ( eelem "div"
 -                                += sattr "class" "content"
 -                                += constL leftSideBar
 -                              )
 -                         )
 -                      += ( eelem "div"
 -                           += sattr "class" "right sideBar"
 -                           += ( eelem "div"
 -                                += sattr "class" "content"
 -                                += constL rightSideBar
 -                              )
 -                         )
 -                    )
 -                 >>>
 -                 uniqueNamespacesFromDeclAndQNames
 -               ) ) -<< pageListing
 -
 +    → do SiteName   siteName   ← getSysConfA (envSysConf env) ⤙ ()
 +         BaseURI    baseURI    ← getSysConfA (envSysConf env) ⤙ ()
 +         StyleSheet styleSheet ← getSysConfA (envSysConf env) ⤙ ()
 +         GlobalLock isGLocked  ← getSysConfA (envSysConf env) ⤙ ()
 +
 +         name ← (getXPathTreesInDoc "/pageListing/@path/text()" ⋙ getText) ⤙ pageListing
 +
 +         let cssHref   = [uriToString id (mkObjectURI baseURI styleSheet) ""]
 +             scriptSrc = [uriToString id (baseURI { uriPath = uriPath baseURI </> "js" }) ""]
 +
 +         pageTitle    ← listA (readSubPage env) ⤙ (T.pack name, Nothing, "PageTitle")
 +         leftSideBar  ← listA (readSubPage env) ⤙ (T.pack name, Nothing, "SideBar/Left")
 +         rightSideBar ← listA (readSubPage env) ⤙ (T.pack name, Nothing, "SideBar/Right")
 +
 +         ( eelem "/"
 +           += ( eelem "html"
 +                += sattr "xmlns" "http://www.w3.org/1999/xhtml"
 +                += ( eelem "head"
 +                     += ( eelem "title"
 +                          += txt (T.unpack siteName)
 +                          += txt " - "
 +                          += getXPathTreesInDoc "/pageListing/@path/text()"
 +                        )
 +                     += ( constL cssHref
 +                          ⋙
 +                          eelem "link"
 +                          += sattr "rel"  "stylesheet"
 +                          += sattr "type" "text/css"
 +                          += attr "href" (arr id ⋙ mkText)
 +                        )
 +                     += mkFeedList env
 +                     += ( constL scriptSrc
 +                          ⋙
 +                          eelem "script"
 +                          += sattr "type" "text/javascript"
 +                          += attr "src" (arr id ⋙ mkText)
 +                        )
 +                     += ( eelem "script"
 +                          += sattr "type" "text/javascript"
 +                          += txt ("Rakka.baseURI = \"" ++ uriToString id baseURI "" ++ "\";")
 +                          += txt ("Rakka.isGlobalLocked=" ++ trueOrFalse isGLocked ++ ";")
 +                        )
 +                     += mkGlobalJSList env
 +                   )
 +                += ( eelem "body"
 +                     += ( eelem "div"
 +                          += sattr "class" "header"
 +                        )
 +                     += ( eelem "div"
 +                          += sattr "class" "center"
 +                          += ( eelem "div"
 +                               += sattr "class" "title"
 +                               += constL pageTitle
 +                             )
 +                          += ( eelem "div"
 +                               += sattr "class" "body"
 +                               += ( eelem "ul"
 +                                    += ( getXPathTreesInDoc "/pageListing/page/@name/text()"
 +                                         ⋙
 +                                         eelem "li"
 +                                         += ( eelem "a"
 +                                              += attr "href" ( getText
 +                                                               ⋙
 +                                                               arr (\ x → uriToString id (mkPageURI baseURI (T.pack x)) "")
 +                                                               ⋙
 +                                                               mkText
 +                                                             )
 +                                              += this
 +                                            ) ) ) ) )
 +                     += ( eelem "div"
 +                          += sattr "class" "footer"
 +                        )
 +                     += ( eelem "div"
 +                          += sattr "class" "left sideBar"
 +                          += ( eelem "div"
 +                               += sattr "class" "content"
 +                               += constL leftSideBar
 +                             )
 +                        )
 +                     += ( eelem "div"
 +                          += sattr "class" "right sideBar"
 +                          += ( eelem "div"
 +                               += sattr "class" "content"
 +                               += constL rightSideBar
 +                             )
 +                        )
 +                   )
 +                ⋙
 +                uniqueNamespacesFromDeclAndQNames
 +              ) ) ⤛ pageListing
  
  {-
    <pageNotFound name="Foo/Bar" />
  -}
 -handlePageNotFound :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a PageName (Resource ())
 +handlePageNotFound ∷ (ArrowXml (⇝), ArrowChoice (⇝), ArrowIO (⇝))
 +                   ⇒ Environment
 +                   → PageName ⇝ Resource ()
  handlePageNotFound env
      = proc name
 -    -> do tree <- ( eelem "/"
 -                    += ( eelem "pageNotFound"
 -                         += attr "name" (arr id >>> mkText)
 -                       )
 -                  ) -< name
 -          returnA -< do setStatus NotFound
 -                        outputXmlPage' tree (notFoundToXHTML env)
 -
 -
 -notFoundToXHTML :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a XmlTree XmlTree
 +    → do tree ← ( eelem "/"
 +                  += ( eelem "pageNotFound"
 +                       += attr "name" (arr T.unpack ⋙ mkText)
 +                     )
 +                ) ⤙ name
 +         returnA ⤙ do setStatus NotFound
 +                      outputXmlPage' tree (notFoundToXHTML env)
 +
 +notFoundToXHTML ∷ (ArrowXml (⇝), ArrowChoice (⇝), ArrowIO (⇝))
 +                ⇒ Environment
 +                → XmlTree ⇝ XmlTree
  notFoundToXHTML env
      = proc pageNotFound
 -    -> do SiteName   siteName   <- getSysConfA (envSysConf env) -< ()
 -          BaseURI    baseURI    <- getSysConfA (envSysConf env) -< ()
 -          StyleSheet styleSheet <- getSysConfA (envSysConf env) -< ()
 -          GlobalLock isGLocked  <- getSysConfA (envSysConf env) -< ()
 -
 -          name <- (getXPathTreesInDoc "/pageNotFound/@name/text()" >>> getText) -< pageNotFound
 -
 -          let cssHref   = [uriToString id (mkObjectURI baseURI styleSheet) ""]
 -              scriptSrc = [uriToString id (baseURI { uriPath = uriPath baseURI </> "js" }) ""]
 -
 -          pageTitle    <- listA (readSubPage env) -< (name, Nothing, "PageTitle")
 -          leftSideBar  <- listA (readSubPage env) -< (name, Nothing, "SideBar/Left")
 -          rightSideBar <- listA (readSubPage env) -< (name, Nothing, "SideBar/Right")
 -
 -          ( eelem "/"
 -            += ( eelem "html"
 -                 += sattr "xmlns" "http://www.w3.org/1999/xhtml"
 -                 += ( eelem "head"
 -                      += ( eelem "title"
 -                           += txt siteName
 -                           += txt " - "
 -                           += getXPathTreesInDoc "/pageNotFound/@name/text()"
 -                         )
 -                      += ( constL cssHref
 -                           >>>
 -                           eelem "link"
 -                           += sattr "rel"  "stylesheet"
 -                           += sattr "type" "text/css"
 -                           += attr "href" (arr id >>> mkText)
 -                         )
 -                      += mkFeedList env
 -                      += ( constL scriptSrc
 -                           >>>
 -                           eelem "script"
 -                           += sattr "type" "text/javascript"
 -                           += attr "src" (arr id >>> mkText)
 -                         )
 -                      += ( eelem "script"
 -                           += sattr "type" "text/javascript"
 -                           += txt ("Rakka.baseURI = \"" ++ uriToString id baseURI "" ++ "\";")
 -                           += txt ("Rakka.isGlobalLocked=" ++ trueOrFalse isGLocked ++ ";")
 -                         )
 -                      += mkGlobalJSList env
 -                    )
 -                 += ( eelem "body"
 -                      += ( eelem "div"
 -                           += sattr "class" "header"
 -                         )
 -                      += ( eelem "div"
 -                           += sattr "class" "center"
 -                           += ( eelem "div"
 -                                += sattr "class" "title"
 -                                += constL pageTitle
 -                              )
 -                           += ( eelem "div"
 -                                += sattr "class" "body"
 -                                += txt "404 Not Found (FIXME)" -- FIXME
 -                              )
 -                         )
 -                      += ( eelem "div"
 -                           += sattr "class" "footer"
 -                         )
 -                      += ( eelem "div"
 -                           += sattr "class" "left sideBar"
 -                           += ( eelem "div"
 -                                += sattr "class" "content"
 -                                += constL leftSideBar
 -                              )
 -                         )
 -                      += ( eelem "div"
 -                           += sattr "class" "right sideBar"
 -                           += ( eelem "div"
 -                                += sattr "class" "content"
 -                                += constL rightSideBar
 -                              )
 -                         )
 -                    )
 -                 >>>
 -                 uniqueNamespacesFromDeclAndQNames
 -               ) ) -<< pageNotFound
 -
 -
 -handlePut :: Environment -> PageName -> Resource ()
 +    → do SiteName   siteName   ← getSysConfA (envSysConf env) ⤙ ()
 +         BaseURI    baseURI    ← getSysConfA (envSysConf env) ⤙ ()
 +         StyleSheet styleSheet ← getSysConfA (envSysConf env) ⤙ ()
 +         GlobalLock isGLocked  ← getSysConfA (envSysConf env) ⤙ ()
 +
 +         name ← (getXPathTreesInDoc "/pageNotFound/@name/text()" ⋙ getText) ⤙ pageNotFound
 +
 +         let cssHref   = [uriToString id (mkObjectURI baseURI styleSheet) ""]
 +             scriptSrc = [uriToString id (baseURI { uriPath = uriPath baseURI </> "js" }) ""]
 +
 +         pageTitle    ← listA (readSubPage env) ⤙ (T.pack name, Nothing, "PageTitle"    )
 +         leftSideBar  ← listA (readSubPage env) ⤙ (T.pack name, Nothing, "SideBar/Left" )
 +         rightSideBar ← listA (readSubPage env) ⤙ (T.pack name, Nothing, "SideBar/Right")
 +
 +         ( eelem "/"
 +           += ( eelem "html"
 +                += sattr "xmlns" "http://www.w3.org/1999/xhtml"
 +                += ( eelem "head"
 +                     += ( eelem "title"
 +                          += txt (T.unpack siteName)
 +                          += txt " - "
 +                          += getXPathTreesInDoc "/pageNotFound/@name/text()"
 +                        )
 +                     += ( constL cssHref
 +                          ⋙
 +                          eelem "link"
 +                          += sattr "rel"  "stylesheet"
 +                          += sattr "type" "text/css"
 +                          += attr "href" (arr id ⋙ mkText)
 +                        )
 +                     += mkFeedList env
 +                     += ( constL scriptSrc
 +                          ⋙
 +                          eelem "script"
 +                          += sattr "type" "text/javascript"
 +                          += attr "src" (arr id ⋙ mkText)
 +                        )
 +                     += ( eelem "script"
 +                          += sattr "type" "text/javascript"
 +                          += txt ("Rakka.baseURI = \"" ++ uriToString id baseURI "" ++ "\";")
 +                          += txt ("Rakka.isGlobalLocked=" ++ trueOrFalse isGLocked ++ ";")
 +                        )
 +                     += mkGlobalJSList env
 +                   )
 +                += ( eelem "body"
 +                     += ( eelem "div"
 +                          += sattr "class" "header"
 +                        )
 +                     += ( eelem "div"
 +                          += sattr "class" "center"
 +                          += ( eelem "div"
 +                               += sattr "class" "title"
 +                               += constL pageTitle
 +                             )
 +                          += ( eelem "div"
 +                               += sattr "class" "body"
 +                               += txt "404 Not Found (FIXME)" -- FIXME
 +                             )
 +                        )
 +                     += ( eelem "div"
 +                          += sattr "class" "footer"
 +                        )
 +                     += ( eelem "div"
 +                          += sattr "class" "left sideBar"
 +                          += ( eelem "div"
 +                               += sattr "class" "content"
 +                               += constL leftSideBar
 +                             )
 +                        )
 +                     += ( eelem "div"
 +                          += sattr "class" "right sideBar"
 +                          += ( eelem "div"
 +                               += sattr "class" "content"
 +                               += constL rightSideBar
 +                             )
 +                        )
 +                   )
 +                ⋙
 +                uniqueNamespacesFromDeclAndQNames
 +              ) ) ⤛ pageNotFound
 +
 +handlePut ∷ Environment → PageName → Resource ()
  handlePut env name
 -    = do userID <- getUserID env
 -         runXmlA env "rakka-page-1.0.rng" $ proc tree
 -             -> do page   <- parseXmlizedPage -< (name, tree)
 -                   status <- putPageA (envStorage env) -< (userID, page)
 -                   returnA  -< setStatus status
 -
 +    = do userID ← getUserID env
 +         runXmlA "rakka-page-1.0.rng" $ proc tree
 +             → do page   ← parseXmlizedPage ⤙ (name, tree)
 +                  status ← putPageA (envStorage env) ⤙ (userID, page)
 +                  returnA ⤙ setStatus status
  
 -handleDelete :: Environment -> PageName -> Resource ()
 +handleDelete ∷ Environment → PageName → Resource ()
  handleDelete env name
 -    = do userID <- getUserID env
 -         status <- deletePage (envStorage env) userID name
 +    = do userID ← getUserID env
 +         status ← deletePage (envStorage env) userID name
           setStatus status
  
 -
 -mkFeedList :: (ArrowIO a, ArrowXml a) => Environment -> a b XmlTree
 +mkFeedList ∷ (ArrowIO (⇝), ArrowXml (⇝)) ⇒ Environment → β ⇝ XmlTree
  mkFeedList env
 -    = proc _ -> do SiteName siteName <- getSysConfA (envSysConf env) -< ()
 -                   BaseURI  baseURI  <- getSysConfA (envSysConf env) -< ()
 -
 -                   feed <- unlistA <<< arrIO0 (findFeeds $ envStorage env) -< ()
 -                   
 -                   ( eelem "link"
 -                     += sattr "rel"   "alternate"
 -                     += sattr "type"  "application/rss+xml"
 -                     += attr  "title" (txt siteName <+> txt " - " <+> mkText)
 -                     += attr  "href"  (arr (mkFeedURIStr baseURI) >>> mkText) ) -<< feed
 -
 +    = proc _
 +      → do SiteName siteName ← getSysConfA (envSysConf env) ⤙ ()
 +           BaseURI  baseURI  ← getSysConfA (envSysConf env) ⤙ ()
 +           feed ← unlistA ⋘ arrIO0 (findFeeds $ envStorage env) ⤙ ()
 +           ( eelem "link"
 +             += sattr "rel"   "alternate"
 +             += sattr "type"  "application/rss+xml"
 +             += attr  "title" (txt (T.unpack siteName) <+> txt " - " <+> (arr T.unpack ⋙ mkText))
 +             += attr  "href"  (arr (mkFeedURIStr baseURI) ⋙ mkText) ) ⤛ feed
  
  findFeeds :: Storage -> IO [PageName]
  findFeeds sto
@@@ -616,18 -603,23 +608,18 @@@ mkGlobalJSList en
                           | otherwise
                               -> none -< ()
  
 -
 -findJavaScripts :: Storage -> IO [PageName]
 +findJavaScripts ∷ Storage → IO [PageName]
  findJavaScripts sto
 -    = do cond <- newCondition
 +    = do cond ← newCondition
           setPhrase   cond "[UVSET]"
           addAttrCond cond "@title STRBW Global/"
           addAttrCond cond "@type  STRBW text/javascript"
           setOrder    cond "@uri STRA"
 -         result <- searchPages sto cond
 +         result ← searchPages sto cond
           return (map hpPageName $ srPages result)
  
 +mkFeedURIStr ∷ URI → PageName → String
 +mkFeedURIStr = flip flip "" ∘ (uriToString id ∘) ∘ mkFeedURI
  
 -mkFeedURIStr :: URI -> PageName -> String
 -mkFeedURIStr baseURI name
 -    = uriToString id (mkFeedURI baseURI name) ""
 -
 -
 -mkObjectURIStr :: URI -> PageName -> String
 -mkObjectURIStr baseURI name
 -    = uriToString id (mkObjectURI baseURI name) ""
 +mkObjectURIStr ∷ URI → PageName → String
 +mkObjectURIStr = flip flip "" ∘ (uriToString id ∘) ∘ mkObjectURI
diff --combined Rakka/Resource/Search.hs
index 56f99c0,eb4acf2..2d076e8
--- a/Rakka/Resource/Search.hs
+++ b/Rakka/Resource/Search.hs
@@@ -1,45 -1,26 +1,46 @@@
 +{-# LANGUAGE
 +    Arrows
 +  , OverloadedStrings
 +  , TypeOperators
 +  , UnicodeSyntax
 +  #-}
  module Rakka.Resource.Search
      ( resSearch
      )
      where
 +import Control.Applicative
 +import Control.Arrow
 +import Control.Arrow.ArrowIf
 +import Control.Arrow.ArrowIO
 +import Control.Arrow.ArrowList
 +import Control.Arrow.ArrowTree
 +import Control.Arrow.Unicode
 +import qualified Codec.Binary.UTF8.Generic as UTF8
  import           Control.Monad.Trans
 -import           Data.List
++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
  import           Rakka.Environment
  import           Rakka.Page
  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)
 -import           Text.XML.HXT.XPath
 -
 +import Text.XML.HXT.Arrow.Namespace
 +import Text.XML.HXT.Arrow.XmlArrow
 +import Text.XML.HXT.DOM.TypeDefs
 +import Text.XML.HXT.XPath
  
  resSearch :: Environment -> ResourceDef
  resSearch env
@@@ -61,9 -42,11 +62,9 @@@ resultsPerSection = 1
  maxSectionWindowSize :: Int
  maxSectionWindowSize = 10
  
 -
 -findQueryParam :: String -> [FormData] -> Maybe String
 +findQueryParam ∷ String → [(String, FormData)] → Maybe String
  findQueryParam name qps
 -    = do fd <- find (\ qp -> fdName qp == name) qps
 -         return $ UTF8.toString $ fdContent fd
 +    = UTF8.toString ∘ fdContent <$> lookup name qps
  
  {-
    <searchResult query="foo bar baz"
@@@ -78,9 -61,9 +79,9 @@@
      ...
    </searchResult>
  -}
 -handleSearch :: Environment -> Resource ()
 +handleSearch ∷ Environment → Resource ()
  handleSearch env
 -    = do params <- getQueryForm
 +    = do params ← getQueryForm
  
           let query = fromMaybe "" $ findQueryParam "q" params
               order = findQueryParam "order" params
@@@ -89,219 -72,224 +90,219 @@@
               to    = fromMaybe (from + resultsPerSection)
                       $ fmap read $ findQueryParam "to" params
  
 -         cond   <- liftIO $ mkCond query order from to
 -         result <- searchPages (envStorage env) cond
 +         cond   ← liftIO $ mkCond (T.pack query) (T.pack <$> order) from to
 +         result ← searchPages (envStorage env) cond
  
           let to' = min (from + length (srPages result)) to
  
 -         BaseURI baseURI <- getSysConf (envSysConf env)
 +         BaseURI baseURI ← getSysConf (envSysConf env)
           runIdempotentA baseURI $ proc ()
 -             -> do tree <- ( eelem "/"
 -                             += ( eelem "searchResult"
 -                                  += sattr "query" query
 -                                  += ( case order of
 -                                         Just o  -> sattr "order" o
 -                                         Nothing -> none
 -                                     )
 -                                  += sattr "from"  (show from)
 -                                  += sattr "to"    (show to')
 -                                  += sattr "total" (show $ srTotal result)
 -                                  += ( constL (srPages result)
 -                                       >>>
 -                                       mkPageElem
 -                                     )
 -                                )
 -                           ) -< ()
 -                   returnA -< outputXmlPage' tree (searchResultToXHTML env)
 +             → do tree ← ( eelem "/"
 +                           += ( eelem "searchResult"
 +                                += sattr "query" query
 +                                += ( case order of
 +                                       Just o  → sattr "order" o
 +                                       Nothing → none
 +                                   )
 +                                += sattr "from"  (show from)
 +                                += sattr "to"    (show to')
 +                                += sattr "total" (show $ srTotal result)
 +                                += ( constL (srPages result)
 +                                     ⋙
 +                                     mkPageElem
 +                                   )
 +                              )
 +                         ) ⤙ ()
 +                  returnA ⤙ outputXmlPage' tree (searchResultToXHTML env)
      where
 -      mkCond :: String -> Maybe String -> Int -> Int -> IO Condition
 +      mkCond ∷ Text → Maybe Text → Int → Int → IO Condition
        mkCond query order from to
 -          = do cond <- newCondition
 +          = do cond ← newCondition
                 setPhrase cond query
                 case order of
 -                 Just o  -> setOrder cond o
 -                 Nothing -> return ()
 -               setSkip   cond from
 -               setMax    cond (to - from + 1)
 -               return cond
 +                 Just o  → setOrder cond o
 +                 Nothing → return ()
 +               setSkip cond from
 +               setMax  cond (to - from + 1)
 +               pure cond
  
 -      mkPageElem :: (ArrowChoice a, ArrowXml a, ArrowIO a) => a HitPage XmlTree
 +      mkPageElem ∷ (ArrowChoice (⇝), ArrowXml (⇝), ArrowIO (⇝)) ⇒ HitPage ⇝ XmlTree
        mkPageElem = ( eelem "page"
 -                     += attr "name" (arr hpPageName >>> mkText)
 -                     += attr "lastModified" ( arrIO (utcToLocalZonedTime . hpLastMod)
 -                                              >>>
 +                     += attr "name" (arr (T.unpack ∘ hpPageName) ⋙ mkText)
 +                     += attr "lastModified" ( arrIO (utcToLocalZonedTime ∘ hpLastMod)
 +                                              ⋙
-                                               arr formatW3CDateTime
+                                               arr W3C.format
 -                                              >>>
 +                                              ⋙
                                                mkText
                                              )
                       += ( arrL hpSnippet
 -                          >>>
 +                          ⋙
                            mkSnippetTree
                          )
                     )
  
 -      mkSnippetTree :: (ArrowChoice a, ArrowXml a) => a SnippetFragment XmlTree
 +      mkSnippetTree ∷ (ArrowChoice (⇝), ArrowXml (⇝)) ⇒ SnippetFragment ⇝ XmlTree
        mkSnippetTree = proc fragment
 -                    -> case fragment of
 -                         Boundary          -> eelem "boundary" -< ()
 -                         NormalText      t -> mkText           -< t
 -                         HighlightedWord w -> ( eelem "hit"
 -                                                += mkText
 -                                              ) -< w
 -
 +                    → case fragment of
 +                        Boundary          → eelem "boundary" ⤙ ()
 +                        NormalText      t → mkText           ⤙ T.unpack t
 +                        HighlightedWord w → ( eelem "hit"
 +                                              += mkText
 +                                            ) ⤙ T.unpack w
  
 -searchResultToXHTML :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a XmlTree XmlTree
 +searchResultToXHTML ∷ (ArrowXml (⇝), ArrowChoice (⇝), ArrowIO (⇝))
 +                    ⇒ Environment
 +                    → XmlTree ⇝ XmlTree
  searchResultToXHTML env
      = proc tree
 -    -> do SiteName   siteName   <- getSysConfA (envSysConf env) -< ()
 -          BaseURI    baseURI    <- getSysConfA (envSysConf env) -< ()
 -          StyleSheet styleSheet <- getSysConfA (envSysConf env) -< ()
 -          GlobalLock isGLocked  <- getSysConfA (envSysConf env) -< ()
 +    → do SiteName   siteName   ← getSysConfA (envSysConf env) ⤙ ()
 +         BaseURI    baseURI    ← getSysConfA (envSysConf env) ⤙ ()
 +         StyleSheet styleSheet ← getSysConfA (envSysConf env) ⤙ ()
 +         GlobalLock isGLocked  ← getSysConfA (envSysConf env) ⤙ ()
  
 -          let cssHref   = [uriToString id (mkObjectURI baseURI styleSheet) ""]
 -              scriptSrc = [uriToString id (baseURI { uriPath = uriPath baseURI </> "js" }) ""]
 +         let cssHref   = [uriToString id (mkObjectURI baseURI styleSheet) ""]
 +             scriptSrc = [uriToString id (baseURI { uriPath = uriPath baseURI </> "js" }) ""]
  
 -          pageTitle    <- listA (readSubPage env) -< "PageTitle"
 -          leftSideBar  <- listA (readSubPage env) -< "SideBar/Left"
 -          rightSideBar <- listA (readSubPage env) -< "SideBar/Right"
 +         pageTitle    ← listA (readSubPage env) ⤙ "PageTitle"
 +         leftSideBar  ← listA (readSubPage env) ⤙ "SideBar/Left"
 +         rightSideBar ← listA (readSubPage env) ⤙ "SideBar/Right"
  
 -          ( eelem "/"
 -            += ( eelem "html"
 -                 += sattr "xmlns" "http://www.w3.org/1999/xhtml"
 -                 += ( eelem "head"
 -                      += ( eelem "title"
 -                           += txt siteName
 -                           += txt " - "
 -                           += getXPathTreesInDoc "/searchResult/@query/text()"
 -                         )
 -                      += ( constL cssHref
 -                           >>>
 -                           eelem "link"
 -                           += sattr "rel"  "stylesheet"
 -                           += sattr "type" "text/css"
 -                           += attr "href" (arr id >>> mkText)
 -                         )
 -                      += ( constL scriptSrc
 -                           >>>
 -                           eelem "script"
 -                           += sattr "type" "text/javascript"
 -                           += attr "src" (arr id >>> mkText)
 -                         )
 -                      += ( eelem "script"
 -                           += sattr "type" "text/javascript"
 -                           += txt ("Rakka.baseURI=\"" ++ uriToString id baseURI "" ++ "\";")
 -                           += txt ("Rakka.isGlobalLocked=" ++ trueOrFalse isGLocked ++ ";")
 -                           += txt  "Rakka.isSpecialPage=true;"
 -                         )
 -                    )
 -                 += ( eelem "body"
 -                      += ( eelem "div"
 -                           += sattr "class" "header"
 -                         )
 -                      += ( eelem "div"
 -                           += sattr "class" "center"
 -                           += ( eelem "div"
 -                                += sattr "class" "title"
 -                                += constL pageTitle
 -                              )
 -                           += ( eelem "div"
 -                                += sattr "class" "body"
 -                                += ( eelem "h1"
 -                                     += txt "Search Result"
 -                                   )
 -                                += ( eelem "div"
 -                                     += sattr "class" "searchStat"
 -                                     += txt "Search result for "
 -                                     += ( eelem "span"
 -                                          += sattr "class" "queryString"
 -                                          += getXPathTreesInDoc "/searchResult/@query/text()"
 -                                        )
 -                                     += txt ": found "
 -                                     += getXPathTreesInDoc "/searchResult/@total/text()"
 -                                     += txt " pages."
 -                                   )
 -                                += ( getXPathTreesInDoc "/searchResult/page"
 -                                     >>>
 -                                     formatItem baseURI
 -                                   )
 -                                += ( ( ( getXPathTreesInDoc "/searchResult/@query/text()"
 -                                         >>>
 -                                         getText
 -                                       )
 -                                       &&&
 -                                       maybeA ( getXPathTreesInDoc "/searchResult/@order/text()"
 -                                                >>>
 -                                                getText
 -                                              )
 -                                       &&&
 -                                       ( getXPathTreesInDoc "/searchResult/@from/text()"
 -                                         >>>
 -                                         getText
 -                                         >>>
 -                                         arr ((`div` resultsPerSection) . read)
 -                                       )
 -                                       &&&
 -                                       ( getXPathTreesInDoc "/searchResult/@total/text()"
 -                                         >>>
 -                                         getText
 -                                         >>>
 -                                         arr ((+ 1) . (`div` resultsPerSection) . (\ x -> x - 1) . read)
 +         ( eelem "/"
 +           += ( eelem "html"
 +                += sattr "xmlns" "http://www.w3.org/1999/xhtml"
 +                += ( eelem "head"
 +                     += ( eelem "title"
 +                          += txt (T.unpack siteName)
 +                          += txt " - "
 +                          += getXPathTreesInDoc "/searchResult/@query/text()"
 +                        )
 +                     += ( constL cssHref
 +                          ⋙
 +                          eelem "link"
 +                          += sattr "rel"  "stylesheet"
 +                          += sattr "type" "text/css"
 +                          += attr "href" (arr id ⋙ mkText)
 +                        )
 +                     += ( constL scriptSrc
 +                          ⋙
 +                          eelem "script"
 +                          += sattr "type" "text/javascript"
 +                          += attr "src" (arr id ⋙ mkText)
 +                        )
 +                     += ( eelem "script"
 +                          += sattr "type" "text/javascript"
 +                          += txt ("Rakka.baseURI=\""      ⊕ uriToString id baseURI "" ⊕ "\";")
 +                          += txt ("Rakka.isGlobalLocked=" ⊕ trueOrFalse isGLocked     ⊕ ";"  )
 +                          += txt  "Rakka.isSpecialPage=true;" ) )
 +                += ( eelem "body"
 +                     += ( eelem "div"
 +                          += sattr "class" "header"
 +                        )
 +                     += ( eelem "div"
 +                          += sattr "class" "center"
 +                          += ( eelem "div"
 +                               += sattr "class" "title"
 +                               += constL pageTitle
 +                             )
 +                          += ( eelem "div"
 +                               += sattr "class" "body"
 +                               += ( eelem "h1"
 +                                    += txt "Search Result"
 +                                  )
 +                               += ( eelem "div"
 +                                    += sattr "class" "searchStat"
 +                                    += txt "Search result for "
 +                                    += ( eelem "span"
 +                                         += sattr "class" "queryString"
 +                                         += getXPathTreesInDoc "/searchResult/@query/text()"
                                         )
 -                                     )
 -                                     >>>
 -                                     ( ((> 1) . snd . snd . snd)
 -                                       `guardsP`
 -                                       formatPager baseURI
 -                                     )
 -                                   )
 -                              )
 -                         )
 -                      += ( eelem "div"
 -                           += sattr "class" "footer"
 -                         )
 -                      += ( eelem "div"
 -                           += sattr "class" "left sideBar"
 -                           += ( eelem "div"
 -                                += sattr "class" "content"
 -                                += constL leftSideBar
 -                              )
 -                         )
 -                      += ( eelem "div"
 -                           += sattr "class" "right sideBar"
 -                           += ( eelem "div"
 -                                += sattr "class" "content"
 -                                += constL rightSideBar
 -                              )
 -                         )
 -                    )
 -                 >>>
 -                 uniqueNamespacesFromDeclAndQNames
 -               ) ) -<< tree
 +                                    += txt ": found "
 +                                    += getXPathTreesInDoc "/searchResult/@total/text()"
 +                                    += txt " pages."
 +                                  )
 +                               += ( getXPathTreesInDoc "/searchResult/page"
 +                                    ⋙
 +                                    formatItem baseURI
 +                                  )
 +                               += ( ( ( getXPathTreesInDoc "/searchResult/@query/text()"
 +                                        ⋙
 +                                        getText
 +                                      )
 +                                      &&&
 +                                      maybeA ( getXPathTreesInDoc "/searchResult/@order/text()"
 +                                               ⋙
 +                                               getText
 +                                             )
 +                                      &&&
 +                                      ( getXPathTreesInDoc "/searchResult/@from/text()"
 +                                        ⋙
 +                                        getText
 +                                        ⋙
 +                                        arr ((`div` resultsPerSection) . read)
 +                                      )
 +                                      &&&
 +                                      ( getXPathTreesInDoc "/searchResult/@total/text()"
 +                                        ⋙
 +                                        getText
 +                                        ⋙
 +                                        arr ((+ 1) . (`div` resultsPerSection) . (\x → x - 1) . read) ) )
 +                                    ⋙
 +                                    ( ((> 1) . snd . snd . snd)
 +                                      `guardsP`
 +                                      formatPager baseURI ) ) ) )
 +                     += ( eelem "div"
 +                          += sattr "class" "footer"
 +                        )
 +                     += ( eelem "div"
 +                          += sattr "class" "left sideBar"
 +                          += ( eelem "div"
 +                               += sattr "class" "content"
 +                               += constL leftSideBar
 +                             )
 +                        )
 +                     += ( eelem "div"
 +                          += sattr "class" "right sideBar"
 +                          += ( eelem "div"
 +                               += sattr "class" "content"
 +                               += constL rightSideBar
 +                             )
 +                        )
 +                   )
 +                ⋙
 +                uniqueNamespacesFromDeclAndQNames
 +              ) ) ⤛ tree
      where
 -      formatItem :: (ArrowXml a, ArrowChoice a, ArrowIO a) => URI -> a XmlTree XmlTree
 +      formatItem ∷ (ArrowXml (⇝), ArrowChoice (⇝), ArrowIO (⇝))
 +                 ⇒ URI
 +                 → XmlTree ⇝ XmlTree
        formatItem baseURI
            = ( eelem "div"
                += sattr "class" "searchResult"
                += ( eelem "a"
                     += attr "href" ( getAttrValue "name"
 -                                    >>>
 -                                    arr (\ x -> uriToString id (mkPageURI baseURI x) "")
 -                                    >>>
 +                                    ⋙
 +                                    arr (\x → uriToString id (mkPageURI baseURI (T.pack x)) "")
 +                                    ⋙
                                      mkText
                                    )
 -                   += (getAttrValue "name" >>> mkText)
 +                   += (getAttrValue "name" ⋙ mkText)
                   )
                += ( eelem "div"
                     += sattr "class" "date"
                     += ( getAttrValue "lastModified"
 -                        >>>
 +                        ⋙
-                         arr (zonedTimeToUTC . fromJust . parseW3CDateTime)
+                         arr (zonedTimeToUTC . fromJust . W3C.parse)
 -                        >>>
 +                        ⋙
                          arrIO utcToLocalZonedTime
 -                        >>>
 +                        ⋙
                          arr RFC1123.format
 -                        >>>
 +                        ⋙
                          mkText
                        )
                   )
                += ( eelem "p"
                     += ( getChildren
 -                        >>>
 +                        ⋙
                          choiceA [ isText             :-> this
                                  , hasName "boundary" :-> txt " ... "
                                  , hasName "hit"      :-> ( eelem "span"
@@@ -325,29 -313,29 +326,29 @@@
                       arr (fst . snd . snd)
                       &&&
                       ( arr (snd . snd)
 -                       >>>
 +                       ⋙
                         mkSectionWindow
                       )
                     )
 -                   >>>
 +                   ⋙
                     proc (query, (order, (currentSection, section)))
                         -> if currentSection == section then
                                ( txt " "
                                  <+> 
                                  eelem "span"
                                  += sattr "class" "currentSection"
 -                                += (arr show >>> mkText)
 -                              ) -< section
 +                                += (arr show ⋙ mkText)
 +                              ) ⤙ section
                            else
                                ( txt " "
                                  <+>
                                  eelem "a"
                                  += attr "href" ( mkSectionURI baseURI
 -                                                 >>>
 +                                                 ⋙
                                                   uriToText
                                                 )
 -                                += (arr (show . snd . snd) >>> mkText)
 -                              ) -< (query, (order, section))
 +                                += (arr (show . snd . snd) ⋙ mkText)
 +                              ) ⤙ (query, (order, section))
                   )
              )
  
@@@ -367,7 -355,7 +368,7 @@@
                                          -- どちらにも溢れない
                                          (windowBegin, windowBegin + windowWidth - 1)
               in
 -               arrL id -< [begin .. end]
 +               arrL id ⤙ [begin .. end]
                         
  
        mkSectionURI :: Arrow a => URI -> a (String, (Maybe String, Int)) URI
@@@ -375,19 -363,19 +376,19 @@@
            = 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
 -      uriToText = arr (\ uri -> uriToString id uri "") >>> mkText
 +      uriToText = arr (\ uri -> uriToString id uri "") ⋙ mkText
  
  
  -- FIXME: localize
@@@ -395,6 -383,6 +396,6 @@@ readSubPage :: (ArrowXml a, ArrowChoic
                 Environment -> a PageName XmlTree
  readSubPage env
      = proc (subPageName) ->
 -      do subPage  <- getPageA (envStorage env) >>> arr fromJust >>> xmlizePage -< (subPageName, Nothing)
 -         subXHTML <- makeSubXHTML (envStorage env) (envSysConf env) (envInterpTable env) -< (Nothing, Nothing, subPage)
 -         returnA -< subXHTML
 +      do subPage  ← getPageA (envStorage env) ⋙ arr fromJust ⋙ xmlizePage ⤙ (subPageName, Nothing)
 +         subXHTML ← makeSubXHTML (envStorage env) (envSysConf env) (envInterpTable env) ⤙ (Nothing, Nothing, subPage)
 +         returnA ⤙ subXHTML
diff --combined Rakka/Resource/TrackBack.hs
index df1f5c3,1bcdbf9..0000000
deleted file mode 100644,100644
--- a/Rakka/Resource/TrackBack.hs
+++ /dev/null
@@@ -1,154 -1,154 +1,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
 -         output 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 --combined Rakka/Storage/Impl.hs
index 8b3cbeb,304b817..55bda71
--- a/Rakka/Storage/Impl.hs
+++ b/Rakka/Storage/Impl.hs
@@@ -1,7 -1,3 +1,7 @@@
 +{-# LANGUAGE
 +    OverloadedStrings
 +  , UnicodeSyntax
 +  #-}
  module Rakka.Storage.Impl
      ( getPage'
      , putPage'
@@@ -13,29 -9,25 +13,29 @@@
      , putAttachment'
      )
      where
 -
 +import Control.Applicative
  import           Control.Concurrent
  import           Control.Concurrent.STM
  import           Control.Exception
  import           Control.Monad
  import           Data.Maybe
 +import Data.Monoid.Unicode
  import           Data.Set (Set)
  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
  import           Prelude hiding (words)
 +import Prelude.Unicode
  import           Rakka.Attachment
  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
@@@ -196,51 -188,52 +196,51 @@@ syncIndex' index revFile repos mkDraf
                 mapM_ (updateIndex index repos mkDraft newRev) (S.toList pages)
  
  
 -searchIndex :: Database -> Condition -> IO SearchResult
 +searchIndex ∷ Database → Condition → IO SearchResult
  searchIndex index cond
 -    = do (ids, hint) <- searchDatabase' index cond
 +    = do (ids, hint) ← searchDatabase' index cond
           let (total, words) = parseHint hint
 -         pages <- mapM (fromId words) ids
 +         pages ← mapM (fromId words) ids
           return SearchResult {
                        srTotal = total
                      , srPages = pages
                      }
      where
 -      parseHint :: [(String, Int)] -> (Int, [String])
 +      parseHint ∷ [(Text, Int)] → (Int, [Text])
        parseHint xs
            = let total = fromJust $ lookup "" xs
 -                words = filter (/= "") $ map fst xs
 +                words = filter ((¬) ∘ T.null) $ map fst xs
              in
                (total, words)
  
 -      fromId :: [String] -> DocumentID -> IO HitPage
 +      fromId ∷ [Text] → DocumentID → IO HitPage
        fromId words docId
 -          = do uri     <- getDocURI index docId
 -               rev     <- unsafeInterleaveIO $
 -                          liftM (read . fromJust)
 -                                (getDocAttr index docId "rakka:revision")
 -               lastMod <- unsafeInterleaveIO $
 -                          liftM (zonedTimeToUTC . fromJust . W3C.parse . fromJust)
 -                                (getDocAttr index docId "@mdate")
 -               summary <- unsafeInterleaveIO $
 -                          getDocAttr index docId "rakka:summary"
 -               snippet <- unsafeInterleaveIO $
 -                          do doc <- getDocument index docId [NoAttributes, NoKeywords]
 -                             sn  <- makeSnippet doc words 300 80 80
 -                             return (trim (== Boundary) $ map toFragment sn)
 -               return HitPage {
 -                            hpPageName = decodePageName $ uriPath uri
 -                          , hpPageRev  = rev
 -                          , hpLastMod  = lastMod
 -                          , hpSummary  = summary
 -                          , hpSnippet  = snippet
 -                          }
 -
 -      toFragment :: Either String (String, String) -> SnippetFragment
 -      toFragment (Left "")      = Boundary
 -      toFragment (Left t)       = NormalText t
 +          = do uri     ← getDocURI index docId
 +               rev     ← unsafeInterleaveIO $
 +                         -- FIXME: use Data.Text.Read
 +                         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"
 +               snippet ← unsafeInterleaveIO $
 +                         do doc ← getDocument index docId [NoAttributes, NoKeywords]
 +                            sn  ← makeSnippet doc words 300 80 80
 +                            pure (trim (≡ Boundary) $ map toFragment sn)
 +               pure HitPage {
 +                      hpPageName = decodePageName $ uriPath uri
 +                    , hpPageRev  = rev
 +                    , hpLastMod  = lastMod
 +                    , hpSummary  = summary
 +                    , hpSnippet  = snippet
 +                    }
 +      toFragment ∷ Either Text (Text, Text) -> SnippetFragment
 +      toFragment (Left  ""    ) = Boundary
 +      toFragment (Left  t     ) = NormalText      t
        toFragment (Right (w, _)) = HighlightedWord w
  
 -
  updateIndex :: Database
              -> Repository
              -> (Page -> IO Document)
@@@ -256,11 -249,11 +256,11 @@@ updateIndex index repos mkDraft rev nam
                       case docIdM of
                         Nothing    -> return ()
                         Just docId -> do removeDocument index docId [CleaningRemove]
 -                                        infoM logger ("Removed page " ++ name ++ " from the index")
 +                                        infoM logger ("Removed page " ⊕ T.unpack name ⊕ " from the index")
             Just page
                 -> do draft <- mkDraft page
                       putDocument index draft [CleaningPut]
 -                     infoM logger ("Indexed page " ++ name ++ " of revision " ++ show (pageRevision page))
 +                     infoM logger ("Indexed page " ⊕ T.unpack name ⊕ " of revision " ⊕ show (pageRevision page))
  
  
  updateIndexRev :: FilePath -> (RevNum -> IO RevNum) -> IO ()
diff --combined Rakka/Storage/Repos.hs
index 6a90ed6,ae4ce70..05759d9
--- a/Rakka/Storage/Repos.hs
+++ b/Rakka/Storage/Repos.hs
@@@ -1,10 -1,4 +1,10 @@@
  -- -*- coding: utf-8 -*-
 +{-# LANGUAGE
 +    DoAndIfThenElse
 +  , RecordWildCards
 +  , ScopedTypeVariables
 +  , UnicodeSyntax
 +  #-}
  module Rakka.Storage.Repos
      ( findAllPagesInRevision
      , getDirContentsInRevision
@@@ -16,26 -10,19 +16,26 @@@
      , putAttachmentIntoRepository
      )
      where
 +import Control.Applicative
 +import           Codec.Binary.UTF8.String
  import           Control.Monad
 +import Control.Monad.Unicode
 +import qualified Data.CaseInsensitive as CI
  import           Data.List
  import qualified Data.Map as M
  import           Data.Maybe
 +import Data.Monoid.Unicode
  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
@@@ -96,6 -83,7 +96,6 @@@ findAllPagesInRevision repos re
        decodePath :: FilePath -> PageName
        decodePath = decodePageName . makeRelative root . dropExtension
  
 -
  getDirContentsInRevision :: Repository -> PageName -> Maybe RevNum -> IO (Set PageName)
  getDirContentsInRevision repos dir rev
      = do fs   <- getRepositoryFS repos
@@@ -115,8 -103,9 +115,8 @@@
        getDir' :: Rev [PageName]
        getDir' = liftM (map entToName) (getDirEntries path)
  
 -      entToName :: DirEntry -> PageName
 -      entToName = (dir </>) . decodePageName . dropExtension . entName
 -
 +      entToName ∷ DirEntry → PageName
 +      entToName = T.pack ∘ (T.unpack dir </>) ∘ T.unpack ∘ decodePageName ∘ dropExtension ∘ entName
  
  findChangedPagesAtRevision :: Repository -> RevNum -> IO (Set PageName)
  findChangedPagesAtRevision repos rev
@@@ -172,13 -161,13 +172,13 @@@ loadPageInRepository repos name re
                                $ 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 {
                              entityName       = name
                            , entityType       = mimeType
 -                          , entityLanguage   = fmap chomp (lookup "rakka:lang" props)
 +                          , entityLanguage   = CI.mk ∘ T.pack ∘ chomp <$> lookup "rakka:lang" props
                            , entityIsTheme    = any ((== "rakka:isTheme") . fst) props
                            , entityIsFeed     = any ((== "rakka:isFeed") . fst) props
                            , entityIsLocked   = any ((== "rakka:isLocked") . fst) props
@@@ -190,10 -179,11 +190,10 @@@
                            , entityRevision   = pageRev
                            , entityLastMod    = zonedTimeToUTC lastMod
                            , entitySummary    = fmap decodeString (lookup "rakka:summary" props)
 -                          , entityOtherLang  = fromMaybe M.empty
 -                                             $ fmap
 -                                                   (M.fromList . fromJust . deserializeStringPairs . decodeString)
 -                                                   (lookup "rakka:otherLang" props)
 -                          , entityContent    = content                                             
 +                          , entityOtherLang  = maybe (∅)
 +                                                     (fromJust ∘ deserializeMap CI.mk id ∘ T.pack ∘ decodeString)
 +                                                     (lookup "rakka:otherLang" props)
 +                          , entityContent    = content
                            , entityUpdateInfo = undefined
                            }
        
@@@ -203,10 -193,10 +203,10 @@@
                 content <- getFileContents path
  
                 let pageRev = fst $ head hist
 -                   dest    = chomp $ decodeString content
 +                   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")
@@@ -221,64 -211,63 +221,64 @@@
                            }
  
  
 -putPageIntoRepository :: Repository -> Maybe String -> Page -> IO StatusCode
 +putPageIntoRepository ∷ Repository → Maybe String → Page → IO StatusCode
  putPageIntoRepository repos userID page
 -    = do let name   = pageName page
 -             author = fromMaybe "[Rakka]" userID
 -         case pageUpdateInfo page of
 -           Just ui
 -               -> do let oldRev = uiOldRevision ui
 -                     denied <- case uiOldName ui of
 -                                 Nothing      -> checkDenial oldRev name
 -                                 Just oldName -> checkDenial oldRev oldName
 -                     if denied then
 -                         return Forbidden
 -                       else
 -                         do rev <- if oldRev == 0 then
 -                                       getRepositoryFS repos >>= getYoungestRev
 -                                   else
 -                                       return oldRev
 -                            ret <- doReposTxn
 -                                   repos
 -                                   rev
 -                                   author
 -                                   (Just "Automatic commit by Rakka for page update")
 -                                   $ do 
 -                                        case uiOldName ui of
 -                                          Nothing      -> return ()
 -                                          Just oldName -> do exists <- isFile (mkPagePath oldName)
 -                                                             when exists
 -                                                                  $ do movePage (uiOldRevision ui) oldName name
 -                                                                       moveAttachments (uiOldRevision ui) oldName name
 -                                        exists <- isFile (mkPagePath name)
 -                                        unless exists
 -                                               $ createPage name
 -                                        updatePage name
 -                            case ret of
 -                              Left  _ -> return Conflict
 -                              Right _ -> return Created
 -           Nothing
 -               -> do fs  <- getRepositoryFS repos
 -                     rev <- getYoungestRev fs
 -                     ret <- doReposTxn
 -                            repos
 -                            rev
 -                            author
 -                            (Just "Automatic commit by Rakka for page creation")
 -                            $ do createPage name
 -                                 updatePage name
 -                     case ret of
 -                       Left  _ -> return Conflict
 -                       Right _ -> return Created
 +    = case pageUpdateInfo page of
 +        Just ui
 +            → do let oldRev = uiOldRevision ui
 +                 denied ← case uiOldName ui of
 +                            Nothing      → shouldDeny oldRev name
 +                            Just oldName → shouldDeny oldRev oldName
 +                 if denied then
 +                     pure Forbidden
 +                 else
 +                     do rev ← if oldRev ≡ 0 then
 +                                  getRepositoryFS repos ≫= getYoungestRev
 +                              else
 +                                  return oldRev
 +                        ret ← doReposTxn repos
 +                                         rev
 +                                         author
 +                                         (Just "Automatic commit by Rakka for page update")
 +                              $ do case uiOldName ui of
 +                                     Nothing      → return ()
 +                                     Just oldName → do exists ← isFile (mkPagePath oldName)
 +                                                       when exists
 +                                                           ( movePage        (uiOldRevision ui) oldName name ≫
 +                                                             moveAttachments (uiOldRevision ui) oldName name
 +                                                           )
 +                                   exists ← isFile (mkPagePath name)
 +                                   unless exists
 +                                       $ createPage name
 +                                   updatePage name
 +                        case ret of
 +                          Left  _ → return Conflict
 +                          Right _ → return Created
 +        Nothing
 +            → do fs  ← getRepositoryFS repos
 +                 rev ← getYoungestRev fs
 +                 ret ← doReposTxn repos
 +                                  rev
 +                                  author
 +                                  (Just "Automatic commit by Rakka for page creation")
 +                       $ (createPage name ≫ updatePage name)
 +                 case ret of
 +                   Left  _ → return Conflict
 +                   Right _ → return Created
      where
 -      checkDenial :: RevNum -> PageName -> IO Bool
 -      checkDenial rev name
 -          = do fs <- getRepositoryFS repos
 +      name ∷ PageName
 +      name = pageName page
 +
 +      author ∷ String
 +      author = fromMaybe "[Rakka]" userID
 +
 +      shouldDeny ∷ RevNum → PageName → IO Bool
 +      shouldDeny rev name'
 +          = do fs ← getRepositoryFS repos
                 withRevision fs rev
 -                   $ do exists <- isFile (mkPagePath name)
 +                   $ do exists ← isFile (mkPagePath name')
                          if exists then
 -                            do prop <- getNodeProp (mkPagePath name) "rakka:isLocked"
 +                            do prop ← getNodeProp (mkPagePath name') "rakka:isLocked"
                                 case prop of
                                   Just _  -> return (isNothing userID) -- 施錠されてゐるので匿名では駄目
                                   Nothing -> return False
@@@ -304,20 -293,20 +304,20 @@@
                 deleteEmptyParentDirectories oldPath
  
        createPage :: PageName -> Txn ()
 -      createPage name
 -          = do let path = mkPagePath name
 +      createPage name'
 +          = do let path = mkPagePath name'
                 createParentDirectories path
                 makeFile path
  
 -      updatePage :: PageName -> Txn ()
 -      updatePage name
 -          | isRedirect page = updatePageRedirect name
 -          | isEntity   page = updatePageEntity name
 +      updatePage ∷ PageName → Txn ()
 +      updatePage name'
 +          | isRedirect page = updatePageRedirect name'
 +          | isEntity   page = updatePageEntity   name'
            | otherwise       = fail "neither redirection nor page"
  
        updatePageRedirect :: PageName -> Txn ()
 -      updatePageRedirect name
 -          = do let path = mkPagePath name
 +      updatePageRedirect name'
 +          = do let path = mkPagePath name'
                 setNodeProp path "svn:mime-type"   (Just "application/x-rakka-redirection")
                 setNodeProp path "rakka:lang"      Nothing
                 setNodeProp path "rakka:isTheme"   Nothing
@@@ -326,24 -315,24 +326,24 @@@
                 setNodeProp path "rakka:isBinary"  Nothing
                 setNodeProp path "rakka:summary"   Nothing
                 setNodeProp path "rakka:otherLang" Nothing
 -               applyText path Nothing (encodeString (redirDest page) ++ "\n")
 +               applyText path Nothing (encodeString (T.unpack $ redirDest page) ⊕ "\n")
  
        updatePageEntity :: PageName -> Txn ()
 -      updatePageEntity name
 -          = do let path = mkPagePath name
 -               setNodeProp path "svn:mime-type"   ((Just . show . entityType) page)
 -               setNodeProp path "rakka:lang"      (entityLanguage page)
 -               setNodeProp path "rakka:isTheme"   (encodeFlag $ entityIsTheme page)
 -               setNodeProp path "rakka:isFeed"    (encodeFlag $ entityIsFeed page)
 +      updatePageEntity name'
 +          = do let path = mkPagePath name'
 +               setNodeProp path "svn:mime-type"   (Just ∘ show $ entityType page)
 +               setNodeProp path "rakka:lang"      (T.unpack ∘ CI.foldedCase <$> entityLanguage page)
 +               setNodeProp path "rakka:isTheme"   (encodeFlag $ entityIsTheme  page)
 +               setNodeProp path "rakka:isFeed"    (encodeFlag $ entityIsFeed   page)
                 setNodeProp path "rakka:isLocked"  (encodeFlag $ entityIsLocked page)
                 setNodeProp path "rakka:isBinary"  (encodeFlag $ entityIsBinary page)
 -               setNodeProp path "rakka:summary"   (fmap encodeString $ entitySummary page)
 -               setNodeProp path "rakka:otherLang" (let otherLang = entityOtherLang page
 -                                                   in
 -                                                     if M.null otherLang then
 -                                                         Nothing
 -                                                     else
 -                                                         Just (encodeString $ serializeStringPairs $ M.toList otherLang))
 +               setNodeProp path "rakka:summary"   (encodeString <$> entitySummary page)
 +               setNodeProp path "rakka:otherLang" ( if M.null (entityOtherLang page) then
 +                                                        Nothing
 +                                                    else
 +                                                        Just ∘ T.unpack ∘ serializeMap CI.foldedCase id
 +                                                        $ entityOtherLang page
 +                                                  )
                 applyTextLBS path Nothing (entityContent page)
  
        encodeFlag :: Bool -> Maybe String
@@@ -408,12 -397,12 +408,12 @@@ deleteEmptyParentDirectories pat
                         deleteEmptyParentDirectories parentPath
  
  
 -loadAttachmentInRepository :: forall a. Attachment a =>
 -                              Repository
 -                           -> PageName
 -                           -> String
 -                           -> Maybe RevNum
 -                           -> IO (Maybe a)
 +loadAttachmentInRepository ∷ ∀α. Attachment α
 +                           ⇒ Repository
 +                           → PageName
 +                           → String
 +                           → Maybe RevNum
 +                           → IO (Maybe α)
  loadAttachmentInRepository repos pName aName rev
      = do fs   <- getRepositoryFS repos
           rev' <- case rev of
@@@ -426,12 -415,12 +426,12 @@@
                      else
                        return Nothing
      where
 -      path :: FilePath
 +      path ∷ FilePath
        path = mkAttachmentPath pName aName
  
 -      loadAttachment' :: Rev a
 -      loadAttachment' = liftM (deserializeFromString . decodeString) (getFileContents path)
 -
 +      loadAttachment' ∷ Rev α
 +      loadAttachment' = (deserializeFromString ∘ decodeString)
 +                        `liftM` getFileContents path
  
  putAttachmentIntoRepository :: Attachment a =>
                                 Repository
diff --combined Rakka/SystemConfig.hs
index 029d307,c151427..d15bc9d
--- a/Rakka/SystemConfig.hs
+++ b/Rakka/SystemConfig.hs
@@@ -1,9 -1,3 +1,9 @@@
 +{-# LANGUAGE
 +    DeriveDataTypeable
 +  , OverloadedStrings
 +  , ScopedTypeVariables
 +  , UnicodeSyntax
 +  #-}
  module Rakka.SystemConfig
      ( SystemConfig
      , SysConfValue(..)
@@@ -23,37 -17,26 +23,37 @@@
      , Languages(..)
      , GlobalLock(..)
  
 -    , serializeStringPairs
 -    , deserializeStringPairs
 +    , serializeTextPairs
 +    , deserializeTextPairs
 +    , serializeMap
 +    , deserializeMap
      )
      where
 +import Control.Applicative
 +import           Codec.Binary.UTF8.String
  import           Control.Arrow.ArrowIO
 +import Control.Arrow.Unicode
  import           Control.Concurrent.STM
  import           Control.Monad
  import           Control.Monad.Trans
 +import Control.Monad.Unicode
  import qualified Data.ByteString.Char8 as C8
  import qualified Data.ByteString.Lazy  as L
 +import qualified Data.CaseInsensitive as CI
  import           Data.Dynamic
  import           Data.Map (Map)
  import qualified Data.Map as M
  import           Data.Maybe
 +import Data.Monoid.Unicode
 +import Data.Text (Text)
 +import qualified Data.Text as T
 +import qualified Data.Text.Encoding as T
  import           GHC.Conc (unsafeIOToSTM)
  import           Network.BSD
  import qualified Network.HTTP.Lucu.Config as LC
 -import           Network.HTTP.Lucu.Utils
  import           Network.HTTP.Lucu hiding (Config)
  import           Network.URI hiding (path)
 +import Prelude.Unicode
  import           Rakka.Page
  import           Rakka.Utils
  import           Subversion.FileSystem
@@@ -63,9 -46,10 +63,9 @@@ import           Subversion.FileSystem.
  import           Subversion.Repository
  import           Subversion.Types
  import           System.FilePath.Posix
 -import           System.IO.Unsafe
 +import System.IO.Unsafe
  import           System.Log.Logger
  
 -
  logger :: String
  logger = "Rakka.SystemConfig"
  
@@@ -76,11 -60,13 +76,11 @@@ data SystemConfig = SystemConfig 
      , scCache      :: !(TVar (Map FilePath Dynamic))
      }
  
 -
 -class (Typeable a, Show a, Eq a) => SysConfValue a where
 -    confPath     :: a -> FilePath
 -    serialize    :: a -> String
 -    deserialize  :: String -> Maybe a
 -    defaultValue :: SystemConfig -> a
 -
 +class (Typeable α, Show α, Eq α) ⇒ SysConfValue α where
 +    confPath     ∷ α → FilePath
 +    serialize    ∷ α → Text
 +    deserialize  ∷ Text → Maybe α
 +    defaultValue ∷ SystemConfig → α
  
  mkSystemConfig :: LC.Config -> Repository -> IO SystemConfig
  mkSystemConfig lc repos
@@@ -91,42 -77,49 +91,42 @@@
                      , scCache      = cache
                      }
  
 -getSysConf :: forall m a. (MonadIO m, SysConfValue a) => SystemConfig -> m a
 +getSysConf ∷ ∀m a. (MonadIO m, SysConfValue a) ⇒ SystemConfig → m a
  getSysConf sc
 -    = liftIO $
 -      atomically $
 -      do let path = confPath (undefined :: a)
 -
 -         cache <- readTVar (scCache sc)
 -
 +    = liftIO $ atomically $
 +      do cache ← readTVar (scCache sc)
 +         let path = confPath ((⊥) ∷ a)
           case M.lookup path cache of
 -           Just val -> return $ fromJust $ fromDynamic val
 -           Nothing  -> do val <- unsafeIOToSTM (getSysConf' sc)
 -                          writeTVar (scCache sc) (M.insert path (toDyn val) cache)
 -                          return val
 +           Just val → pure ∘ fromJust $ fromDynamic val
 +           Nothing  → do val ← unsafeIOToSTM (getSysConf' sc)
 +                         writeTVar (scCache sc) (M.insert path (toDyn val) cache)
 +                         return val
  
 -
 -getSysConf' :: forall a. SysConfValue a => SystemConfig -> IO a
 +getSysConf' ∷ ∀α. SysConfValue α ⇒ SystemConfig → IO α
  getSysConf' sc
 -    = do let path = fromConfPath $ confPath (undefined :: a)
 -
 -         fs    <- getRepositoryFS (scRepository sc)
 -         rev   <- getYoungestRev fs
 -         value <- withRevision fs rev
 -                  $ do exists <- isFile path
 -                       case exists of
 -                         True
 -                             -> do str <- getFileContentsLBS path
 -                                   return $ Just $ chomp $ decode $ L.unpack str
 -                         False
 -                             -> return Nothing
 -
 +    = do let path = fromConfPath $ confPath ((⊥) ∷ α)
 +         fs    ← getRepositoryFS (scRepository sc)
 +         rev   ← getYoungestRev fs
 +         value ← withRevision fs rev
 +                 $ do exists ← isFile path
 +                      case exists of
 +                        True
 +                            → do str ← getFileContentsLBS path
 +                                 return $ Just $ T.pack $ chomp $ decode $ L.unpack str
 +                        False
 +                            → return Nothing
           case value of
             Just str
 -               -> case deserialize str of
 -                    Just val
 -                        -> do debugM logger ("Got a config value at `" ++ path ++ "': " ++ show val)
 -                              return val
 -                    Nothing
 -                        -> fail ("Got an invalid config value at `" ++ path ++ "': " ++ str)
 +               → case deserialize str of
 +                   Just val
 +                       → debugM logger ("Got a config value at `" ⊕ path ⊕ "': " ⊕ show val) ≫
 +                         return val
 +                   Nothing
 +                       → fail ("Got an invalid config value at `" ⊕ path ⊕ "': " ⊕ show str)
             Nothing
 -               -> do let val = defaultValue sc
 -                     debugM logger ("Got no config value at `" ++ path ++ "'. Defaulting to " ++ show val)
 -                     return val
 -
 +               → do let val = defaultValue sc
 +                    debugM logger ("Got no config value at `" ⊕ path ⊕ "'. Defaulting to " ⊕ show val)
 +                    return val
  
  setSysConf :: forall m a. (MonadIO m, SysConfValue a) => SystemConfig -> String -> a -> m StatusCode
  setSysConf sc userID value
@@@ -141,41 -134,42 +141,41 @@@
  		    setSysConf' sc userID value
  
  
 -setSysConf' :: forall a. SysConfValue a => SystemConfig -> String -> a -> IO StatusCode
 +setSysConf' ∷ ∀α. SysConfValue α ⇒ SystemConfig → String → α → IO StatusCode
  setSysConf' sc userID value
 -    = do let path  = fromConfPath $ confPath (undefined :: a)
 -	     str   = L.pack $ encode $ serialize value ++ "\n"
 +    = do let path  = fromConfPath $ confPath ((⊥) ∷ α)
 +	     str   = (L.fromChunks ∘ (:[]) ∘ T.encodeUtf8 $ serialize value) ⊕ "\n"
  	     repos = scRepository sc
 -         fs  <- getRepositoryFS repos
 -	 rev <- getYoungestRev fs
 -	 ret <- doReposTxn
 -		repos
 -		rev
 -		userID
 -		(Just "Automatic commit by Rakka for systemConfig update")
 -		$ do exists <- isFile path
 -		     unless exists
 -		         $ createValueEntry path
 -		     applyTextLBS path Nothing str
 +         fs  ← getRepositoryFS repos
 +	 rev ← getYoungestRev fs
 +         ret ← doReposTxn
 +               repos
 +               rev
 +               userID
 +               (Just "Automatic commit by Rakka for systemConfig update")
 +               $ do exists ← isFile path
 +                    unless exists
 +                        $ createValueEntry path
 +                    applyTextLBS path Nothing str
  	 case ret of
 -		  Left  _ -> return Conflict
 -		  Right _ -> do debugM logger ("Set a config value at `" ++ path ++ "': " ++ show value)
 -				return Created
 +	   Left  _ → return Conflict
 +	   Right _ → do debugM logger ("Set a config value at `" ⊕ path ⊕ "': " ⊕ show value)
 +                        return Created
      where
 -    createValueEntry :: FilePath -> Txn ()
 +    createValueEntry ∷ FilePath → Txn ()
      createValueEntry path
 -	= do createParentDirectories path
 -	     makeFile path
 +        = do createParentDirectories path
 +             makeFile path
  
 -    createParentDirectories :: FilePath -> Txn ()
 +    createParentDirectories ∷ FilePath → Txn ()
      createParentDirectories path
 -	= do let parentPath = takeDirectory path
 -	     kind <- checkPath parentPath
 -	     case kind of
 -		       NoNode   -> do createParentDirectories parentPath
 -				      makeDirectory parentPath
 -		       FileNode -> fail ("createParentDirectories: already exists a file: " ++ parentPath)
 -		       DirNode  -> return ()
 -
 +        = do let parentPath = takeDirectory path
 +             kind ← checkPath parentPath
 +             case kind of
 +               NoNode   → createParentDirectories parentPath ≫
 +                          makeDirectory parentPath
 +               FileNode → fail ("createParentDirectories: already exists a file: " ⊕ parentPath)
 +               DirNode  → return ()
  
  getSysConfA :: (ArrowIO a, SysConfValue c) => SystemConfig -> a b c
  getSysConfA = arrIO0 . getSysConf
@@@ -188,76 -182,84 +188,81 @@@ setSysConfA = (arrIO .) . setSysCon
  fromConfPath :: FilePath -> FilePath
  fromConfPath = ("/config" </>)
  
 -
 -serializeStringPairs :: [(String, String)] -> String
 -serializeStringPairs = joinWith "\n" . map serializePair'
 +serializeTextPairs ∷ [(Text, Text)] → Text
 +serializeTextPairs = T.intercalate "\n" ∘ (serializePair' <$>)
      where
 -      serializePair' :: (String, String) -> String
 -      serializePair' (a, b) = a ++ " " ++ b
 +      serializePair' ∷ (Text, Text) → Text
 +      serializePair' (a, b) = a ⊕ " " ⊕ b
  
 +serializeMap ∷ (k → Text) → (v → Text) → Map k v → Text
 +serializeMap f g = serializeTextPairs ∘ ((f ⁂ g) <$>) ∘ M.toList
  
 -deserializeStringPairs :: String -> Maybe [(String, String)]
 -deserializeStringPairs = mapM deserializePair' . lines
 +deserializeTextPairs ∷ Text → Maybe [(Text, Text)]
 +deserializeTextPairs = mapM deserializePair' ∘ T.lines
      where
 -      deserializePair' :: String -> Maybe (String, String)
 -      deserializePair' s = case break (== ' ') s of
 -                             (a, ' ':b) -> Just (a, b)
 -                             _          -> Nothing
 -
 -
 +      deserializePair' ∷ Text → Maybe (Text, Text)
 +      deserializePair' s = case T.breakOn " " s of
 +                             (a, b)
 +                                 | (¬) (T.null b) → Just (a, T.tail b)
 +                             _                    → Nothing
  
 -{- config values -}
 +deserializeMap ∷ Ord k ⇒ (Text → k) → (Text → v) → Text → Maybe (Map k v)
 +deserializeMap f g = (M.fromList ∘ ((f ⁂ g) <$>) <$>) ∘ deserializeTextPairs
  
 -newtype SiteName = SiteName String deriving (Show, Typeable, Eq)
 +newtype SiteName = SiteName Text deriving (Show, Typeable, Eq)
  instance SysConfValue SiteName where
      confPath _                = "siteName"
      serialize (SiteName name) = name
      deserialize               = Just . SiteName
      defaultValue _            = SiteName "Rakka"
  
 -
  newtype BaseURI = BaseURI URI deriving (Show, Typeable, Eq)
  instance SysConfValue BaseURI where
      confPath _              = "baseURI"
 -    serialize (BaseURI uri) = uriToString id uri ""
 +    serialize (BaseURI uri) = T.pack $ uriToString id uri ""
      deserialize uri         = fmap BaseURI
 -                              $ do parsed <- parseURI uri
 -                                   when (uriPath parsed        == "" ) (fail undefined)
 -                                   when (last (uriPath parsed) /= '/') (fail undefined)
 -                                   when (uriQuery parsed       /= "" ) (fail undefined)
 -                                   when (uriFragment parsed    /= "" ) (fail undefined)
 +                              $ do parsed ← parseURI (T.unpack uri)
 +                                   when (uriPath parsed        ≡ "" ) mzero
 +                                   when (last (uriPath parsed) ≠ '/') mzero
 +                                   when (uriQuery parsed       ≠ "" ) mzero
 +                                   when (uriFragment parsed    ≠ "" ) mzero
                                     return parsed
      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 ++ 
++                  = "http://" ++ host ++
                      (if port == 80
                       then ""
                       else ':' : show port) ++ "/"
            in
              BaseURI $ fromJust $ parseURI defaultURI
  
 -
 -newtype DefaultPage = DefaultPage String deriving (Show, Typeable, Eq)
 +newtype DefaultPage = DefaultPage Text deriving (Show, Typeable, Eq)
  instance SysConfValue DefaultPage where
      confPath _                   = "defaultPage"
      serialize (DefaultPage name) = name
      deserialize                  = Just . DefaultPage
      defaultValue _               = DefaultPage "MainPage"
  
 -
 -newtype StyleSheet = StyleSheet String deriving (Show, Typeable, Eq)
 +newtype StyleSheet = StyleSheet Text deriving (Show, Typeable, Eq)
  instance SysConfValue StyleSheet where
      confPath _                  = "styleSheet"
      serialize (StyleSheet name) = name
      deserialize                 = Just . StyleSheet
      defaultValue _              = StyleSheet "StyleSheet/Default"
  
 -
  newtype Languages = Languages (Map LanguageTag LanguageName) deriving (Show, Typeable, Eq)
  instance SysConfValue Languages where
      confPath _                  = "languages"
 -    serialize (Languages langs) = serializeStringPairs (M.toList langs)
 -    deserialize                 = fmap (Languages . M.fromList) . deserializeStringPairs
 +    serialize (Languages langs) = serializeMap CI.foldedCase id langs
 +    deserialize                 = (Languages <$>) ∘ deserializeMap CI.mk id
      defaultValue _         
          = Languages $ M.fromList [ ("en", "English"  )
                                   , ("es", "Español"  )
diff --combined Rakka/TrackBack.hs
index 8b1d2cb,8b1d2cb..0000000
deleted file mode 100644,100644
--- a/Rakka/TrackBack.hs
+++ /dev/null
@@@ -1,96 -1,96 +1,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)
--
--
--{-
--  <trackbacks>
--    <trackback title="" url="" blogName="" time="">
--      excerpt...
--    </trackback>
--    ...
--  </trackbacks>
---}
--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 --combined Rakka/Utils.hs
index 3148c6b,e89fee0..717a606
--- a/Rakka/Utils.hs
+++ b/Rakka/Utils.hs
@@@ -1,7 -1,5 +1,7 @@@
  {-# LANGUAGE
      Arrows
 +  , OverloadedStrings
 +  , TypeOperators
    , UnicodeSyntax
    #-}
  module Rakka.Utils
@@@ -12,22 -10,26 +12,28 @@@
      , deleteIfEmpty
      , chomp
      , guessMIMEType
 +    , isSafeChar
      , 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.Ascii (Ascii)
 -import qualified Data.Ascii as A
++import Data.ByteString (ByteString)
+ import qualified Data.ByteString as BS
+ import qualified Data.ByteString.Char8 as C8
 -import qualified Data.ByteString.Unsafe as BS
+ import qualified Data.ByteString.Lazy as LS
++import qualified Data.ByteString.Unsafe as BS
+ import Data.Char
 -import qualified Data.Text as T
 +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"
@@@ -37,58 -39,95 +43,91 @@@ trueOrFalse ∷ Bool → Strin
  trueOrFalse True  = "true"
  trueOrFalse False = "false"
  
 -parseYesOrNo ∷ ArrowChoice a ⇒ a String Bool
 -parseYesOrNo 
 -    = proc str → do case str of
 -                       "yes" → returnA ⤙ True
 -                       "no"  → returnA ⤙ False
 -                       _     → returnA ⤙ error ("Expected yes or no: " ⧺ str)
 +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 ∷ [(T.Text, T.Text)] → Ascii
++mkQueryString ∷ [(Text, Text)] → ByteString
+ {-# INLINEABLE mkQueryString #-}
 -mkQueryString = A.unsafeFromByteString
 -                ∘ BS.intercalate (C8.singleton ';')
 -                ∘ map encodePair
++mkQueryString = BS.intercalate (C8.singleton ';') ∘ map encodePair
+     where
 -      encodePair ∷ (T.Text, T.Text) → BS.ByteString
++      encodePair ∷ (Text, Text) → ByteString
+       {-# INLINE encodePair #-}
+       encodePair (k, v)
+           = BS.intercalate (C8.singleton '=') [encodeText k, encodeText v]
+ 
 -      encodeText ∷ T.Text → BS.ByteString
++      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 ∷ BS.ByteString → BS.ByteString
++toURLEncoded ∷ ByteString → ByteString
+ {-# INLINEABLE toURLEncoded #-}
+ toURLEncoded = C8.concatMap go
      where
-       encode :: String -> String
-       encode = escapeURIString isSafeChar . UTF8.encodeString
 -      go ∷ Char → BS.ByteString
++      go ∷ Char → ByteString
+       {-# INLINE go #-}
+       go c | c ≡ ' '        = C8.singleton '+'
+            | isReserved   c = urlEncode c
+            | isUnreserved c = C8.singleton c
+            | otherwise      = urlEncode c
+ 
 -      urlEncode ∷ Char → BS.ByteString
++      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 --combined Rakka/Wiki/Interpreter/PageList.hs
index d94f67e,2fe9d30..4faee0f
--- a/Rakka/Wiki/Interpreter/PageList.hs
+++ b/Rakka/Wiki/Interpreter/PageList.hs
@@@ -1,21 -1,13 +1,22 @@@
 +{-# LANGUAGE
 +    OverloadedStrings
 +  , RecordWildCards
 +  , UnicodeSyntax
 +  #-}
  module Rakka.Wiki.Interpreter.PageList
      ( interpreters
      )
      where
 -
 -import           Control.Monad
 -import           Data.Maybe
 +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
  import           Data.Time
  import qualified Data.Time.RFC1123 as RFC1123
  import           Network.URI
 +import Prelude.Unicode
  import           Rakka.Storage
  import           Rakka.SystemConfig
  import           Rakka.Utils
@@@ -39,9 -31,9 +40,9 @@@ recentUpdatesURLInter
            = \ 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")
        }
@@@ -59,26 -51,29 +60,26 @@@
  --     ...
  --   </ul>
  -- </div>
 -recentUpdatesInterp :: Interpreter
 +recentUpdatesInterp ∷ Interpreter
  recentUpdatesInterp 
      = BlockCommandInterpreter {
          bciName      = "recentUpdates"
        , bciInterpret
 -          = \ ctx (BlockCommand _ args _)
 -          -> do let items          = fromMaybe 10   $ fmap read         $ lookup "items" args
 -                    showSummary    = fromMaybe True $ fmap parseYesOrNo $ lookup "showSummary" args
 -                    onlyEntity     = fromMaybe True $ fmap parseYesOrNo $ lookup "onlyEntity" args
 -                    onlySummarized = fromMaybe True $ fmap parseYesOrNo $ lookup "onlySummarized" args
 -                    sto            = ctxStorage ctx
 -                
 -                cond <- newCondition
 -                when onlyEntity
 -                    $ addAttrCond cond "@type STRNE application/x-rakka-redirection"
 -                when onlySummarized
 -                    $ addAttrCond cond "rakka:summary STRNE" -- summary が空でない
 -                setPhrase cond "[UVSET]"
 -                setOrder  cond "@mdate NUMD"
 -                setMax    cond items
 -
 -                result <- searchPages sto cond
 -                mkPageList showSummary (srPages result)
 +          = \(InterpreterContext {..}) (BlockCommand _ args _) →
 +            do let items          = fromMaybe 10   $ read ∘ T.unpack <$> lookup "items" args
 +                   showSummary    = fromMaybe True $ parseYesOrNo    <$> lookup "showSummary" args
 +                   onlyEntity     = fromMaybe True $ parseYesOrNo    <$> lookup "onlyEntity" args
 +                   onlySummarized = fromMaybe True $ parseYesOrNo    <$> lookup "onlySummarized" args
 +               cond ← newCondition
 +               when onlyEntity
 +                   $ addAttrCond cond "@type STRNE application/x-rakka-redirection"
 +               when onlySummarized
 +                   $ addAttrCond cond "rakka:summary STRNE" -- summary が空でない
 +               setPhrase cond "[UVSET]"
 +               setOrder  cond "@mdate NUMD"
 +               setMax    cond items
 +               result ← searchPages ctxStorage cond
 +               mkPageList showSummary (srPages result)
        }
      where
        mkPageList :: Bool -> [HitPage] -> IO BlockElement
@@@ -87,21 -82,21 +88,21 @@@
                 return (Div [("class", "recentUpdates")]
                         [ Block (List Bullet items) ])
  
 -      mkListItem :: Bool -> HitPage -> IO ListItem
 +      mkListItem ∷ Bool → HitPage → IO ListItem
        mkListItem showSummary page
 -          = do lastMod <- utcToLocalZonedTime (hpLastMod page)
 +          = do lastMod ← utcToLocalZonedTime (hpLastMod page)
                 return ( [ Inline PageLink {
                                         linkPage     = Just (hpPageName page)
                                       , linkFragment = Nothing
                                       , linkText     = Nothing
                                       }
                          , Block ( Div [("class", "date")]
 -                                  [Inline (Text (RFC1123.format lastMod))]
 +                                  [Inline (Text (T.pack $ RFC1123.format lastMod))]
                                  )
                          ]
 -                        ++
 +                        ⊕
                          case (showSummary, hpSummary page) of
                            (True, Just s)
 -                              -> [ Block (Paragraph [Text s]) ]
 -                          _   -> []
 +                              → [ Block (Paragraph [Text s]) ]
 +                          _   → []
                        )
diff --combined Rakka/Wiki/Interpreter/Trackback.hs
index b5e5cf0,b5e5cf0..0000000
deleted file mode 100644,100644
--- a/Rakka/Wiki/Interpreter/Trackback.hs
+++ /dev/null
@@@ -1,75 -1,75 +1,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]
diff --combined Rakka/Wiki/Parser.hs
index 3b3d7c4,aae3a78..e7ca8eb
--- a/Rakka/Wiki/Parser.hs
+++ b/Rakka/Wiki/Parser.hs
@@@ -1,30 -1,18 +1,30 @@@
 +{-# LANGUAGE
 +    OverloadedStrings
 +  , RankNTypes
 +  , UnicodeSyntax
 +  , ViewPatterns
 +  #-}
  module Rakka.Wiki.Parser
      ( CommandTypeOf
      , wikiPage
      )
      where
 -
 -import           Control.Monad
 -import           Data.Maybe
 -import           Network.URI hiding (fragment)
 -import           Rakka.Wiki
 -import           Text.ParserCombinators.Parsec hiding (label)
 -
 -
 -type CommandTypeOf = String -> Maybe CommandType
 -
 +-- FIXME: use attoparsec
 +import Control.Applicative hiding ((<|>), many)
 +import Control.Applicative.Unicode
 +import Control.Monad
 +import Data.CaseInsensitive (CI)
 +import qualified Data.CaseInsensitive as CI
 +import Data.Maybe
 +import Data.Monoid.Unicode ((⊕))
 +import Data.Text (Text)
 +import qualified Data.Text as T
 +import Network.URI hiding (fragment)
 +import Prelude.Unicode
 +import Rakka.Wiki
 +import Text.ParserCombinators.Parsec hiding (label)
 +
 +type CommandTypeOf = Alternative f ⇒ Text → f CommandType
  
  wikiPage :: CommandTypeOf -> Parser WikiPage
  wikiPage cmdTypeOf
@@@ -53,25 -41,26 +53,25 @@@ blockElement cmdTypeO
                                   , blockCmd cmdTypeOf
                                   ]
  
 -
 -heading :: Parser BlockElement
 +heading ∷ Parser BlockElement
  heading = foldr (<|>) pzero (map heading' [1..5])
            <?>
            "heading"
      where
 -      heading' :: Int -> Parser BlockElement
 -      heading' n = do try $ do _ <- count n (char '=')
 -                               notFollowedBy (char '=')
 +      heading' ∷ Int → Parser BlockElement
 +      heading' n = do try ( void (count n (char '=')) *>
 +                            notFollowedBy (char '=')
 +                          )
                        ws
 -                      x  <- notFollowedBy (char '=') >> anyChar
 -                      xs <- manyTill anyChar (try $ ws >> ( count n (char '=')
 -                                                            <?>
 -                                                            ("trailing " ++ replicate n '=')
 -                                                          )
 -                                             )
 +                      x  ← notFollowedBy (char '=') *> anyChar
 +                      xs ← manyTill anyChar (try $ ws *> ( count n (char '=')
 +                                                           <?>
 +                                                           ("trailing " ++ replicate n '=')
 +                                                         )
 +                                            )
                        ws
                        eol
 -                      return (Heading n (x:xs))
 -
 +                      pure ∘ Heading n $ T.pack (x:xs)
  
  horizontalLine :: Parser BlockElement
  horizontalLine = try ( do _ <- count 4 (char '-')
@@@ -162,15 -151,19 +162,15 @@@ definitionList cmdTypeOf = liftM Defini
                      "description of term"
  
  
 -verbatim :: Parser BlockElement
 -verbatim = do _ <- try (string "<!verbatim[")
 -              _ <- many (oneOf " \t\n")
 -              x <- verbatim'
 -              return (Preformatted [Text x])
 +verbatim ∷ Parser BlockElement
 +verbatim = try (string "<!verbatim[") *>
 +           many (oneOf " \t\n")       *>
 +           (Preformatted ∘ (:[]) ∘ Text ∘ T.pack <$> verbatim')
      where
        verbatim' :: Parser String
 -      verbatim' = do _ <- try (many (oneOf " \t\n") >> string "]>")
 -                     return []
 +      verbatim' = try (many (oneOf " \t\n") *> string "]>") *> pure []
                    <|>
 -                  do x  <- anyChar
 -                     xs <- verbatim'
 -                     return (x:xs)
 +                  ((:) <$> anyChar ⊛ verbatim')
  
  
  leadingSpaced :: CommandTypeOf -> Parser BlockElement
@@@ -211,15 -204,11 +211,11 @@@ paragraph cmdTypeOf = liftM Paragraph p
                                       ys <- (paragraph' <|> return [])
                                       return (Text "\n" : ys)
                                    -- \n があり、その次に \n または
-                                   -- blockSymbols があれば、fail して
-                                   -- 最初の newline を讀んだ所まで卷き
-                                   -- 戻す。
- 
-                                   -- FIXME: 本當にそのやうな動作になつ
-                                   -- てゐるか？偶然動いてゐるだけではな
-                                   -- いか？確かにこの實裝でユニットテス
-                                   -- トは通るのだが、私の理解を越えてし
-                                   -- まったやうだ。
+                                   -- blockSymbols があれば、fail して最
+                                   -- 初の newline を讀んだ所まで卷き戻
+                                   -- す。oneOf が一文字消費しているので、
+                                   -- <|> は右辺を適用せずに try まで戻
+                                   -- る。
                                  )
                              <|>
                              paragraph'
@@@ -242,8 -231,10 +238,8 @@@ blockCmd cmdTypeO
                                         , bCmdAttributes = tagAttrs
                                         , bCmdContents   = xs
                                         }
 -
                    Just InlineCommandType
                        -> pzero
 -
                    _   -> return $ undefinedCmdErr tagName
        )
        <|>
@@@ -255,30 -246,35 +251,30 @@@
                                         , bCmdAttributes = tagAttrs
                                         , bCmdContents   = []
                                         }
 -
                    Just InlineCommandType
                        -> pzero
 -
                    _   -> return $ undefinedCmdErr tagName
        )
        <?>
        "block command"
      where
 -      contents :: Parser [BlockElement]
 -      contents = do x  <- blockElement cmdTypeOf
 -                    xs <- contents
 -                    return (x:xs)
 +      contents ∷ Parser [BlockElement]
 +      contents = ((:) <$> blockElement cmdTypeOf ⊛ contents)
                   <|>
 -                 (newline >> contents)
 +                 (newline *> contents)
                   <|>
 -                 (comment >> contents)
 +                 (comment *> contents)
                   <|>
 -                 return []
 +                 pure []
  
 -      undefinedCmdErr :: String -> BlockElement
 +      undefinedCmdErr ∷ Text → BlockElement
        undefinedCmdErr name
            = Div [("class", "error")]
 -            [ Block (Paragraph [Text ("The command `" ++ name ++ "' is not defined. " ++
 +            [ Block (Paragraph [Text ("The command `" ⊕ name ⊕ "' is not defined. " ⊕
                                        "Make sure you haven't mistyped.")
                                 ])
              ]
  
 -
  inlineElement :: CommandTypeOf -> Parser InlineElement
  inlineElement cmdTypeOf
      = try $ do skipMany comment
@@@ -291,24 -287,31 +287,24 @@@
                                   , inlineCmd cmdTypeOf
                                   ]
  
 -
 -nowiki :: Parser InlineElement
 -nowiki = liftM Text (try (string "<!nowiki[") >> nowiki')
 +nowiki ∷ Parser InlineElement
 +nowiki = Text ∘ T.pack <$> (try (string "<!nowiki[") *> nowiki')
      where
 -      nowiki' :: Parser String
 -      nowiki' = do _ <- try (string "]>")
 -                   return []
 +      nowiki' ∷ Parser String
 +      nowiki' = (try (string "]>") *> pure [])
                  <|>
 -                do x  <- anyChar
 -                   xs <- nowiki'
 -                   return (x:xs)
 +                ((:) <$> anyChar ⊛ nowiki')
  
 -
 -text :: Parser InlineElement
 -text = liftM (Text . (':' :)) ( char ':'
 -                                >>
 -                                many (noneOf ('\n':inlineSymbols))
 -                              )
 +text ∷ Parser InlineElement
 +text = (Text ∘ T.pack ∘ (':' :) <$> ( char ':' *>
 +                                      many (noneOf ('\n':inlineSymbols))
 +                                    ))
         -- 定義リストとの關係上、コロンは先頭にしか來られない。
         <|>
 -       liftM Text (many1 (noneOf ('\n':inlineSymbols)))
 +       (Text ∘ T.pack <$> (many1 (noneOf ('\n':inlineSymbols))))
         <?>
         "text"
  
 -
  apostrophes :: CommandTypeOf -> Parser InlineElement
  apostrophes cmdTypeOf = foldr (<|>) pzero (map try [apos1, apos2, apos3, apos4, apos5])
      where
@@@ -335,57 -338,63 +331,57 @@@
        apos n = count n (char '\'') >> notFollowedBy (char '\'')
  
  
 -objLink :: Parser InlineElement
 -objLink = do _     <- try (string "[[[")
 -             page  <- many1 (noneOf "|]")
 -             label <- option Nothing
 -                      (liftM Just (char '|' >> many1 (satisfy (/= ']'))))
 -             _     <- string "]]]"
 -             return $ ObjectLink page label
 +objLink ∷ Parser InlineElement
 +objLink = do void $ try (string "[[[")
 +             page  ← many1 (noneOf "|]")
 +             label ← option Nothing $
 +                     Just <$> (char '|' *> many1 (satisfy (≠ ']')))
 +             void $ string "]]]"
 +             pure $ ObjectLink (T.pack page) (T.pack <$> label)
            <?>
            "object link"
  
 -
 -pageLink :: Parser InlineElement
 -pageLink = do _        <- try (string "[[")
 -              page     <- option Nothing 
 -                          (liftM Just (many1 (noneOf "#|]")))
 -              fragment <- option Nothing
 -                          (liftM Just (char '#' >> many1 (noneOf "|]")))
 -              label    <- option Nothing
 -                          (liftM Just (char '|' >> many1 (satisfy (/= ']'))))
 -
 -              case (page, fragment) of
 -                (Nothing, Nothing) -> pzero
 -                (_, _)             -> return ()
 -
 -              _ <- string "]]"
 -              return $ PageLink page fragment label
 +pageLink ∷ Parser InlineElement
 +pageLink = do void $ try (string "[[")
 +              page     ← option Nothing $
 +                         Just <$> many1 (noneOf "#|]")
 +              fragment ← option Nothing $
 +                         Just <$> (char '#' *> many1 (noneOf "|]"))
 +              label    ← option Nothing $
 +                         Just <$> (char '|' *> many1 (satisfy (≠ ']')))
 +              when (isNothing page ∧ isNothing fragment) (∅)
 +              void $ string "]]"
 +              pure $ PageLink (T.pack <$> page    )
 +                              (T.pack <$> fragment)
 +                              (T.pack <$> label   )
             <?>
             "page link"
  
 -
 -extLink :: Parser InlineElement
 -extLink = do _      <- char '['
 -             uriStr <- many1 (noneOf " \t]")
 -             _      <- skipMany (oneOf " \t")
 -             label  <- option Nothing
 -                       (liftM Just (many1 (noneOf "]")))
 -             
 +extLink ∷ Parser InlineElement
 +extLink = do void $ char '['
 +             uriStr ← many1 (noneOf " \t]")
 +             void $ skipMany (oneOf " \t")
 +             label ← option Nothing $
 +                     Just <$> many1 (noneOf "]")
               case parseURI uriStr of
 -               Just uri -> char ']' >> return (ExternalLink uri label)
 -               Nothing  -> pzero <?> "absolute URI"
 +               Just uri → char ']' *> pure (ExternalLink uri (T.pack <$> label))
 +               Nothing  → pzero <?> "absolute URI"
            <?>
            "external link"
  
 -
 -inlineCmd :: CommandTypeOf -> Parser InlineElement
 +inlineCmd ∷ CommandTypeOf → Parser InlineElement
  inlineCmd cmdTypeOf
 -    = (try $ do (tagName, tagAttrs) <- openTag
 +    = (try $ do (tagName, tagAttrs) ← openTag
                  case cmdTypeOf tagName of
                    Just InlineCommandType
 -                      -> do xs <- contents
 -                            closeTag tagName
 -                            return $ InlineCmd InlineCommand {
 +                      → do xs ← contents
 +                           closeTag tagName
 +                           pure $ InlineCmd InlineCommand {
                                           iCmdName       = tagName
                                         , iCmdAttributes = tagAttrs
                                         , iCmdContents   = xs
                                         }
 -                  _   -> pzero
 +                  _   → pzero
        )
        <|>
        (try $ do (tagName, tagAttrs) <- emptyTag
@@@ -401,58 -410,62 +397,58 @@@
        <?>
        "inline command"
      where
 -      contents :: Parser [InlineElement]
 -      contents = do x  <- inlineElement cmdTypeOf
 -                    xs <- contents
 -                    return (x:xs)
 +      contents ∷ Parser [InlineElement]
 +      contents = ((:) <$> inlineElement cmdTypeOf ⊛ contents)
                   <|>
 -                 (comment >> contents)
 +                 (comment *> contents)
                   <|>
 -                 liftM (Text "\n" :) (newline >> contents)
 +                 ((Text "\n" :) <$> (newline *> contents))
                   <|>
 -                 return []
 -
 -
 -openTag :: Parser (String, [Attribute])
 -openTag = try $ do _     <- char '<'
 -                   _     <- many space
 -                   name  <- many1 letter
 -                   _     <- many space
 -                   attrs <- many $ do attr <- tagAttr
 -                                      _    <- many space
 -                                      return attr
 -                   _     <- char '>'
 -                   return (name, attrs)
 -
 -
 -emptyTag :: Parser (String, [Attribute])
 -emptyTag = try $ do _     <- char '<'
 -                    _     <- many space
 -                    name  <- many1 letter
 -                    _     <- many space
 -                    attrs <- many $ do attr <- tagAttr
 -                                       _    <- many space
 -                                       return attr
 -                    _     <- 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 '>'
 -                         return ()
 -
 -
 -tagAttr :: Parser (String, String)
 -tagAttr = do name  <- many1 letter
 -             _     <- char '='
 -             _     <- char '"'
 -             value <- many (satisfy (/= '"'))
 -             _     <- char '"'
 -             return (name, value)
 +                 pure []
 +
 +openTag ∷ Parser (Text, [Attribute])
 +openTag = try $ do void $ char '<'
 +                   void $ many space
 +                   name ← many1 letter
 +                   void $ many space
 +                   attrs ← many $ do attr ← tagAttr
 +                                     void $ many space
 +                                     pure attr
 +                   void $ char '>'
 +                   return (T.pack name, attrs)
 +
 +emptyTag ∷ Parser (Text, [Attribute])
 +emptyTag = try $ do void $ char '<'
 +                    void $ many space
 +                    name ← many1 letter
 +                    void $ many space
 +                    attrs ← many $ do attr ← tagAttr
 +                                      void $ many space
 +                                      pure attr
 +                    void $ char '/'
 +                    void $ many space
 +                    void $ char '>'
 +                    return (T.pack name, attrs)
 +
 +closeTag ∷ Text → Parser ()
 +closeTag (T.unpack → name)
 +    = try ( char '<'    *>
 +            many space  *>
 +            char '/'    *>
 +            many space  *>
 +            string name *>
 +            many space  *>
 +            char '>'    *>
 +            pure ()
 +          )
 +
 +tagAttr ∷ Parser (CI Text, Text)
 +tagAttr = do name ← many1 letter
 +             void $ char '='
 +             void $ char '"'
 +             value ← many (satisfy (≠ '"'))
 +             void $ char '"'
 +             return (CI.mk $ T.pack name, T.pack value)
  
  
  comment :: Parser ()
diff --combined defaultPages/StyleSheet/CieloNegro.xml
index 6e41dda,6e41dda..ec8152f
--- a/defaultPages/StyleSheet/CieloNegro.xml
+++ b/defaultPages/StyleSheet/CieloNegro.xml
@@@ -422,8 -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 --combined defaultPages/StyleSheet/Default.xml
index 499bf03,499bf03..49c3e6e
--- a/defaultPages/StyleSheet/Default.xml
+++ b/defaultPages/StyleSheet/Default.xml
@@@ -392,8 -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 -422,7 +421,7 @@@
      -moz-border-radius: 10px;
  }
  
--.sideBar .recentUpdates li, .sideBar .trackbacks li {
++.sideBar .recentUpdates li {
      background-color: #e0e0e0;
  }