{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

-- | Server
--
-- : exe ibb
--
-- : dep clay
-- : dep miso
-- : dep protolude
-- : dep servant
-- : dep text
-- : dep MonadRandom
-- : dep acid-state
-- : dep bytestring
-- : dep ixset
-- : dep random
-- : dep safecopy
-- : dep scotty
-- : dep servant-server
-- : dep text
module Com.InfluencedByBooks.Server where

import qualified Clay
import           Com.InfluencedByBooks.Core
import qualified Com.InfluencedByBooks.Keep as Keep
import qualified Com.InfluencedByBooks.Look as Look
import           Com.Simatime.Alpha
import           Com.Simatime.Network
import           Data.Acid (AcidState)
import qualified Data.Acid.Abstract as Acid
import           Data.Maybe (fromMaybe)
import qualified Data.Text.Lazy as Lazy
import qualified Data.Text.Lazy.Encoding as Lazy
import qualified Lucid as L
import           Lucid.Base
import           Miso
import           Network.HTTP.Media ((//), (/:))
import           Network.HTTP.Types
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"
  staticDir <- fromMaybe "static"
    <$> lookupEnv "STATIC_DIR" :: IO [Char]
  port <- read
    <$> fromMaybe "3000"
    <$> lookupEnv "PORT" :: IO Int
  keep <- Keep.openLocal "_keep/"
  say "port: 3000"
  run port $ logStdout $ compress $ app staticDir $ 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/ibb.js"
        cssRef "/css/main.css"
      L.body_ $ do
        page
    where
      page = L.toHtml x
      jsRef href = L.with (L.script_ mempty)
        [ makeAttribute "src" href
        , makeAttribute "type" "text/javascript"
        , makeAttribute "async" mempty
        , makeAttribute "defer" mempty
        ]
      cssRef href = L.with
        (L.link_ mempty)
        [L.rel_ "stylesheet", L.type_ "text/css", L.href_ href]

type ServerRoutes = ToServerRoutes AppRoutes HtmlPage Action

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

newtype CSS = CSS { unCSS :: Text }

instance MimeRender CSS Text where
  mimeRender _ = Lazy.encodeUtf8 . Lazy.fromStrict

instance Accept CSS where
  contentType _ = "text" // "css" /: ("charset", "utf-8")

type CssRoute = "css" :> "main.css" :> Get '[CSS] Text

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

cssHandlers :: Server CssRoute
cssHandlers = return . Lazy.toStrict . Clay.render
    $ Look.main

app :: [Char] -> AcidState Keep.IbbKeep -> Application
app staticDir keep = serve
  (Proxy @Routes)
  $ static
  :<|> cssHandlers
  :<|> serverHandlers
  :<|> apiHandlers keep
  :<|> Tagged handle404
  where
    static = serveDirectoryWith
      (defaultWebAppSettings $ staticDir)

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 =
  Acid.query' keep $ Keep.GetPeople 20