]> 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 882ff76668dc60bcb721eaefd83f1d4555d5303a..2d1b3470f1cf62a797a1336c183e8d54999589b9 100644 (file)
@@ -23,7 +23,7 @@ import Control.Applicative.Unicode hiding ((∅))
 import Control.Monad.Error (MonadError, throwError)
 import Control.Monad.Unicode
 import Data.Ascii (Ascii, CIAscii, AsciiBuilder)
 import Control.Monad.Error (MonadError, throwError)
 import Control.Monad.Unicode
 import Data.Ascii (Ascii, CIAscii, AsciiBuilder)
-import qualified Data.Ascii as A
+import Data.Attempt
 import Data.Attoparsec
 import qualified Data.Attoparsec.Lazy as LP
 import qualified Data.ByteString as BS
 import Data.Attoparsec
 import qualified Data.Attoparsec.Lazy as LP
 import qualified Data.ByteString as BS
@@ -38,7 +38,6 @@ import Data.Maybe
 import Data.Monoid.Unicode
 import Data.Sequence (Seq)
 import Data.Text (Text)
 import Data.Monoid.Unicode
 import Data.Sequence (Seq)
 import Data.Text (Text)
-import qualified Data.Text as T
 import Network.HTTP.Lucu.Headers
 import Network.HTTP.Lucu.MIMEParams
 import Network.HTTP.Lucu.MIMEType (MIMEType)
 import Network.HTTP.Lucu.Headers
 import Network.HTTP.Lucu.MIMEParams
 import Network.HTTP.Lucu.MIMEType (MIMEType)
@@ -136,7 +135,7 @@ prologue ∷ Ascii → Parser ()
 prologue boundary
     = ( (string "--" <?> "prefix")
         *>
 prologue boundary
     = ( (string "--" <?> "prefix")
         *>
-        (string (A.toByteString boundary) <?> "boundary")
+        (string (cs boundary) <?> "boundary")
         *>
         pure ()
       )
         *>
         pure ()
       )
@@ -180,16 +179,16 @@ getContDispo hdrs
         Nothing
             → throwError "Content-Disposition is missing"
         Just str
         Nothing
             → throwError "Content-Disposition is missing"
         Just str
-            → case parseOnly (finishOff contentDisposition) $ A.toByteString str of
+            → case parseOnly (finishOff contentDisposition) $ cs str of
                  Right  d → return d
                  Left err → throwError $ "malformed Content-Disposition: "
                  Right  d → return d
                  Left err → throwError $ "malformed Content-Disposition: "
-                                       â§º A.toString str
-                                       â§º ": "
-                                       â§º err
+                                       â\8a\95 cs str
+                                       â\8a\95 ": "
+                                       â\8a\95 err
 
 contentDisposition ∷ Parser ContDispo
 contentDisposition
 
 contentDisposition ∷ Parser ContDispo
 contentDisposition
-    = (ContDispo <$> (A.toCIAscii <$> token) ⊛ mimeParams)
+    = (ContDispo <$> (cs <$> token) ⊛ mimeParams)
       <?>
       "contentDisposition"
 
       <?>
       "contentDisposition"
 
@@ -200,19 +199,19 @@ getContType hdrs
         Nothing
             → return Nothing
         Just str
         Nothing
             → return Nothing
         Just str
-            → case parseOnly (finishOff MT.mimeType) $ A.toByteString str of
+            → case parseOnly (finishOff MT.mimeType) $ cs str of
                  Right  d → return $ Just d
                  Left err → throwError $ "malformed Content-Type: "
                  Right  d → return $ Just d
                  Left err → throwError $ "malformed Content-Type: "
-                                       â§º A.toString str
-                                       â§º ": "
-                                       â§º err
+                                       â\8a\95 cs str
+                                       â\8a\95 ": "
+                                       â\8a\95 err
 
 getBody ∷ MonadError String m
         ⇒ Ascii
         → LS.ByteString
         → m (LS.ByteString, LS.ByteString)
 {-# INLINEABLE getBody #-}
 
 getBody ∷ MonadError String m
         ⇒ Ascii
         → LS.ByteString
         → m (LS.ByteString, LS.ByteString)
 {-# INLINEABLE getBody #-}
-getBody (("\r\n--" ⊕) ∘ A.toByteString → boundary) src
+getBody (("\r\n--" ⊕) ∘ cs → boundary) src
     = case breakOn boundary src of
         (before, after)
             | LS.null after
     = case breakOn boundary src of
         (before, after)
             | LS.null after
@@ -236,17 +235,16 @@ partToFormPair pt@(Part {..})
              return (name, fd)
     | otherwise
         = throwError $ "disposition type is not \"form-data\": "
              return (name, fd)
     | otherwise
         = throwError $ "disposition type is not \"form-data\": "
-                     â§º A.toString (A.fromCIAscii $ dType ptContDispo)
+                     â\8a\95 cs (dType ptContDispo)
 
 partName ∷ MonadError String m ⇒ Part → m Ascii
 {-# INLINEABLE partName #-}
 partName (Part {..})
     = case lookup "name" $ dParams ptContDispo of
         Just name
 
 partName ∷ MonadError String m ⇒ Part → m Ascii
 {-# INLINEABLE partName #-}
 partName (Part {..})
     = case lookup "name" $ dParams ptContDispo of
         Just name
-            → case A.fromText name of
-                 Just a  → return a
-                 Nothing → throwError $ "Non-ascii part name: "
-                                      ⧺ T.unpack name
+            → case ca name of
+                 Success a → return a
+                 Failure e → throwError $ show e
         Nothing
             → throwError $ "form-data without name: "
                          ⊕ convertSuccessVia ((⊥) ∷ Ascii) ptContDispo
         Nothing
             → throwError $ "form-data without name: "
                          ⊕ convertSuccessVia ((⊥) ∷ Ascii) ptContDispo