Application.hs

module Web.Hyperbole.Application
  ( waiApplication
  , Wai
  ) where

import Data.ByteString (ByteString)
import Data.ByteString.Lazy qualified as L
import Data.String.Conversions (cs)
import Effectful
import Effectful.Wai
import Network.HTTP.Types (status200, status301, status400, status404)
import Network.HTTP.Types.Header (HeaderName)
import Network.Wai
import Web.Hyperbole.Route
import Web.View.Types (Url (..))


waiApplication :: (Route route) => (L.ByteString -> L.ByteString) -> (route -> Eff [Wai, IOE] ()) -> Application
waiApplication toDoc actions request respond = do
  -- let (method, paths, query) = (requestMethod req, pathInfo req, queryString req)
  case findRoute (pathInfo request) of
    Nothing -> respond $ responseLBS status404 [contentType ContentText] "Not Found"
    Just rt -> do
      res <- runEff . runWai request $ actions rt
      case res of
        Left err -> interrupt err
        Right resp -> sendResponse resp
 where
  findRoute [] = Just defRoute
  findRoute ps = matchRoute (Path True ps)

  -- convert to document if GET. Subsequent POST requests will only include fragments
  addDocument "GET" bd = toDoc bd
  addDocument _ bd = bd

  contentType :: ContentType -> (HeaderName, ByteString)
  contentType ContentHtml = ("Content-Type", "text/html; charset=utf-8")
  contentType ContentText = ("Content-Type", "text/plain; charset=utf-8")

  sendResponse :: Handler -> IO ResponseReceived
  sendResponse resp = do
    let headers = contentType resp.contentType : resp.headers
        respBody = addDocument (requestMethod request) resp.body
    respond $ responseLBS status200 headers respBody

  interrupt NotFound =
    respond $ responseLBS status404 [contentType ContentText] "Not Found"
  interrupt (ParseError e) = do
    -- TODO: logging!
    putStrLn $ "Parse Error: " <> cs e
    respond $ responseLBS status400 [contentType ContentText] $ "Parse Error: " <> cs e
  interrupt (Redirect (Url u)) =
    respond $ responseLBS status301 [("Location", cs u)] ""
  interrupt (RespondNow resp) = do
    sendResponse resp


{- | Run both the http and ws application
application :: (Route route) => (L.ByteString -> L.ByteString) -> (route -> Eff [Wai, IOE] ()) -> Application
application toDoc actions =
  websocketsOr connectionOptions (socketApplication talk)
    $ httpApplication toDoc actions
-}

-- talk :: (Socket :> es) => Eff es ()
-- talk = do
--   msg :: Text <- receiveData
--
--   -- HANDLE ACTION?
--   -- SEND VIEW (possibly multiple times). Need to run action...
--
--   sendCommand $ Render [Text $ "Updated: " <> msg]