{-# LANGUAGE
    BangPatterns
  , OverloadedStrings
  , UnicodeSyntax
  #-}
-- |Utility functions used internally in the Lucu httpd. These
-- functions may be useful too for something else.
module Network.HTTP.Lucu.Utils
    ( splitBy
    , joinWith
    , quoteStr
    , parseWWWFormURLEncoded
    )
    where
import Control.Monad
import Data.Ascii (Ascii, AsciiBuilder)
import qualified Data.Ascii as A
import qualified Data.ByteString.Char8 as BS
import Data.List hiding (last)
import Data.Monoid.Unicode
import Network.URI
import Prelude hiding (last)
import Prelude.Unicode

-- |> splitBy (== ':') "ab:c:def"
--  > ==> ["ab", "c", "def"]
splitBy ∷ (a → Bool) → [a] → [[a]]
splitBy isSep src
    = case break isSep src
      of (last , []       ) → [last]
         (first, _sep:rest) → first : splitBy isSep rest

-- |> joinWith ":" ["ab", "c", "def"]
--  > ==> "ab:c:def"
joinWith ∷ Ascii → [AsciiBuilder] → AsciiBuilder
{-# INLINEABLE joinWith #-}
joinWith sep = flip go (∅)
    where
      go ∷ [AsciiBuilder] → AsciiBuilder → AsciiBuilder
      {-# INLINE go #-}
      go []     ab = ab
      go (x:[]) ab = ab ⊕ x
      go (x:xs) ab = go xs (ab ⊕ A.toAsciiBuilder sep ⊕ x)

-- |> quoteStr "abc"
--  > ==> "\"abc\""
--
--  > quoteStr "ab\"c"
--  > ==> "\"ab\\\"c\""
quoteStr ∷ Ascii → AsciiBuilder
quoteStr str = A.toAsciiBuilder "\"" ⊕
               go (A.toByteString str) (∅) ⊕
               A.toAsciiBuilder "\""
    where
      go ∷ BS.ByteString → AsciiBuilder → AsciiBuilder
      go bs ab
          = case BS.break (≡ '"') bs of
              (x, y)
                  | BS.null y → ab ⊕ b2ab x
                  | otherwise → go (BS.tail y) (ab ⊕ b2ab x
                                                   ⊕ A.toAsciiBuilder "\\\"")

      b2ab ∷ BS.ByteString → AsciiBuilder
      b2ab = A.toAsciiBuilder ∘ A.unsafeFromByteString

-- |> parseWWWFormURLEncoded "aaa=bbb&ccc=ddd"
--  > ==> [("aaa", "bbb"), ("ccc", "ddd")]
parseWWWFormURLEncoded ∷ String → [(String, String)]
parseWWWFormURLEncoded src
    | src == "" = []
    | otherwise = do pairStr <- splitBy (\ c → c == ';' || c == '&') src
                     let (key, value) = break (== '=') pairStr
                     return ( unEscapeString key
                            , unEscapeString $ case value of
                                                 ('=':val) → val
                                                 val       → val
                            )