From: PHO Date: Thu, 25 Aug 2011 15:51:31 +0000 (+0900) Subject: RFC2231 is done... Hope it works... X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=0a300483f71cbbbe84b5781849f33692c2832864;p=Lucu.git RFC2231 is done... Hope it works... Ditz-issue: 8959dadc07db1bd363283dee401073f6e48dc7fa --- diff --git a/Network/HTTP/Lucu/RFC2231.hs b/Network/HTTP/Lucu/RFC2231.hs index 1d49646..0f2eb13 100644 --- a/Network/HTTP/Lucu/RFC2231.hs +++ b/Network/HTTP/Lucu/RFC2231.hs @@ -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)