-- ----------------------------------------------------------------------------

{- |
  Module     : Hayoo.SearchApplication
  Copyright  : Copyright (C) 2010 Timo B. Huebel
  License    : MIT

  Maintainer : Timo B. Huebel (tbh@holumbus.org)
  Stability  : experimental
  Portability: portable
  Version    : 0.1

  The search web-service for the Hayoo Haskell API search engine.

-}

-- ----------------------------------------------------------------------------

module Hayoo.Search.Application
    ( hayooApplication
    , hayooInit
    , Core (..)
    )
where

import Control.Concurrent               -- For the global MVar

import Data.ByteString.Lazy.Char8       ( fromChunks )

import qualified Data.List              as L
import qualified Data.Text.Encoding     as T

import Hayoo.IndexTypes
import Hayoo.Search.EvalSearch
import Hayoo.Search.Pages.Template
import Hayoo.Search.Pages.Static

import Holumbus.Index.Common

import Hack
import Hack.Contrib.Middleware.File
import Hack.Contrib.Middleware.URLMap
import Hack.Contrib.Request             ( params, path, host )
import Hack.Contrib.Utils               ( empty_app )

import System.IO                        ( stdout )
import System.Time

import System.Log.Logger
import System.Log.Handler.Simple

import qualified
       Text.XHtmlCombinators            as X

-- ------------------------------------------------------------

-- | Init Hayoo!
hayooInit :: FilePath -> IO Application
hayooInit ixBase = do
    fdl  <- fileHandler "hayoo.log" INFO
    sdl  <- streamHandler stdout INFO

    updateGlobalLogger rootLoggerName (setHandlers [fdl, sdl])
    updateGlobalLogger rootLoggerName (setLevel INFO)

    idx  <- loadIndex     hayooIndex
    infoM "Hayoo.Main" ("Hayoo index   loaded from file " ++ show hayooIndex)

    doc  <- loadDocuments hayooDocs
    infoM "Hayoo.Main" ("Hayoo docs    loaded from file " ++ show hayooDocs )
    infoM "Hayoo.Main" ("Hayoo docs contains " ++ show (sizeDocs doc) ++ " functions and types")

    pidx <- loadIndex     hackageIndex
    infoM "Hayoo.Main" ("Hackage index loaded from file " ++ show hackageIndex)

    pdoc <- loadPkgDocs   hackageDocs
    infoM "Hayoo.Main" ("Hackage docs  loaded from file " ++ show hackageDocs)
    infoM "Hayoo.Main" ("Hackage docs contains " ++ show (sizeDocs pdoc) ++ " packages")

    prnk <- return $ buildRankTable pdoc
    infoM "Hayoo.Main" ("Hackage package rank table computed")

    tpl  <- return $ makeTemplate (sizeDocs pdoc) (sizeDocs doc)

    midct <- newMVar $
             Core
             { index      = idx
             , documents  = doc
             , pkgIndex   = pidx
             , pkgDocs    = pdoc
             , template   = tpl
             , packRank   = prnk
             }

    return $
           url_map [ ("/hayoo.html", hayooApplication midct)
                   , ("/hayoo.json", hayooApplication midct)
                   , ("/help.html", serveStatic $ tpl help)
                   , ("/about.html", serveStatic $ tpl about)
                   , ("/api.html", serveStatic $ tpl api)
                   ] (file Nothing empty_app)
  where
  hayooIndex      = ixBase ++ "/ix.bin.idx"
  hayooDocs       = ixBase ++ "/ix.bin.doc"
  hackageIndex    = ixBase ++ "/pkg.bin.idx"
  hackageDocs     = ixBase ++ "/pkg.bin.doc"
  serveStatic c _ = return $ Response 
                    { status = 200
                    , headers = [ ("Content-Type", "text/html") ]
                    , body = fromChunks [T.encodeUtf8 $ X.render c]
                    }

-- | Generate the actual response
hayooApplication :: MVar Core -> Env -> IO Response
hayooApplication midct env      = let p = params env in do
          request <- return $               getValDef p "query"  ""
          start   <- return $ readDef 0    (getValDef p "start"  "")
          static  <- return $ readDef True (getValDef p "static" "")
          json    <- return $ isJson (path env)

          -- Output some information about the request.
          logRequest env

          -- Because index access is read only, the MVar's are just read 
          -- to make them avaliable again.
          idct    <- readMVar midct

          -- Put all information relevant for rendering into a container
          state   <- return $ (request, start, static, (template idct))

          -- If the query is empty, just render an empty page
          resp    <- return $
                     if L.null request
                     then renderEmpty json idct
                     else renderResult state json idct

          -- Determine the mime type of the response
          mime    <- return $ 
                     if json 
                     then "application/json" 
                     else "text/html"

          -- Return the actual response
          return $ Response { status = 200, headers = [ ("Content-Type", mime) ], body = resp }


-- | Log a request to stdout.
logRequest :: Env -> IO ()
logRequest env = do
  -- Extract remote host and the search string from the incoming transaction.
  remHost    <- return $ host env
  rawRequest <- return $ getValDef (params env) "query" ""
  start      <- return $ getValDef (params env) "start" "0"
  userAgent  <- return $ getValDef (http env) "User-Agent" "No user agent"

  -- Decode URI encoded entities in the search string.
  decodedRequest <- return $ decode rawRequest

  -- Get the current date and time.
  unixTime <- getClockTime
  currTime <- return $ calendarTimeToString $ toUTCTime unixTime

  -- Output all the collected information from above to stdout.
  infoM "Hayoo.Request" (currTime ++ "\t" ++
                         remHost ++ "\t "++
                         userAgent ++ "\t" ++
                         rawRequest ++ "\t" ++
                         decodedRequest ++ "\t" ++
                         start
                        )

-- ------------------------------------------------------------