From: PHO Date: Mon, 19 Dec 2011 09:57:20 +0000 (+0900) Subject: Code clean-up using convertible-text. X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=6680828;p=Lucu.git Code clean-up using convertible-text. Ditz-issue: 0a2a377be55430e655ab42fdc4902fa56a058b26 --- diff --git a/Network/HTTP/Lucu/DefaultPage.hs b/Network/HTTP/Lucu/DefaultPage.hs index d952917..c5ae6f5 100644 --- a/Network/HTTP/Lucu/DefaultPage.hs +++ b/Network/HTTP/Lucu/DefaultPage.hs @@ -13,8 +13,8 @@ module Network.HTTP.Lucu.DefaultPage where import Blaze.ByteString.Builder (Builder) import Data.Ascii (Ascii) -import qualified Data.Ascii as A import qualified Data.CaseInsensitive as CI +import Data.Convertible.Base import Data.Convertible.Utils import Data.Maybe import Data.Monoid.Unicode @@ -52,7 +52,7 @@ defaultPageWithMessage (Config {..}) sc msg body $ do h1 status p msg hr - address $ do toHtml $ A.toText cnfServerSoftware + address $ do toHtml (cs cnfServerSoftware ∷ Text) unsafeByteString " at " toHtml $ CI.original cnfServerHost where @@ -128,7 +128,7 @@ defaultMessage req res@(Response {..}) path = toHtml ∘ uriPath ∘ reqURI $ fromJust req loc ∷ Text - loc = A.toText ∘ fromJust $ getHeader "Location" res + loc = cs ∘ fromJust $ getHeader "Location" res hr ∷ Html {-# INLINE hr #-} diff --git a/Network/HTTP/Lucu/Preprocess.hs b/Network/HTTP/Lucu/Preprocess.hs index 1284f2b..7704727 100644 --- a/Network/HTTP/Lucu/Preprocess.hs +++ b/Network/HTTP/Lucu/Preprocess.hs @@ -18,6 +18,7 @@ import qualified Data.Ascii as A import qualified Data.ByteString.Char8 as C8 import Data.CaseInsensitive (CI) import qualified Data.CaseInsensitive as CI +import Data.Convertible.Base import Data.Maybe import Data.Text (Text) import qualified Data.Text as T @@ -137,7 +138,7 @@ examineAuthority localHost localPort parseHost ∷ Ascii → (CI Text, Ascii) parseHost hp - = let (h, p) = C8.break (≡ ':') $ A.toByteString hp + = let (h, p) = C8.break (≡ ':') $ cs hp -- FIXME: should decode punycode here. hText = CI.mk $ T.decodeUtf8 h pAscii = A.unsafeFromByteString p @@ -151,7 +152,7 @@ updateAuthority host port req uriAuthority = Just URIAuth { uriUserInfo = "" , uriRegName = T.unpack $ CI.original host - , uriPort = A.toString port + , uriPort = cs port } } in @@ -179,7 +180,7 @@ examineHeaders | otherwise → setStatus NotImplemented - case A.toByteString <$> getHeader "Content-Length" req of + case cs <$> getHeader "Content-Length" req of Nothing → return () Just value → case C8.readInt value of Just (len, garbage) diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs index a970b46..852860b 100644 --- a/Network/HTTP/Lucu/Resource.hs +++ b/Network/HTTP/Lucu/Resource.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP , BangPatterns + , FlexibleContexts , GeneralizedNewtypeDeriving , DoAndIfThenElse , OverloadedStrings @@ -147,8 +148,7 @@ import Control.Arrow import Control.Monad import Control.Monad.IO.Class import Control.Monad.Unicode -import Data.Ascii (Ascii, CIAscii) -import qualified Data.Ascii as A +import Data.Ascii (Ascii, CIAscii, AsciiBuilder) import Data.Attempt import qualified Data.Attoparsec.Char8 as P import Data.ByteString (ByteString) @@ -639,10 +639,10 @@ setContentType = setHeader "Content-Type" ∘ cs -- @uri@. You usually don't need to call this function directly. setLocation ∷ URI → Rsrc () setLocation uri - = case A.fromChars uriStr of - Just a → setHeader "Location" a - Nothing → abort $ mkAbortion' InternalServerError - $ "Malformed URI: " ⊕ T.pack uriStr + = case ca uriStr of + Success a → setHeader "Location" a + Failure e → abort $ mkAbortion' InternalServerError + $ cs (show e) where uriStr = uriToString id uri "" @@ -657,12 +657,13 @@ setContentEncoding codings _ → abort $ mkAbortion' InternalServerError "setContentEncoding: Unknown HTTP version" setHeader "Content-Encoding" - $ A.fromAsciiBuilder + $ cs $ mconcat - $ intersperse (A.toAsciiBuilder ", ") + $ intersperse (cs (", " ∷ Ascii)) $ map tr codings where - toAB = A.toAsciiBuilder ∘ A.fromCIAscii + toAB ∷ ConvertSuccess α AsciiBuilder ⇒ α → AsciiBuilder + toAB = cs -- |@'setWWWAuthenticate' challenge@ declares the response header -- \"WWW-Authenticate\" as @challenge@. diff --git a/Network/HTTP/Lucu/Resource/Internal.hs b/Network/HTTP/Lucu/Resource/Internal.hs index e5c38e7..9feca7e 100644 --- a/Network/HTTP/Lucu/Resource/Internal.hs +++ b/Network/HTTP/Lucu/Resource/Internal.hs @@ -42,11 +42,11 @@ import Control.Monad.Fix import Control.Monad.IO.Class import Control.Monad.Reader (ReaderT, runReaderT, ask) import Control.Monad.Unicode -import Data.Ascii (Ascii, CIAscii) -import qualified Data.Ascii as A +import Data.Ascii (Ascii, CIAscii, AsciiBuilder) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.Collections +import Data.Convertible.Base import Data.List (intersperse, nub) import Data.Maybe import Data.Monoid @@ -180,10 +180,10 @@ spawnRsrc (Resource {..}) ni@(NI {..}) notAllowed ∷ Rsrc () notAllowed = do setStatus MethodNotAllowed setHeader "Allow" - $ A.fromAsciiBuilder + $ cs $ mconcat - $ intersperse (A.toAsciiBuilder ", ") - $ map A.toAsciiBuilder allowedMethods + $ intersperse (cs (", " ∷ Ascii) ∷ AsciiBuilder) + $ map cs allowedMethods allowedMethods ∷ [Ascii] allowedMethods = nub $ concat [ methods resGet ["GET"] diff --git a/Network/HTTP/Lucu/StatusCode.hs b/Network/HTTP/Lucu/StatusCode.hs index 2dd3863..8f3e225 100644 --- a/Network/HTTP/Lucu/StatusCode.hs +++ b/Network/HTTP/Lucu/StatusCode.hs @@ -1,5 +1,6 @@ {-# LANGUAGE - QuasiQuotes + OverloadedStrings + , QuasiQuotes #-} -- |Definition of HTTP status code. -- 'Network.HTTP.Lucu.Resource.setStatus' accepts these named status diff --git a/Network/HTTP/Lucu/StatusCode/Internal.hs b/Network/HTTP/Lucu/StatusCode/Internal.hs index 1d9117c..2121037 100644 --- a/Network/HTTP/Lucu/StatusCode/Internal.hs +++ b/Network/HTTP/Lucu/StatusCode/Internal.hs @@ -19,8 +19,8 @@ module Network.HTTP.Lucu.StatusCode.Internal import Control.Applicative import Data.Ascii (Ascii, AsciiBuilder) import qualified Data.Ascii as A -import Data.Attoparsec.Char8 as P -import Data.Attoparsec.Lazy as LP +import Data.Attoparsec.Char8 +import qualified Data.Attoparsec.Lazy as LP import qualified Data.ByteString.Lazy.Char8 as Lazy import Data.Convertible.Base import Data.Convertible.Instances.Ascii () @@ -43,7 +43,7 @@ class Show sc ⇒ StatusCode sc where numericCode ∷ sc → Int -- |Return the combination of 3-digit integer and reason phrase -- for this status e.g. @200 OK@ - textualStatus ∷ sc → Ascii + textualStatus ∷ sc → AsciiBuilder -- |Wrap the status code into 'SomeStatusCode'. fromStatusCode ∷ sc → SomeStatusCode fromStatusCode = SomeStatusCode @@ -85,7 +85,7 @@ instance StatusCode sc ⇒ ConvertSuccess sc Ascii where instance StatusCode sc ⇒ ConvertSuccess sc AsciiBuilder where {-# INLINE convertSuccess #-} - convertSuccess = cs ∘ textualStatus + convertSuccess = textualStatus instance StatusCode sc ⇒ ConvertAttempt sc Ascii where {-# INLINE convertAttempt #-} @@ -113,17 +113,17 @@ instance StatusCode sc ⇒ ConvertAttempt sc AsciiBuilder where -- data OK = OK deriving ('Show') -- instance OK where -- 'numericCode' _ = 200 --- 'textualStatus' _ = 'A.unsafeFromString' \"200 OK\" +-- 'textualStatus' _ = 'cs' (\"200 OK\" ∷ Ascii) -- -- data BadRequest = BadRequest deriving ('Show') -- instance BadRequest where -- 'numericCode' _ = 400 --- 'textualStatus' _ = 'A.unsafeFromString' \"400 Bad Request\" +-- 'textualStatus' _ = 'cs' (\"400 Bad Request\" ∷ Ascii) -- -- data MethodNotAllowed = MethodNotAllowed deriving ('Show') -- instance MethodNotAllowed where -- 'numericCode' _ = 405 --- 'textualStatus' _ = 'A.unsafeFromString' \"405 Method Not Allowed\" +-- 'textualStatus' _ = 'cs' (\"405 Method Not Allowed\" ∷ Ascii) -- @ statusCodes ∷ QuasiQuoter statusCodes = QuasiQuoter { @@ -166,7 +166,7 @@ parseStatusCodes src "pair" word ∷ Parser Ascii - word = A.unsafeFromByteString <$> P.takeWhile1 isAlpha_ascii + word = A.unsafeFromByteString <$> takeWhile1 isAlpha_ascii statusDecl ∷ (Int, [Ascii]) → Q [Dec] statusDecl (num, phrase) @@ -175,7 +175,7 @@ statusDecl (num, phrase) return (a:bs) where name ∷ Name - name = mkName $ concatMap A.toString phrase + name = mkName $ concatMap cs phrase dataDecl ∷ Q Dec dataDecl = dataD (cxt []) name [] [con] [''Show] @@ -196,8 +196,8 @@ statusDecl (num, phrase) con = return $ NormalC name [] txt ∷ Q Exp - txt = [| A.unsafeFromString $(lift txt') |] + txt = [| cs ($(lift txt') ∷ Ascii) |] txt' ∷ String txt' = concat $ intersperse "\x20" - $ show num : map A.toString phrase + $ show num : map cs phrase diff --git a/Network/HTTP/Lucu/Utils.hs b/Network/HTTP/Lucu/Utils.hs index 9abaf1e..297ea3a 100644 --- a/Network/HTTP/Lucu/Utils.hs +++ b/Network/HTTP/Lucu/Utils.hs @@ -35,18 +35,17 @@ import qualified Data.CaseInsensitive as CI import Data.Char import Data.Collections import Data.Collections.BaseInstances () +import Data.Convertible.Base +import Data.Convertible.Instances.Time () import Data.Maybe import Data.Monoid.Unicode -import Data.Ratio import Data.Text (Text) import qualified Data.Text as T import Data.Time -import Data.Time.Clock.POSIX import Network.URI import Prelude hiding (last, mapM, null, reverse) import Prelude.Unicode import System.Directory -import System.Time (ClockTime(..)) -- |'Host' represents an IP address or a host name in an URI -- authority. @@ -166,9 +165,4 @@ mapM = flip foldrM empty ∘ (flip ((<$>) ∘ flip insert) ∘) -- |Get the modification time of a given file. getLastModified ∷ FilePath → IO UTCTime -getLastModified = (clockTimeToUTC <$>) ∘ getModificationTime - where - clockTimeToUTC ∷ ClockTime → UTCTime - clockTimeToUTC (TOD sec picoSec) - = posixSecondsToUTCTime ∘ fromRational - $ sec % 1 + picoSec % (1000 ⋅ 1000 ⋅ 1000 ⋅ 1000) +getLastModified = (cs <$>) ∘ getModificationTime