{-# LANGUAGE
    OverloadedStrings
  , UnicodeSyntax
  #-}
-- |Provide facilities to encode/decode MIME parameter values in
-- character sets other than US-ASCII. See:
-- http://www.faqs.org/rfcs/rfc2231.html
module Network.HTTP.Lucu.RFC2231
    ( printParams
--    , paramsP
    )
    where
import Data.Ascii (Ascii, CIAscii, AsciiBuilder)
import qualified Data.Ascii as A
import Data.Bits
import qualified Data.ByteString.Char8 as BS
import Data.Map (Map)
import qualified Data.Map as M
import Data.Monoid.Unicode
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding
import Data.Word
import Network.HTTP.Lucu.Parser.Http
import Network.HTTP.Lucu.Utils
import Prelude.Unicode

printParams ∷ Map CIAscii Text → AsciiBuilder
printParams params
    | M.null params = (∅)
    | otherwise     = A.toAsciiBuilder "; " ⊕
                      joinWith "; " (map printPair $ M.toList params)
    where
      printPair ∷ (CIAscii, Text) → AsciiBuilder
      printPair (name, value)
          | T.any (> '\xFF') value
              = printPairInUTF8 name value
          | otherwise
              = printPairInAscii name (A.unsafeFromByteString $ encodeUtf8 value)

      printPairInUTF8 ∷ CIAscii → Text → AsciiBuilder
      printPairInUTF8 name value
          = A.toAsciiBuilder (A.fromCIAscii name) ⊕
            A.toAsciiBuilder "*=utf-8''" ⊕
            escapeUnsafeChars (encodeUtf8 value) (∅)

      printPairInAscii ∷ CIAscii → Ascii → AsciiBuilder
      printPairInAscii name value
          = A.toAsciiBuilder (A.fromCIAscii name) ⊕
            A.toAsciiBuilder "=" ⊕
            if BS.any ((¬) ∘ isToken) (A.toByteString value) then
                quoteStr value
            else
                A.toAsciiBuilder value

      escapeUnsafeChars ∷ BS.ByteString → AsciiBuilder → AsciiBuilder
      escapeUnsafeChars bs b
          = case BS.uncons bs of
              Nothing         → b
              Just (c, bs')
                  | isToken c → escapeUnsafeChars bs' $
                                    b ⊕ A.toAsciiBuilder (A.unsafeFromString [c])
                  | otherwise → escapeUnsafeChars bs' $
                                    b ⊕ toHex (fromIntegral $ fromEnum c)

      toHex ∷ Word8 → AsciiBuilder
      toHex o = A.toAsciiBuilder "%" ⊕
                A.toAsciiBuilder (A.unsafeFromString [ toHex' (o `shiftR` 8)
                                                     , toHex' (o .&.   0x0F) ])

      toHex' ∷ Word8 → Char
      toHex' o
          | o ≤ 0x09  = toEnum $ fromIntegral $ fromEnum '0' + fromIntegral o
          | otherwise = toEnum $ fromIntegral $ fromEnum 'A' + fromIntegral (o - 0x0A)

{-
decode ∷ [(CIAscii, Ascii)] → Map CIAscii Text
{-# INLINEABLE decode #-}
decode = error "FIXME: not implemented"
-}