{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}

module Hsm.Web
  ( Web
  , runServer
  , runWeb
  )
where

import Data.Aeson (encode)
import Data.Maybe (fromJust, isJust)
import Effectful (Dispatch (Static), DispatchOf, Eff, IOE, liftIO, (:>))
import Effectful.Concurrent (Concurrent)
import Effectful.Dispatch.Static
  ( SideEffects (WithSideEffects)
  , StaticRep
  , evalStaticRep
  , getStaticRep
  , unEff
  , unsafeEff
  )
import Effectful.Dispatch.Static.Primitive (Env)
import Effectful.Exception (finally)
import Effectful.Fail (Fail)
import Hsm.Drive (Action, Drive, drive)
import Hsm.GPIO (GPIO)
import Hsm.INA226 (I2CINA226, INA226, readINA226State)
import Hsm.Log (Logs, Severity (Info, Trace), logMsg, makeLoggerIO)
import Hsm.PWM (PWM)
import Hsm.Stream (Stream, isStreaming, startStream, stopStream)
import Network.HTTP.Types.Status (status400)
import Network.Wai.Handler.Warp (defaultSettings, setLogger)
import Network.Wai.Middleware.Static (addBase, noDots, staticPolicy, (>->))
import Paths_hsm_web (getDataFileName)
import Text.Read (readMaybe)
import Web.Scotty
  ( Options (settings, verbose)
  , defaultOptions
  , file
  , get
  , middleware
  , queryParamMaybe
  , raw
  , scottyOpts
  , setHeader
  , status
  )

data Web (a :: * -> *) (b :: *)

type instance DispatchOf Web = Static WithSideEffects

newtype instance StaticRep Web
  = Web Options

server
  :: ( Concurrent :> es
     , Drive :> es
     , Fail :> es
     , GPIO :> es
     , I2CINA226 :> es
     , INA226 :> es
     , Logs '["drive", "gpio", "gst", "i2c", "ina226", "pwm", "stream"] es
     , PWM :> es
     , Stream :> es
     )
  => Options
  -> Env es
  -> IO ()
server options env = do
  dist <- getDataFileName "Client/dist/"
  scottyOpts options $ do
    -- Index and static files
    middleware . staticPolicy $ noDots >-> addBase dist
    get "/" . file $ dist <> "index.html"
    -- Battery status
    get "/ina226" $ do
      setHeader "Content-Type" "application/json"
      res <- liftIO $ unEff readINA226State env
      raw $ encode res
    -- Camera stream control endpoints
    get "/startStream" . liftIO $ unEff startStream env
    get "/stopStream" $ liftIO $ unEff stopStream env
    get "/isStreaming" $ do
      setHeader "Content-Type" "text/plain"
      res <- liftIO $ unEff isStreaming env
      raw $ encode res
    -- Motion control
    get "/command" $ do
      cmd <- (>>= readMaybe @Action) <$> queryParamMaybe "cmd"
      if isJust cmd
        then liftIO $ unEff (drive [fromJust cmd]) env
        else status status400

runServer
  :: ( Concurrent :> es
     , Drive :> es
     , Fail :> es
     , GPIO :> es
     , I2CINA226 :> es
     , INA226 :> es
     , Logs '["drive", "gpio", "gst", "i2c", "ina226", "pwm", "stream", "web"] es
     , PWM :> es
     , Stream :> es
     , Web :> es
     )
  => Eff es ()
runServer = finally startServer stopServer
  where
    startServer = do
      Web options <- getStaticRep
      logMsg @"web" Info "Starting scotty web server"
      unsafeEff $ server options
    stopServer = logMsg @"web" Info "Stopping scotty web server"

runWeb :: (IOE :> es, Logs '["scotty", "web"] es) => Eff (Web : es) a -> Eff es a
runWeb action = do
  logMsg @"web" Info "Registering logger for scotty web server"
  scottyLogger <- logRequest <$> makeLoggerIO @"scotty"
  evalStaticRep (Web $ options scottyLogger) action
  where
    logRequest loggerIO request code fileSize = loggerIO Trace $ unwords [show request, show code, show fileSize]
    options logger = defaultOptions{verbose = 0, settings = setLogger logger defaultSettings}