{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

module Hack.Contrib.Utils where

import Control.Arrow ((<<<))
import Data.ByteString.Lazy.Char8 (ByteString)
import Data.Default
import Data.List (lookup)
import Data.Time
import Hack
import Hack.Contrib.Constants
import MPS.Light
import Network.URI hiding (path)
import Prelude hiding ((.), (^), (>), lookup, (+), (/), (-))
import System.Locale (defaultTimeLocale)
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.Map as M

empty_app :: Application
empty_app = return def

-- | usage: app.use [content_type, cache]
use :: [Middleware] -> Middleware
use = reduce (<<<)

-- use the get / put helper to deal with headers
put :: String -> String -> [(String, String)] -> [(String, String)]
put k v xs = (k,v) : xs.reject (fst > is k)

get :: String -> [(String, String)] -> Maybe String
get = lookup

bytesize :: ByteString -> Int
bytesize = B.length > from_i

dummy_middleware :: Middleware
dummy_middleware = id

dummy_app :: Application
dummy_app _ = return - def { status = 500 }

escape_html :: String -> String
escape_html = concatMap fixChar
  where
    fixChar '&'   = "&amp;"
    fixChar '<'  = "&lt;"
    fixChar '>'  = "&gt;"
    fixChar '\'' = "&#39;"
    fixChar '"'  = "&quot;"
    fixChar x    = [x]

escape_uri :: String -> String
escape_uri = escapeURIString isAllowedInURI

unescape_uri :: String -> String
unescape_uri = unEscapeString

show_status_message :: Int -> Maybe String
show_status_message x = status_code.M.lookup x

now :: IO UTCTime
now = getCurrentTime

httpdate :: UTCTime -> String
httpdate x = x.format_time "%a, %d %b %Y %X GMT"


format_time :: String -> UTCTime -> String
format_time = formatTime defaultTimeLocale

request_method    :: Env -> RequestMethod
script_name       :: Env -> String
path_info         :: Env -> String
query_string      :: Env -> String
server_name       :: Env -> String
server_port       :: Env -> Int
hack_version      :: Env -> [Int]
hack_url_scheme   :: Env -> Hack_UrlScheme
hack_input        :: Env -> ByteString
hack_errors       :: Env -> HackErrors
custom            :: Env -> [(String, String)]
remote_host       :: Env -> String

request_method  = requestMethod
script_name     = scriptName
path_info       = pathInfo
query_string    = queryString
server_name     = serverName
server_port     = serverPort
hack_version    = hackVersion
hack_url_scheme = hackUrlScheme
hack_input      = hackInput
hack_errors     = hackErrors
custom          = hackHeaders
remote_host     = remoteHost