]> gitweb @ CieloNegro.org - Lucu.git/commitdiff
RFC2231 is done... Hope it works...
authorPHO <pho@cielonegro.org>
Thu, 25 Aug 2011 15:51:31 +0000 (00:51 +0900)
committerPHO <pho@cielonegro.org>
Thu, 25 Aug 2011 15:51:31 +0000 (00:51 +0900)
Ditz-issue: 8959dadc07db1bd363283dee401073f6e48dc7fa

Network/HTTP/Lucu/RFC2231.hs

index 1d49646947dacb0d81a848b8a9d658ccda541370..0f2eb136d7a00da9303f3fb7aa59834634ddf111 100644 (file)
@@ -14,6 +14,7 @@ module Network.HTTP.Lucu.RFC2231
     )
     where
 import Control.Applicative
+import qualified Control.Exception as E
 import Control.Monad.Unicode
 import Data.Ascii (Ascii, CIAscii, AsciiBuilder)
 import qualified Data.Ascii as A
@@ -31,6 +32,7 @@ import Data.Sequence.Unicode hiding ((∅))
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.ICU.Convert as TC
+import Data.Text.ICU.Error
 import Data.Text.Encoding
 import Data.Traversable
 import Data.Word
@@ -38,6 +40,7 @@ import Network.HTTP.Lucu.Parser.Http
 import Network.HTTP.Lucu.Utils
 import Prelude hiding (concat, mapM, takeWhile)
 import Prelude.Unicode
+import System.IO.Unsafe
 
 printParams ∷ Map CIAscii Text → AsciiBuilder
 printParams params
@@ -151,7 +154,7 @@ initialEncodedValue
          payload ← encodedPayload
          if charset ≡ "" then
              -- NOTE: I'm not sure this is the right thing, but RFC
-             -- 2231 doesn't tell us what should we do when the
+             -- 2231 doesn't tell us what we should do when the
              -- charset is omitted.
              return ("US-ASCII", payload)
          else
@@ -251,7 +254,7 @@ decodeSections = (decodeSeq =≪) ∘ flip (flip toSeq 0) (∅)
                        let t = TC.toUnicode conv epPayload
                        decodeSeq' (Just conv) xs $ S.singleton t
               ContinuedEncodedParam {..} :< _
-                  → fail "decodeSeq: internal error: ContinuedEncodedParam at section 0"
+                  → fail "decodeSeq: internal error: CEP at section 0"
               AsciiParam {..} :< xs
                   → let t = A.toText apPayload
                     in
@@ -266,7 +269,7 @@ decodeSections = (decodeSeq =≪) ∘ flip (flip toSeq 0) (∅)
               EmptyL
                   → return $ T.concat $ toList chunks
               InitialEncodedParam {..} :< _
-                  → fail "decodeSeq': internal error: InitialEncodedParam at section > 0"
+                  → fail "decodeSeq': internal error: IEP at section > 0"
               ContinuedEncodedParam {..} :< xs
                   → case convM of
                        Just conv
@@ -278,7 +281,7 @@ decodeSections = (decodeSeq =≪) ∘ flip (flip toSeq 0) (∅)
                                           , show epSection
                                           , " for parameter '"
                                           , A.toString $ A.fromCIAscii epName
-                                          , "' is encoded but its section 0 is not"
+                                          , "' is encoded but its first section is not"
                                           ])
               AsciiParam {..} :< xs
                   → let t = A.toText apPayload
@@ -287,4 +290,9 @@ decodeSections = (decodeSeq =≪) ∘ flip (flip toSeq 0) (∅)
 
       openConv ∷ CIAscii → m TC.Converter
       openConv charset
-          = fail "FIXME"
+          = let cs    = A.toString $ A.fromCIAscii charset
+                open' = TC.open cs (Just True)
+            in
+              case unsafePerformIO $ E.try open' of
+                Right conv → return conv
+                Left  err  → fail $ show (err ∷ ICUError)