]> gitweb @ CieloNegro.org - Lucu.git/blobdiff - Network/HTTP/Lucu/MultipartForm.hs
Code clean-up using convertible-text.
[Lucu.git] / Network / HTTP / Lucu / MultipartForm.hs
index 30a4adb7dd3f11885254d8762862ad344a1daede..882ff76668dc60bcb721eaefd83f1d4555d5303a 100644 (file)
@@ -1,10 +1,13 @@
 {-# LANGUAGE
     DoAndIfThenElse
+  , FlexibleInstances
   , FlexibleContexts
+  , MultiParamTypeClasses
   , OverloadedStrings
   , QuasiQuotes
   , RecordWildCards
   , ScopedTypeVariables
+  , TemplateHaskell
   , UnicodeSyntax
   , ViewPatterns
   #-}
@@ -19,7 +22,7 @@ import Control.Applicative hiding (many)
 import Control.Applicative.Unicode hiding ((∅))
 import Control.Monad.Error (MonadError, throwError)
 import Control.Monad.Unicode
-import Data.Ascii (Ascii, CIAscii)
+import Data.Ascii (Ascii, CIAscii, AsciiBuilder)
 import qualified Data.Ascii as A
 import Data.Attoparsec
 import qualified Data.Attoparsec.Lazy as LP
@@ -72,13 +75,18 @@ data ContDispo
       , dParams ∷ !MIMEParams
       }
 
--- FIXME
-printContDispo ∷ ContDispo → Ascii
-printContDispo d
-    = A.fromAsciiBuilder
-      ( A.toAsciiBuilder (A.fromCIAscii $ dType d)
-        ⊕
-        cs (dParams d) )
+instance ConvertSuccess ContDispo Ascii where
+    {-# INLINE convertSuccess #-}
+    convertSuccess = convertSuccessVia ((⊥) ∷ AsciiBuilder)
+
+instance ConvertSuccess ContDispo AsciiBuilder where
+    {-# INLINE convertSuccess #-}
+    convertSuccess (ContDispo {..})
+        = cs dType ⊕ cs dParams
+
+deriveAttempts [ ([t| ContDispo |], [t| Ascii        |])
+               , ([t| ContDispo |], [t| AsciiBuilder |])
+               ]
 
 -- |Parse \"multipart/form-data\" and return either @'Left' err@ or
 -- @'Right' result@. Note that there are currently the following
@@ -241,7 +249,7 @@ partName (Part {..})
                                       ⧺ T.unpack name
         Nothing
             → throwError $ "form-data without name: "
-                         â§º A.toString (printContDispo ptContDispo)
+                         â\8a\95 convertSuccessVia ((â\8a¥) â\88· Ascii) ptContDispo
 
 partFileName ∷ Part → Maybe Text
 partFileName (ptContDispo → ContDispo {..})