{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- Developer allocation
--
-- : out devalloc-host
-- : dep clay
-- : dep cmark
-- : sys cmark
-- : dep envy
-- : dep lucid
-- : dep miso
-- : dep protolude
-- : dep servant
-- : dep servant-server
-- : dep warp
module Biz.Devalloc.Host
  ( main,
  )
where

import Alpha
import Biz.App (CSS (..), HtmlApp (..))
-- import qualified CMark as Cmark

import qualified Biz.Look
import qualified Biz.Devalloc.Core as Core
import qualified Biz.Devalloc.Path as Path
import qualified Clay
import qualified Control.Exception as Exception
import qualified Data.Text as Text
import qualified Lucid
import qualified Lucid.Base as Lucid
import Miso hiding (node)
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp
import Network.Wai.Middleware.RequestLogger (logStdout)
import Network.Wai.Application.Static (defaultWebAppSettings)
import Servant
import qualified System.Envy as Envy

main :: IO ()
main = Exception.bracket startup shutdown run
  where
    startup =
      Envy.decodeWithDefaults Envy.defConfig >>= \cfg -> do
        -- pitchText <- readFile <| pitches cfg
        -- let pitch = Cmark.commonmarkToHtml [] pitchText
        putText "@"
        putText "devalloc"
        putText <| "port: " <> (show <| port cfg)
        putText <| "node: " <> (Text.pack <| node cfg)
        let static = serveDirectoryWith <| defaultWebAppSettings <| node cfg
        return (cfg, serve (Proxy @AllPaths) <| serverHandlers static)
    shutdown :: (Config, Application) -> IO ()
    shutdown _ = pure ()
    run :: (Config, Wai.Application) -> IO ()
    run (cfg, app) = Warp.run (port cfg) (logStdout app)

type HostPaths = ToServerRoutes Path.Paths HtmlApp Core.Move

type AllPaths = ("static" :> Raw) :<|> HostPaths :<|> CssRoute

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

cssHandlers :: Server CssRoute
cssHandlers = return . toStrict <| Clay.render look

instance Lucid.ToHtml a => Lucid.ToHtml (HtmlApp a) where
  toHtmlRaw = Lucid.toHtml
  toHtml (HtmlApp x) =
    Lucid.doctypehtml_ <| do
      Lucid.head_ <| do
        Lucid.meta_ [Lucid.charset_ "utf-8"]
        jsRef "/static/all.js"
        cssRef "/css/main.css"
      Lucid.body_ (Lucid.toHtml x)
    where
      jsRef _href =
        Lucid.with
          (Lucid.script_ mempty)
          [ Lucid.makeAttribute "src" _href,
            Lucid.makeAttribute "async" mempty,
            Lucid.makeAttribute "defer" mempty
          ]
      cssRef _href =
        Lucid.with
          (Lucid.link_ mempty)
          [ Lucid.rel_ "stylesheet",
            Lucid.type_ "text/css",
            Lucid.href_ _href
          ]

data Config = Config
  { port :: Warp.Port,
    -- | A yaml file of pitches
    pitches :: FilePath,
    node :: FilePath
  }
  deriving (Generic, Show)

instance Envy.DefConfig Config where
  defConfig =
    Config
      { port = 3000,
        pitches = "./Biz/Devalloc/pitch.md",
        node = "_/bild/dev/static/devalloc.js"
      }

instance Envy.FromEnv Config

home :: Handler (HtmlApp (View Core.Move))
home =
  Core.Form {Core.uri = Path.home}
    |> Core.view
    |> HtmlApp
    |> pure

signup :: Handler (HtmlApp (View Core.Move))
signup =
  Core.Form {Core.uri = Path.signup}
    |> Core.view
    |> HtmlApp
    |> pure

serverHandlers :: Tagged Handler Application -> Server AllPaths
serverHandlers static = static :<|> (home :<|> signup) :<|> cssHandlers

look :: Clay.Css
look = do
  Biz.Look.fuckingStyle
  "body" Clay.? Biz.Look.fontStack