Code clean-up using convertible-text.

[Lucu.git] / Network / HTTP / Lucu / Resource.hs

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@.