{-# LANGUAGE RecordWildCards #-} module Web.Response(response) where import CmdLine.All import Hoogle import General.Base import General.Util import General.Web import Web.Page import Data.Generics.Uniplate import Data.Time.Clock import Data.Time.Calendar import Network.HTTP import Paths_hoogle logFile = "log.txt" response :: FilePath -> CmdLine -> IO (Response String) response resources q = do logMessage q let r200 x = Response (2,0,0) "OK" [Header HdrContentType x] case webmode q of Just "suggest" -> fmap (r200 "application/json") $ runSuggest q Just "ajax" -> do dbs <- if isRight $ queryParsed q then fmap snd $ loadQueryDatabases (databases q) (fromRight $ queryParsed q) else return mempty return $ r200 "text/html" $ unlines $ runQuery dbs q Nothing -> do dbs <- if isRight $ queryParsed q then fmap snd $ loadQueryDatabases (databases q) (fromRight $ queryParsed q) else return mempty return $ r200 "text/html" $ unlines $ header resources (escapeHTML $ queryText q) ++ runQuery dbs q ++ footer Just e -> return $ r200 "text/html" $ "Unknown webmode: " ++ show e logMessage :: CmdLine -> IO () logMessage q = do time <- getCurrentTime cgi <- fmap (fromMaybe []) cgiArgs appendFile logFile $ (++ "\n") $ unwords $ [showGregorian (utctDay time) ,show (queryText q)] ++ ["?" ++ a ++ "=" ++ c ++ b ++ c | (a,b) <- cgi, let c = ['\"' | any isSpace b]] runSuggest :: CmdLine -> IO String runSuggest Search{queryText=q} = do root <- getDataDir db <- loadDatabase $ root > "default.hoo" let res = queryCompletions db q return $ "[" ++ show q ++ "," ++ show res ++ "]" runSuggest _ = return "" runQuery :: Database -> CmdLine -> [String] runQuery dbs Search{queryParsed = Left err} = ["
"
," Query: " ++ showTagHTMLWith f (parseInput err) ++ "
"
,"
"
," Error: " ++& errorMessage err ++ "
"
,"
" ," For information on what queries should look like, see the" ," user manual." ,"
" ] where f (TagEmph x) = Just $ "" ++ showTagHTMLWith f x ++ "" f _ = Nothing runQuery dbs q | isBlankQuery $ fromRight $ queryParsed q = welcome runQuery dbs cq@Search{queryParsed = Right q} = ["" ++ showTagHTML (transform qurl sug) ++ "
" | Just sug <- [querySuggestions dbs q]] ++ if null res then ["No results found
"] else ["