{-# 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           Alpha
import qualified Clay
import           Com.InfluencedByBooks.Core
import qualified Com.InfluencedByBooks.Keep    as Keep
import qualified Com.InfluencedByBooks.Look    as Look
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