module Hack.Handler.CGI
    ( run
    , helper
    ) where

import Hack
import Data.Default
import System.Environment (getEnvironment)
import Data.Maybe (fromMaybe)
import qualified Data.ByteString.Lazy as BS
import Data.Word (Word8)
import Control.Arrow (first)
import Data.Char (toLower)

safeRead :: Read a => a -> String -> a
safeRead d s =
  case reads s of
    ((x, _):_) -> x
    [] -> d

lookup' :: String -> [(String, String)] -> String
lookup' key pairs = fromMaybe "" $ lookup key pairs

run :: Application -> IO ()
run app = do
    vars <- getEnvironment
    body' <- BS.getContents
    helper vars body' app >>= BS.putStr

helper :: [(String, String)] -- ^ all variables
       -> BS.ByteString -- ^ body of input
       -> Application
       -> IO BS.ByteString -- ^ full output
helper vars body' app = do
    let rmethod = safeRead GET $ lookup' "REQUEST_METHOD" vars
        sname = lookup' "SCRIPT_NAME" vars
        pinfo = lookup' "PATH_INFO" vars
        qstring = lookup' "QUERY_STRING" vars
        servername = lookup' "SERVER_NAME" vars
        serverport = safeRead 80 $ lookup' "SERVER_PORT" vars
        contentLength = safeRead 0 $ lookup' "CONTENT_LENGTH" vars
    let env = def
            { requestMethod = rmethod
            , scriptName = sname
            , pathInfo = pinfo
            , queryString = qstring
            , serverName = servername
            , serverPort = serverport
            , http = map (first cleanupVarName) vars
            , hackInput = BS.take contentLength body'
            }
    res <- app env
    let h = headers res
    let h' = case ilookup "Content-Type" h of
                Nothing -> ("Content-Type", "text/html; charset=utf-8") : h
                Just _ -> h
    let s = case status res of
                0 -> 200
                x -> x
    return $ BS.concat
        [ pack "Status: "
        , pack $ show s
        , pack "\n"
        , BS.concat $ map showHeader h'
        , pack "\n"
        , body res
        ]

showHeader :: (String, String) -> BS.ByteString
showHeader (x, y) = pack $ x ++ ": " ++ y ++ "\n"

pack :: String -> BS.ByteString
pack = BS.pack . map safeCharToWord8

safeCharToWord8 :: Char -> Word8
safeCharToWord8 c
    | fromEnum c < 256 = toEnum $ fromEnum c
    | otherwise = error $ "Out of bound character, value: " ++
                          show (fromEnum c)

cleanupVarName :: String -> String
cleanupVarName ('H':'T':'T':'P':'_':a:as) = a : helper' as where
    helper' ('_':x:rest) = '-' : x : helper' rest
    helper' (x:rest) = toLower x : helper' rest
    helper' [] = []
cleanupVarName "CONTENT_TYPE" = "Content-Type"
cleanupVarName "CONTENT_LENGTH" = "Content-Length"
cleanupVarName x = x

-- | Case insensitive lookup
ilookup :: String -> [(String, a)] -> Maybe a
ilookup needle haystack = lookup (ls needle) $ map (first ls) haystack where
    ls = map toLower