{-# LANGUAGE QuasiQuotes #-}

module Hack.Contrib.Request where

import Hack
import Hack.Contrib.Constants

import Prelude hiding ((.), (^), (>), (+))
import MPSUTF8
import Hack.Contrib.Utils
import Data.Maybe
import Network.CGI.Protocol
import Network.CGI.Cookie

body :: Env -> String
body = hack_input

scheme :: Env -> String
scheme = hack_url_scheme > show > lower

port :: Env -> Int
port = server_port

path :: Env -> String
path env = env.script_name ++ env.path_info

content_type :: Env -> String
content_type env = env.http_ _ContentType .fromMaybe ""

media_type :: Env -> String
media_type env = env.content_type.split "\\s*[;,]\\s*" .first.lower

media_type_params :: Env -> [(String, String)]
media_type_params env
  | env.content_type.empty = []
  | otherwise = 
      env
        .content_type
        .split "\\s*[;,]\\s"
        .drop 1
        .map (split "=" > take 2)
        .map tuple2
        .map_fst lower

content_charset :: Env -> String
content_charset env = env.media_type_params.lookup "charset" .fromMaybe ""

host :: Env -> String
host env = env.http_"HOST" .fromMaybe (env.server_name) .gsub ":\\d+\\z" ""

params :: Env -> [(String, String)]
params env
  | env.query_string.empty = []
  | otherwise =
      env
        .query_string
        .formDecode

inputs :: Env -> [(String, String)]
inputs env
  | env.media_type.is "application/x-www-form-urlencoded" =
      env
        .hack_input
        .formDecode
  | otherwise = [] -- multipart wait - -

referer :: Env -> String
referer = http_ _Referer > fromMaybe "/"

cookies :: Env -> [(String, String)]
cookies env = case env.http_ _Cookie of
  Nothing -> []
  Just s -> s.readCookies

fullpath :: Env -> String
fullpath env = 
  if env.query_string.empty 
    then env.path 
    else env.path ++ "?" ++ env.query_string

http_ :: String -> Env -> Maybe String
http_ s env = env.http.get s

custom_ :: String -> Env -> Maybe String
custom_ s env = env.custom.get s

url :: Env -> String
url env =
  [  env.scheme
  ,  "://"
  ,  env.host
  ,  port_string
  ,  env.fullpath
  ]
  .join'
  where
    port_string = 
      if (env.scheme.is "https" && env.port.is_not 443 || 
          env.scheme.is "http" && env.port.is_not 80 )
        then ":" ++ env.server_port.show
        else ""


--form_data_media_types :: [String]
--form_data_media_types = 
--  [  ""
--  ,  "application/x-www-form-urlencoded"
--  ,  "multipart/form-data"
--  ]
--
--parseable_data_media_types :: [String]
--parseable_data_media_types = 
--  [  "multipart/related"
--  ,  "multipart/mixed"
--  ]
--
--is_form_data :: Env -> Bool
--is_form_data = media_type > belongs_to form_data_media_types
--
--is_parseable_data :: Env -> Bool
--is_parseable_data = media_type > belongs_to parseable_data_media_types