{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

-- | Server
module Ibb where

import Alpha
import Biz.Ibb
import qualified Biz.Ibb.Keep as Keep
import Data.Maybe (fromMaybe)
import Data.Acid (AcidState)
import qualified Data.Acid.Abstract as Acid
import qualified Lucid as L
import Lucid.Base
import Miso
import Network.HTTP.Types
import Network.RemoteData
import Network.Wai
import Network.Wai.Application.Static
import Network.Wai.Handler.Warp
import Network.Wai.Middleware.Gzip
import Network.Wai.Middleware.RequestLogger
import Servant
import System.Environment (lookupEnv)

main :: IO ()
main = do
  say "rise: ibb"
  port <- read
          <$> fromMaybe "3000"
          <$> lookupEnv "PORT" :: IO Int
  keep <- Keep.openLocal "keep/"
  say "port: 3000"
  run port $ logStdout $ compress $ app $ keep
    where
      compress = gzip def { gzipFiles = GzipCompress }

newtype HtmlPage a = HtmlPage a
  deriving (Show, Eq)

instance L.ToHtml a => L.ToHtml (HtmlPage a) where
  toHtmlRaw = L.toHtml
  toHtml (HtmlPage x) =
    L.doctypehtml_ $ do
      L.head_ $ do
        L.meta_ [L.charset_ "utf-8"]
        jsRef "/static/all.js"
      L.body_ (L.toHtml x)
    where
      jsRef href = L.with (L.script_ mempty)
        [ makeAttribute "src" href
        , makeAttribute "type" "text/javascript"
        , makeAttribute "async" mempty
        , makeAttribute "defer" mempty
        ]

type ServerRoutes = ToServerRoutes AppRoutes HtmlPage Action

handle404 :: Application
handle404 _ respond = respond
  $ responseLBS status404 [("Content-Type", "text/html")]
  $ renderBS
  $ toHtml
  $ HtmlPage
  $ notfound

type Routes = "static" :> Raw
  :<|> ServerRoutes
  :<|> "api" :> ApiRoutes
  :<|> Raw

app :: AcidState Keep.IbbKeep -> Application
app keep = serve
  (Proxy @Routes)
  $ static
  :<|> serverHandlers
  :<|> apiHandlers keep
  :<|> Tagged handle404
  where
    static = serveDirectoryWith (defaultWebAppSettings "ibb.jsexe")

type ApiRoutes =
  "people" :> Get '[JSON] [Person]

serverHandlers :: Server ServerRoutes
serverHandlers = homeHandler
  where
    send f u =
      pure $ HtmlPage $ f Model { uri = u, people = NotAsked }
    homeHandler = send home goHome

-- | for now we just have one api endpoint, which returns all the people
apiHandlers :: AcidState Keep.IbbKeep -> Server ApiRoutes
apiHandlers keep = do
  people <- Acid.query' keep $ Keep.GetPeople 20
  return $ people