module Hack.Frontend.Happstack where

import Happstack.Server
import Happstack.Server.HTTP.Types (Request (..), Version (Version))
import qualified Data.ByteString.UTF8 as UBS
import qualified Happstack.Server as H
import Happstack.Server.SURI (parse)
import qualified Hack as Hack
import qualified Hack
import Hack (http, pathInfo, scriptName, queryString, hackInput, serverName, serverPort, Application)
import Data.Maybe
import Data.Foldable (toList)

-- | Converts a Happstack ServerPartT to a CGI handling function.
serverPartToApp :: (ToMessage b) => ServerPartT IO b -> Application
serverPartToApp = convert . processRequest

convert :: (Request -> IO Response) -> Application
convert f = \env -> do
  let rq = toHappstackRequest env
  rs <- f rq
  let r = toHackResponse rs
  return r

toHackResponse :: Response -> Hack.Response
toHackResponse r = Hack.Response
  {
    Hack.body = rsBody r
  , Hack.status = rsCode r
  , Hack.headers = map convertHeader $ toList (rsHeaders r)
  }

-- | Sets all the headers coming from Happstack
convertHeader :: HeaderPair -> (String, String)
convertHeader (HeaderPair k v) = (UBS.toString k, UBS.toString (last v))

-- | Converts one request into another
toHappstackRequest :: Hack.Env -> Request
toHappstackRequest env =
  tmpRequest
    { rqInputs = queryInput uri ++ bodyInput tmpRequest }
  where
    uri = fromJust $ parse $ concat $ map (\f -> f env) 
      [ serverName
      , show . serverPort
      , scriptName
      , pathInfo
      , add_q . queryString
      ]
    tmpRequest = 
      Request { rqMethod  = convertRequestMethod $ Hack.requestMethod env
              , rqPaths   = split '/' $ pathInfo env
              , rqUri	    = scriptName env ++ pathInfo env
              , rqQuery   = add_q $ queryString env
              , rqInputs  = []
              , rqCookies = readCookies $ http env
              , rqVersion = Version 1 1
              , rqHeaders = mkHeaders $ http env
              , rqBody    = Body $ hackInput env
              , rqPeer    = (serverName env, serverPort env)
              }
  
    convertRequestMethod Hack.OPTIONS     =     OPTIONS
    convertRequestMethod Hack.GET         =     GET
    convertRequestMethod Hack.HEAD        =     HEAD
    convertRequestMethod Hack.POST        =     POST
    convertRequestMethod Hack.PUT         =     PUT
    convertRequestMethod Hack.DELETE      =     DELETE
    convertRequestMethod Hack.TRACE       =     TRACE
    convertRequestMethod Hack.CONNECT     =     CONNECT
    
    
    readCookies = map cookieWithName 
      . either (const []) id . parseCookies . fromMaybe "" . lookup "Cookie"
      
    add_q [] = []
    add_q x = '?' : x

cookieWithName :: H.Cookie -> (String, H.Cookie)
cookieWithName x = (H.cookieName x, x)


-- | Transforms a ServerPartT into a function. This is a copy of simpleHTTP'
processRequest :: (ToMessage b, Monad m, Functor m) => ServerPartT m b -> Request -> m Response
processRequest hs req =  (runWebT $ runServerPartT hs req) >>= (return . (maybe standardNotFound id))
    where
        standardNotFound = H.setHeader "Content-Type" "text/html" $ toResponse "Not found"


-- | Splits a list by character, the resulting lists don't have the character in them.
split :: Char -> String -> [String]
split c cs = filter (not.null) $ worker [] cs
    where worker acc [] = [reverse acc]
          worker acc (c':cs') | c==c' = reverse acc:worker [] cs'
          worker acc (c':cs') = worker (c':acc) cs'