From: PHO Date: Fri, 29 Jul 2011 17:24:53 +0000 (+0900) Subject: Still working on Rakka.Utils... X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=bea735c;p=Rakka.git Still working on Rakka.Utils... Ditz-issue: 1c6bfe78f0f9ebd241b8650eb62939dc932cd6f0 --- diff --git a/Main.hs b/Main.hs index 866fe5d..8ea4e99 100644 --- a/Main.hs +++ b/Main.hs @@ -5,7 +5,6 @@ import Data.List import Data.Maybe import Network.Socket import Network.HTTP.Lucu -import OpenSSL import Rakka.Environment import Rakka.Resource.CheckAuth import Rakka.Resource.DumpRepos @@ -16,7 +15,6 @@ import Rakka.Resource.Object import Rakka.Resource.Render import Rakka.Resource.Search import Rakka.Resource.SystemConfig --- import Rakka.Resource.TrackBack import Rakka.Resource.Users import Rakka.Storage import Subversion diff --git a/Rakka.cabal b/Rakka.cabal index 571eba4..fffa6f8 100644 --- a/Rakka.cabal +++ b/Rakka.cabal @@ -65,14 +65,13 @@ Flag build-test-suite Executable rakka Build-Depends: HsHyperEstraier == 0.4.*, - HsOpenSSL == 0.10.*, HsSVN == 0.4.*, Lucu == 0.7.*, + ascii == 0.0.*, base == 4.3.*, base-unicode-symbols == 0.2.*, bytestring == 0.9.*, containers == 0.4.*, - dataenc == 0.14.*, directory == 1.1.*, filemanip == 0.3.*, filepath == 1.2.*, diff --git a/Rakka/Authorization.hs b/Rakka/Authorization.hs index d4da7db..a7d8c60 100644 --- a/Rakka/Authorization.hs +++ b/Rakka/Authorization.hs @@ -14,8 +14,6 @@ import qualified Data.ByteString as B import Data.Map (Map) import qualified Data.Map as M hiding (Map) import Data.Maybe -import OpenSSL.EVP.Base64 -import OpenSSL.EVP.Digest import Rakka.SystemConfig import System.Directory import System.FilePath diff --git a/Rakka/Page.hs b/Rakka/Page.hs index e396c1b..24f037b 100644 --- a/Rakka/Page.hs +++ b/Rakka/Page.hs @@ -1,3 +1,8 @@ +-- -*- coding: utf-8 -*- +{-# LANGUAGE + Arrows + , UnicodeSyntax + #-} module Rakka.Page ( PageName , Page(..) @@ -27,27 +32,31 @@ module Rakka.Page , parseXmlizedPage ) where +import Control.Arrow +import qualified Data.Ascii as Ascii +import qualified Data.Text as T 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.Char +import Data.Map (Map) import qualified Data.Map as M -import Data.Time +import Data.Time import qualified Data.Time.W3C as W3C -import Network.HTTP.Lucu hiding (redirect) -import Network.URI hiding (fragment) -import OpenSSL.EVP.Base64 -import Rakka.Utils -import Subversion.Types -import System.FilePath.Posix -import Text.XML.HXT.XPath +import Network.HTTP.Lucu hiding (redirect) +import Network.URI hiding (fragment) +import Rakka.Utils +import Subversion.Types +import System.FilePath.Posix +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 PageName = String - -type LanguageTag = String -- See RFC 3066: http://www.ietf.org/rfc/rfc3066.txt -type LanguageName = String -- i.e. "日本語" +type LanguageTag = Ascii -- See RFC 3066: http://www.ietf.org/rfc/rfc3066.txt +type LanguageName = T.Text -- i.e. "日本語" data Page @@ -363,15 +372,10 @@ parseEntity , entityContent = content , entityUpdateInfo = updateInfo } - where - dropWhitespace :: String -> String - dropWhitespace [] = [] - dropWhitespace (x:xs) - | x == ' ' || x == '\t' || x == '\n' - = dropWhitespace xs - | otherwise - = x : dropWhitespace xs +dropWhitespace :: String -> String +{-# INLINE dropWhitespace #-} +dropWhitespace = filter ((¬) ∘ isSpace) parseUpdateInfo :: (ArrowXml a, ArrowChoice a) => a XmlTree UpdateInfo parseUpdateInfo @@ -383,5 +387,3 @@ parseUpdateInfo uiOldRevision = oldRev , uiOldName = oldName } - - diff --git a/Rakka/Resource/Render.hs b/Rakka/Resource/Render.hs index 8202cf6..d358cd8 100644 --- a/Rakka/Resource/Render.hs +++ b/Rakka/Resource/Render.hs @@ -8,7 +8,6 @@ import Control.Arrow.ArrowList import Control.Monad.Trans import qualified Data.ByteString.Lazy as Lazy import Network.HTTP.Lucu -import OpenSSL.EVP.Base64 import Rakka.Environment import Rakka.Page import Rakka.Utils diff --git a/Rakka/Utils.hs b/Rakka/Utils.hs index 7673eb5..051685c 100644 --- a/Rakka/Utils.hs +++ b/Rakka/Utils.hs @@ -14,14 +14,17 @@ module Rakka.Utils , mkQueryString ) where -import qualified Codec.Binary.Url as Url +import qualified Blaze.ByteString.Builder as BBB import Control.Arrow import Control.Arrow.ArrowList +import Data.Ascii (Ascii) +import qualified Data.Ascii as A import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BS import qualified Data.ByteString.Lazy as LS -import Data.List +import Data.Monoid.Unicode import qualified Data.Text as T +import qualified Data.Text.Lazy as LT import Data.Text.Encoding import Magic import Network.HTTP.Lucu @@ -84,15 +87,23 @@ isSafeChar c | isUnreserved c = True | otherwise = False -mkQueryString ∷ [(T.Text, T.Text)] → String -{-# INLINEABLE mkQueryString #-} -mkQueryString = intercalate ";" ∘ map pairToStr +mkQueryString ∷ [(T.Text, T.Text)] → Ascii +{-# INLINE mkQueryString #-} +mkQueryString = A.unsafeFromByteString + ∘ BBB.toByteString + ∘ flip mkBBB (∅) where - pairToStr ∷ (T.Text, T.Text) → String - {-# INLINE pairToStr #-} - pairToStr (k, v) - = encode k ⧺ ('=':encode v) + mkBBB ∷ [(T.Text, T.Text)] → BBB.Builder → BBB.Builder + {-# INLINEABLE mkBBB #-} + mkBBB [] acc = acc + mkBBB (kv:[]) acc = acc ⊕ pair kv + mkBBB (kv:xs) acc = mkBBB xs (acc ⊕ pair kv ⊕ semicolon) - encode ∷ T.Text → String - {-# INLINE encode #-} - encode = Url.encode ∘ BS.unpack ∘ encodeUtf8 + pair ∷ (T.Text, T.Text) → BBB.Builder + {-# INLINE pair #-} + pair (k, v) + = encodeText k ⊕ equal ⊕ encodeText v + + encodeText ∷ T.Text → BBB.Builder + {-# INLINE encodeText #-} + encodeText = BBB.fromByteString ∘ URI.encode ∘ encodeUtf8 diff --git a/Rakka/Wiki/Engine.hs b/Rakka/Wiki/Engine.hs index dae6471..e4f0e56 100644 --- a/Rakka/Wiki/Engine.hs +++ b/Rakka/Wiki/Engine.hs @@ -14,7 +14,6 @@ import qualified Data.Map as M import Data.Maybe import Network.HTTP.Lucu import Network.URI -import OpenSSL.EVP.Base64 import Rakka.Page import Rakka.Storage import Rakka.SystemConfig