X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FMultipartForm.hs;fp=Network%2FHTTP%2FLucu%2FMultipartForm.hs;h=882ff76668dc60bcb721eaefd83f1d4555d5303a;hp=30a4adb7dd3f11885254d8762862ad344a1daede;hb=bb41be0c967538a1014c87103a3a5d3840ad3e15;hpb=0678be80d2cab7c670aba82659bde87ba84b926b diff --git a/Network/HTTP/Lucu/MultipartForm.hs b/Network/HTTP/Lucu/MultipartForm.hs index 30a4adb..882ff76 100644 --- a/Network/HTTP/Lucu/MultipartForm.hs +++ b/Network/HTTP/Lucu/MultipartForm.hs @@ -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) + ⊕ convertSuccessVia ((⊥) ∷ Ascii) ptContDispo partFileName ∷ Part → Maybe Text partFileName (ptContDispo → ContDispo {..})