Code clean-up using convertible-text.

Ditz-issue: 0a2a377be55430e655ab42fdc4902fa56a058b26

diff --git a/ImplantFile.hs b/ImplantFile.hs
index 60f9b54755911f631c693a053129867bb836f687..cbada793366c7b1d1265cdc0d2401f4602c1d300 100644 (file)
--- a/ImplantFile.hs
+++ b/ImplantFile.hs
@@ -4,8 +4,11 @@
 module Main (main) where
 import Control.Applicative
 import Control.Monad
-import qualified Data.Ascii as A
+import Data.Ascii (Ascii)
+import Data.Attempt
 import Data.Char
+import Data.Convertible.Base
+import Data.Convertible.Utils
 import Data.Maybe
 import Language.Haskell.TH.PprLib
 import Language.Haskell.TH.Syntax
@@ -97,9 +100,9 @@ getMIMEType opts
     = case mimeTypeOpts of
         []  → Nothing
         OptMIMEType ty:[]
-            → case A.fromChars ty of
-                 Just a  → Just $ parseMIMEType a
-                 Nothing → error "MIME types must not contain any non-ASCII letters."
+            → case convertAttemptVia ((⊥) ∷ Ascii) ty of
+                 Success a → Just a
+                 Failure e → error (show e)
         _   → error "too many --mime-type options."
     where
       mimeTypeOpts ∷ [CmdOpt]
@@ -122,9 +125,9 @@ getETag opts
 
       strToETag ∷ String → ETag
       strToETag str
-          = case A.fromChars str of
-              Just a  → strongETag a
-              Nothing → error "ETag must not contain any non-ASCII letters."
+          = case ca str of
+              Success a → strongETag a
+              Failure e → error (show e)
 
 openOutput ∷ [CmdOpt] → IO Handle
 openOutput opts

diff --git a/Network/HTTP/Lucu.hs b/Network/HTTP/Lucu.hs
index a3f73bef3529e85092f139efa9d88d89a4a1bb57..876064ce8c14701931f0a040e6e8c511a02783b1 100644 (file)
--- a/Network/HTTP/Lucu.hs
+++ b/Network/HTTP/Lucu.hs
@@ -63,7 +63,6 @@ module Network.HTTP.Lucu
       -- *** MIME Type
     , MIMEType(..)
     , MIMEParams
-    , parseMIMEType
     , mimeType
 
       -- *** Authentication

diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs
index d4c51d5e24ae7681e91aff273ae9c5bbc29b2e70..e56567e7d665b191a96d08b75dfab9bc781f614c 100644 (file)
--- a/Network/HTTP/Lucu/Headers.hs
+++ b/Network/HTTP/Lucu/Headers.hs
@@ -111,11 +111,12 @@ instance ConvertSuccess Headers Ascii where
     convertSuccess = convertSuccessVia ((⊥) ∷ AsciiBuilder)
 
 instance ConvertSuccess Headers AsciiBuilder where
-    {-# INLINE convertSuccess #-}
+    {-# INLINEABLE convertSuccess #-}
     convertSuccess (Headers m)
         = mconcat (header <$> fromFoldable m) ⊕ cs ("\x0D\x0A" ∷ Ascii)
         where
           header ∷ (CIAscii, Ascii) → AsciiBuilder
+          {-# INLINE header #-}
           header (name, value)
               = cs name                 ⊕
                 cs (": " ∷ Ascii)       ⊕

diff --git a/Network/HTTP/Lucu/Implant/PrettyPrint.hs b/Network/HTTP/Lucu/Implant/PrettyPrint.hs
index 5bbc36d8d470508904ce8247485d9ef0947ce72b..22e3a74538c3a3342a74979c45d60382a3742c63 100644 (file)
--- a/Network/HTTP/Lucu/Implant/PrettyPrint.hs
+++ b/Network/HTTP/Lucu/Implant/PrettyPrint.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE
     DoAndIfThenElse
+  , FlexibleContexts
+  , MultiParamTypeClasses
   , OverloadedStrings
   , RecordWildCards
   , TemplateHaskell
@@ -15,10 +17,10 @@ module Network.HTTP.Lucu.Implant.PrettyPrint
 import Codec.Compression.GZip
 import Control.Monad
 import Data.Ascii (Ascii, CIAscii)
-import qualified Data.Ascii as A
 import qualified Data.ByteString.Lazy as L
 import Data.Char
 import Data.Collections
+import Data.Convertible.Base
 import Data.Convertible.Utils
 import Data.List (intersperse)
 import Data.Monoid
@@ -60,19 +62,16 @@ header i@(Input {..})
                              ]
                     else
                         text "      Compression: disabled"
-                  , text "        MIME Type:" <+> mimeTypeToDoc iType
-                  , text "             ETag:" <+> eTagToDoc iETag
+                  , text "        MIME Type:" <+> toDoc iType
+                  , text "             ETag:" <+> toDoc iETag
                   , text "    Last Modified:" <+> text (show iLastMod)
                   ]
            , text " -}"
            , text "{-# LANGUAGE MagicHash #-}"
            ]
     where
-      eTagToDoc ∷ ETag → Doc
-      eTagToDoc = text ∘ convertSuccessVia ((⊥) ∷ Ascii)
-
-      mimeTypeToDoc ∷ MIMEType → Doc
-      mimeTypeToDoc = text ∘ A.toString ∘ A.fromAsciiBuilder ∘ printMIMEType
+      toDoc ∷ ConvertSuccess α Ascii ⇒ α → Doc
+      toDoc = text ∘ convertSuccessVia ((⊥) ∷ Ascii)
 
 moduleDecl ∷ ModName → Name → Doc
 moduleDecl modName symName

diff --git a/Network/HTTP/Lucu/MIMEParams.hs b/Network/HTTP/Lucu/MIMEParams.hs
index a2b93412a7eecb6d9be0eb5ccd77b7e13e02507a..88dbb6fdd71a47bdc832cca03dc4b36797f3230b 100644 (file)
--- a/Network/HTTP/Lucu/MIMEParams.hs
+++ b/Network/HTTP/Lucu/MIMEParams.hs
@@ -62,7 +62,7 @@ instance ConvertSuccess MIMEParams Ascii where
     convertSuccess = convertSuccessVia ((⊥) ∷ AsciiBuilder)
 
 instance ConvertSuccess MIMEParams AsciiBuilder where
-    {-# INLINE convertSuccess #-}
+    {-# INLINEABLE convertSuccess #-}
     convertSuccess = foldl' f (∅)
         where
           f ∷ AsciiBuilder → (CIAscii, Text) → AsciiBuilder
@@ -119,6 +119,10 @@ toHex o = cs ("%" ∷ Ascii) ⊕
           | otherwise = toEnum $ fromIntegral
                                $ fromEnum 'A' + fromIntegral (h - 0x0A)
 
+deriveAttempts [ ([t| MIMEParams |], [t| Ascii        |])
+               , ([t| MIMEParams |], [t| AsciiBuilder |])
+               ]
+
 data ExtendedParam
     = InitialEncodedParam {
         epName    ∷ !CIAscii

diff --git a/Network/HTTP/Lucu/MIMEType.hs b/Network/HTTP/Lucu/MIMEType.hs
index 68e9b255e54b0d1fdac608b97cd54ccbb28b5481..1c448eedecde5435e0889cffdd49d126df7bc25e 100644 (file)
--- a/Network/HTTP/Lucu/MIMEType.hs
+++ b/Network/HTTP/Lucu/MIMEType.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE
     DeriveDataTypeable
+  , FlexibleInstances
+  , MultiParamTypeClasses
   , OverloadedStrings
   , RecordWildCards
   , TemplateHaskell
@@ -9,10 +11,6 @@
 -- (<http://tools.ietf.org/html/rfc2046>).
 module Network.HTTP.Lucu.MIMEType
     ( MIMEType(..)
-
-    , parseMIMEType
-    , printMIMEType
-
     , mimeType
     , mimeTypeList
     )
@@ -51,24 +49,30 @@ instance Lift MIMEType where
              }
            |]
 
--- |Convert a 'MIMEType' to an 'AsciiBuilder'.
-printMIMEType ∷ MIMEType → AsciiBuilder
-{-# INLINEABLE printMIMEType #-}
-printMIMEType (MIMEType {..})
-    = A.toAsciiBuilder (A.fromCIAscii mtMedia) ⊕
-      A.toAsciiBuilder "/" ⊕
-      A.toAsciiBuilder (A.fromCIAscii mtSub) ⊕
-      cs mtParams
+instance ConvertSuccess MIMEType Ascii where
+    {-# INLINE convertSuccess #-}
+    convertSuccess = convertSuccessVia ((⊥) ∷ AsciiBuilder)
+
+instance ConvertSuccess MIMEType AsciiBuilder where
+    {-# INLINEABLE convertSuccess #-}
+    convertSuccess (MIMEType {..})
+        = cs mtMedia       ⊕
+          cs ("/" ∷ Ascii) ⊕
+          cs mtSub         ⊕
+          cs mtParams
+
+deriveAttempts [ ([t| MIMEType |], [t| Ascii        |])
+               , ([t| MIMEType |], [t| AsciiBuilder |])
+               ]
 
--- |Parse 'MIMEType' from an 'Ascii'. This function throws an
--- exception for parse error. For literals consider using
--- 'Network.HTTP.Lucu.MIMEType.TH.mimeType'.
-parseMIMEType ∷ Ascii → MIMEType
-{-# INLINEABLE parseMIMEType #-}
-parseMIMEType str
-    = case parseOnly (finishOff mimeType) $ A.toByteString str of
-        Right  t → t
-        Left err → error ("Unparsable MIME Type: " ⧺ A.toString str ⧺ ": " ⧺ err)
+-- |Parse 'MIMEType' from an 'Ascii'. For MIME type literals, consider
+-- using 'Network.HTTP.Lucu.MIMEType.TH.mimeType'.
+instance ConvertAttempt Ascii MIMEType where
+    {-# INLINEABLE convertAttempt #-}
+    convertAttempt str
+        = case parseOnly (finishOff mimeType) (cs str) of
+            Right  t → return t
+            Left err → fail ("Unparsable MIME Type: " ⧺ cs str ⧺ ": " ⧺ err)
 
 -- |'Parser' for an 'MIMEType'.
 mimeType ∷ Parser MIMEType

diff --git a/Network/HTTP/Lucu/MIMEType/TH.hs b/Network/HTTP/Lucu/MIMEType/TH.hs
index 7cdf24497637c4ef081749f9ed88466de307ff56..9e16efcb0571a0a76f7e00b8ae190e1af706f7da 100644 (file)
--- a/Network/HTTP/Lucu/MIMEType/TH.hs
+++ b/Network/HTTP/Lucu/MIMEType/TH.hs
@@ -9,7 +9,8 @@ module Network.HTTP.Lucu.MIMEType.TH
     where
 import Control.Monad.Unicode
 import Data.Ascii (Ascii)
-import qualified Data.Ascii as A
+import Data.Attempt
+import Data.Convertible.Base
 import Language.Haskell.TH.Syntax
 import Language.Haskell.TH.Quote
 import Network.HTTP.Lucu.MIMEType hiding (mimeType)
@@ -24,15 +25,23 @@ import Prelude.Unicode
 -- @
 mimeType ∷ QuasiQuoter
 mimeType = QuasiQuoter {
-             quoteExp  = (lift ∘ parseMIMEType =≪) ∘ toAscii
+             quoteExp  = (lift =≪) ∘ (parse =≪) ∘ toAscii
            , quotePat  = const unsupported
            , quoteType = const unsupported
            , quoteDec  = const unsupported
            }
     where
+      parse ∷ Monad m ⇒ Ascii → m MIMEType
+      parse a
+          = case ca a of
+              Success t → return t
+              Failure e → fail (show e)
+
       toAscii ∷ Monad m ⇒ String → m Ascii
-      toAscii (A.fromChars ∘ trim → Just a) = return a
-      toAscii str = fail $ "Malformed MIME Type: " ⧺ str
+      toAscii (trim → s)
+          = case ca s of
+              Success a → return a
+              Failure e → fail (show e)
 
       unsupported ∷ Monad m ⇒ m α
       unsupported = fail "Unsupported usage of mimeType quasi-quoter."

diff --git a/Network/HTTP/Lucu/MultipartForm.hs b/Network/HTTP/Lucu/MultipartForm.hs
index a5280c043f6bf252bf0095ba2792c3959ab26247..30a4adb7dd3f11885254d8762862ad344a1daede 100644 (file)
--- a/Network/HTTP/Lucu/MultipartForm.hs
+++ b/Network/HTTP/Lucu/MultipartForm.hs
@@ -27,6 +27,9 @@ import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LS
 import Data.ByteString.Lazy.Search
 import Data.Collections
+import Data.Convertible.Base
+import Data.Convertible.Instances.Ascii ()
+import Data.Convertible.Utils
 import Data.List (intercalate)
 import Data.Maybe
 import Data.Monoid.Unicode
@@ -69,12 +72,13 @@ data ContDispo
       , dParams ∷ !MIMEParams
       }
 
+-- FIXME
 printContDispo ∷ ContDispo → Ascii
 printContDispo d
     = A.fromAsciiBuilder
       ( A.toAsciiBuilder (A.fromCIAscii $ dType d)
         ⊕
-        printMIMEParams (dParams d) )
+        cs (dParams d) )
 
 -- |Parse \"multipart/form-data\" and return either @'Left' err@ or
 -- @'Right' result@. Note that there are currently the following

diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs
index 6f3ecce8b851e8526e1f5eb48f6bf255656533ab..b478503c8bc53d6af8b74e6b9cf196350b1772c2 100644 (file)
--- a/Network/HTTP/Lucu/Resource.hs
+++ b/Network/HTTP/Lucu/Resource.hs
@@ -587,10 +587,9 @@ getForm limit
                → readMultipartFormData params
            Just cType
                → abort $ mkAbortion' UnsupportedMediaType
-                       $ A.toText
-                       $ A.fromAsciiBuilder
-                       $ A.toAsciiBuilder "Unsupported media type: "
-                       ⊕ MT.printMIMEType cType
+                       $ cs
+                       $ ("Unsupported media type: " ∷ Ascii)
+                       ⊕ cs cType
     where
       readWWWFormURLEncoded
           = (map toPairWithFormData ∘ parseWWWFormURLEncoded)
@@ -635,8 +634,7 @@ redirect sc uri
 -- \"Content-Type\" as @mType@. Declaring \"Content-Type\" is
 -- mandatory for sending a response body.
 setContentType ∷ MIMEType → Rsrc ()
-setContentType
-    = setHeader "Content-Type" ∘ A.fromAsciiBuilder ∘ MT.printMIMEType
+setContentType = setHeader "Content-Type" ∘ cs
 
 -- |@'setLocation' uri@ declares the response header \"Location\" as
 -- @uri@. You usually don't need to call this function directly.