{-# 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 Devalloc.Host
  ( main,
  )
where

import Alpha
import Biz.App (CSS (..), HtmlApp (..))
import qualified Biz.Look
-- import qualified CMark as Cmark
import qualified Clay
import qualified Control.Exception as Exception
import qualified Devalloc.Page.Home as Home
import qualified Devalloc.Page.Signup as Signup
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 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)
        return (cfg, serve (Proxy @AllRoutes) <| serverHandlers)
    shutdown :: (Config, Application) -> IO ()
    shutdown _ = pure ()
    run :: (Config, Wai.Application) -> IO ()
    run (cfg, app) = Warp.run (port cfg) (logStdout app)

type HomeServer = ToServerRoutes Home.Path HtmlApp Home.Move

type SignupServer = ToServerRoutes Signup.Path HtmlApp Signup.Move

type AllRoutes = HomeServer :<|> SignupServer :<|> 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"
        jsRef "//unpkg.com/turbolinks@5.2.0/dist/turbolinks.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 = "./Devalloc/pitch.md",
        node = "_/bild/dev/Devalloc.Node/static"
      }

instance Envy.FromEnv Config

serverHandlers :: Server AllRoutes
serverHandlers = Home.host :<|> Signup.host :<|> cssHandlers

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