Code clean-up using convertible-text.

Ditz-issue: 0a2a377be55430e655ab42fdc4902fa56a058b26

diff --git a/Network/HTTP/Lucu/DefaultPage.hs b/Network/HTTP/Lucu/DefaultPage.hs
index d95291764cf2ecd7c1b4c0e8beebe84a1f20744c..c5ae6f5c5d485ea8dbe4ca6046e70cbd7258ce47 100644 (file)
--- 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 1284f2b322749e2e69dcd0d69702065a7aa99644..77047273c43564feddc2ef688be16eb652f57d73 100644 (file)
--- 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 a970b46f9f695595f435793768c2285b51221490..852860b278489df97143eaa64ccf41a09c98a02a 100644 (file)
--- 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 e5c38e78c1b3ae466cad9b0e62a69f3d47f5ee50..9feca7edf6e3b6401fc7e4306705a420553fe016 100644 (file)
--- 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 2dd38630c2b1e83d61d3c643199d58bb1b046e89..8f3e22579ddc8d4d8d32963e84ae7bc936a01eda 100644 (file)
--- 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 1d9117ceb1d3ade43416efe25ea0261a76fecb24..21210375bbfa3ae5d34cd84fe759bf8c6ecbe7ad 100644 (file)
--- 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 9abaf1e9c511d3e0d2d61bf1008640471f2baa51..297ea3a762ef64992466469a3845053ffb86d7af 100644 (file)
--- 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