{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE TypeFamilies #-}

module Hsm.Stream
  ( Stream
  , startStream
  , stopStream
  , runStream
  )
where

import Control.Monad (void, when)
import Effectful (Dispatch (Static), DispatchOf, Eff, IOE, liftIO, (:>))
import Effectful.Dispatch.Static (SideEffects (WithSideEffects), StaticRep, evalStaticRep, getStaticRep, unsafeEff_)
import Effectful.Exception (finally)
import Foreign.C.String (withCString)
import Foreign.Ptr (Ptr, nullPtr)
import Hsm.Log (Log, Severity (Info), logMsg)
import Hsm.Stream.FFI
  ( GstElement
  , gstDeinit
  , gstElementSetState
  , gstInit
  , gstObjectUnref
  , gstParseLaunch
  , gstStateNull
  , gstStatePlaying
  )
import System.Environment (setEnv)

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

type instance DispatchOf Stream = Static WithSideEffects

newtype instance StaticRep Stream
  = Stream (Ptr GstElement)

startStream :: (Log "stream" :> es, Stream :> es) => Eff es ()
startStream = do
  Stream pipeline <- getStaticRep
  logMsg Info "Starting stream"
  unsafeEff_ . void $ gstElementSetState pipeline gstStatePlaying

stopStream :: (Log "stream" :> es, Stream :> es) => Eff es ()
stopStream = do
  Stream pipeline <- getStaticRep
  logMsg Info "Stopping stream"
  unsafeEff_ . void $ gstElementSetState pipeline gstStateNull

runStream :: (IOE :> es, Log "stream" :> es) => Bool -> Eff (Stream : es) a -> Eff es a
runStream suppressXLogs action = do
  when suppressXLogs $ do
    logMsg Info "Suppressing external loggers"
    liftIO $ setEnv "GST_DEBUG" "none"
    liftIO $ setEnv "LIBCAMERA_LOG_LEVELS" "FATAL"
    liftIO $ setEnv "WEBRTCSINK_SIGNALLING_SERVER_LOG" "none"
  logMsg Info "Initializing gstreamer library"
  liftIO $ gstInit nullPtr nullPtr
  logMsg Info $ "Parsing gstreamer pipeline: " <> pipelineStr
  pipeline <- liftIO . withCString pipelineStr $ \cStr -> gstParseLaunch cStr nullPtr
  evalStaticRep (Stream pipeline) . finally action $ stopStream >> endStream
  where
    pipelineStr = "libcamerasrc ! videoconvert ! vp8enc deadline=1 ! webrtcsink run-signalling-server=true"
    endStream = do
      Stream pipeline <- getStaticRep
      logMsg Info "Unrefing gstreamer pipeline"
      liftIO $ gstObjectUnref pipeline
      logMsg Info "De-initializing gstreamer library"
      liftIO gstDeinit