content: {-# LANGUAGE BlockArguments #-}
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE OverloadedRecordDot #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE RecordWildCards #-}
  
  module Main (main, handlers) where
  
  import Control.Monad (forM_)
  import Data.Aeson qualified as J
  import Data.Aeson.Key qualified as AK
  import Data.Aeson.KeyMap qualified as AKM
  import Data.ByteString.Builder qualified as BB
  import Data.ByteString.Char8 qualified as BS8
  import Data.ByteString.Lazy qualified as LBS
  import Data.ByteString.Lazy.Char8 qualified as LBS8
  import Data.CaseInsensitive qualified as CI
  import Data.Function (fix, (&))
  import Data.Text.Lazy qualified as LT
  import Data.Text.Lazy.Encoding qualified as LTE
  import Data.Vector.Unboxed.Mutable qualified as MU
  import Effectful
  import Effectful.Concurrent (Concurrent, runConcurrent)
  import Effectful.Prim
  import Effectful.Random.Static (Random, evalRandom, newStdGen, uniform)
  import Lucid
  import Network.HTTP.Types (encodePathSegments, renderQuery)
  import Steward.Demo.Fib.Types
  import Steward.Workers
  
  foreign export javascript "handlers" handlers :: IO JSHandlers
  
  handlers :: IO JSHandlers
  handlers = toJSHandlers Handlers {fetch = fetcher}
  
  type Bound = BindingsClass '[] '[] '[]
  
  fetcher :: FetchHandler Bound
  fetcher = runWorker $ do
    g <- newStdGen
    runConcurrent $ runPrim $ evalRandom g $ fromHandlers @Bound endpoints
  
  endpoints ::
    ( Random :> es
    , Prim :> es
    , Concurrent :> es
    , Worker Bound :> es
    ) =>
    FibEndpoints (Handler (Eff es))
  endpoints =
    FibEndpoints
      { random = Handler serveRandom
      , index = Handler indexPage
      , fib = Handler serveFib
      }
  
  serveFib ::
    (Prim :> es) =>
    Int ->
    Eff es FibResult
  serveFib n = do
    mv <- MU.new $ n + 1
    MU.write mv 0 0
    MU.write mv 1 1
    2 & fix \self !i ->
      if i > n
        then pure ()
        else do
          k <- MU.read mv $ i - 2
          l <- MU.read mv $ i - 1
          MU.write mv i $ k + l
          self $ i + 1
    result <- MU.read mv n
    pure FibResult {input = n, ..}
  
  indexPage ::
    (Worker Bound :> es) =>
    Eff es (Either LBS.ByteString (Html ()))
  indexPage = do
    mcf <- getCloudflareJSON @Bound
    req <- getStewardRequest @Bound
    pure $ Right $ buildResponseBody mcf req
  
  serveRandom ::
    (Concurrent :> es, Random :> es) =>
    Eff es Int
  serveRandom = uniform
  
  buildResponseBody :: Maybe J.Value -> StewardRequest -> Html ()
  buildResponseBody mcf req = do
    let method = show req.method
        url = toUrl req
        hdrs = req.headers
    doctype_
    html_ $ do
      head_ $ do
        title_ "Hello Worker, From GHC, with Love!"
        link_ [rel_ "stylesheet", href_ "https://cdn.simplecss.org/simple-v1.css"]
      body_ $ do
        h1_ "Hello Worker, From GHC, with Love!"
        p_ do
          "["
          a_ [href_ "https://github.com/konn/ghc-wasm-earthly/blob/main/steward-fib-demo/app/worker/Main.hs"] "Source Code"
          "]"
        h2_ "Info"
        p_ "Proudedly generated by GHC WASM backend."
        h2_ "Fibonacci!"
        p_ do
          "Calculate Fibonacci number (via Workers!): "
        p_ do
          input_ [type_ "text", id_ "fib-input", placeholder_ "12"]
          button_ [id_ "calc-fib"] "Fib"
        p_ do
          "Fib: "
          span_ [id_ "fib-result"] ""
        h2_ "Random Number Generation"
        p_ do
          "Generate a random number (via Workers!): "
          button_ [id_ "gen-rand"] "Random"
        p_ do
          "Random: "
          span_ [id_ "random-result"] ""
        h2_ "Metadata"
        table_ do
          thead_ do
            tr_ do
              th_ [scope_ "col"] "Property"
              th_ [scope_ "col"] "Value"
          tbody_ do
            tr_ do
              th_ [scope_ "row"] "Method"
              td_ $ toHtml method
            tr_ do
              th_ [scope_ "row"] "Url"
              td_ $ code_ $ toHtml url
        h2_ "Headers"
        table_ do
          thead_ do
            tr_ do
              th_ [scope_ "col"] "Header"
              th_ [scope_ "col"] "Value"
          tbody_ $ forM_ hdrs \(l, r) ->
            tr_ do
              th_ [scope_ "row"] $ toHtml $ BS8.unpack $ CI.foldedCase l
              td_ $ code_ $ toHtml $ BS8.unpack r
  
        h2_ "Cloudflare Workers Specific Request Properties"
        case mcf of
          Nothing -> p_ "N/A"
          Just (J.Array xs) -> ul_ $ mapM_ (li_ . toHtml . J.encode) xs
          Just (J.Object dic) -> table_ do
            thead_ do
              tr_ do
                th_ [scope_ "col"] "Property"
                th_ [scope_ "col"] "Value"
            let dic' =
                  AKM.toList $
                    AKM.delete "tlsExportedAuthenticator" $
                      AKM.delete "tlsClientExtensionsSha1" $
                        AKM.delete "tlsClientRandom" $
                          AKM.delete "tlsClientAuth" $
                            AKM.delete "botManagement" dic
            tbody_ $ forM_ dic' \(k, v) -> do
              tr_ do
                th_ [scope_ "row"] $ toHtml $ AK.toText k
                td_ $
                  code_ $
                    toHtml $
                      J.encode v
          Just v -> pre_ $ code_ $ toHtml $ J.encode v
        h2_ "Body"
        if LBS.null req.body
          then p_ "N/A"
          else pre_ $ code_ $ toHtml $ LTE.decodeUtf8 req.body
    script_ [type_ "text/javascript", async_ ""] startupScript
  
  startupScript :: LT.Text
  startupScript =
    LT.unlines
      [ "const fibButton = document.getElementById(\"calc-fib\");"
      , "fibButton.addEventListener('click', async () => {"
      , "  const fibInput = document.getElementById(\"fib-input\")"
      , "  const fibResult = document.getElementById(\"fib-result\")"
      , "  const num = fibInput.value;"
      , "  const resp = await fetch(`./fib/${num}`);"
      , "  const result = await resp.json();"
      , "  fibResult.innerText = JSON.stringify(result);"
      , "});"
      , "const randButton = document.getElementById(\"gen-rand\");"
      , "randButton.addEventListener('click', async () => {"
      , "  const randResult = document.getElementById(\"random-result\")"
      , "  const resp = await fetch(\"./random\");"
      , "  const result = await resp.json();"
      , "  randResult.innerText = JSON.stringify(result);"
      , "});"
      ]
  
  toUrl :: StewardRequest -> String
  toUrl req =
    let proto
          | req.secure = "https://"
          | otherwise = "http://"
     in LBS8.unpack $ BB.toLazyByteString $ proto <> BB.byteString req.host <> BB.byteString req.port <> encodePathSegments req.pathInfo <> BB.byteString (renderQuery True req.queryString)
  
  main :: IO ()
  main = pure ()
  