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)

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
    let env = def
            { requestMethod = rmethod
            , scriptName = sname
            , pathInfo = pinfo
            , queryString = qstring
            , serverName = servername
            , serverPort = serverport
            , http = vars
            , hackInput = body'
            }
    res <- app env
    let h = headers res
    let h' = case lookup "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)