module Camera (camera) where

import Control.Exception (SomeException, catch)
import Data.Function ((&))
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Text (Text, intercalate, pack)
import Desktop.Portal (Client)
import Desktop.Portal qualified as Portal
import Monomer
import PipeWire (PipeWireCallbacks (..), PipeWireClient, RegistryObject (..))
import PipeWire qualified
import System.Posix.Types (Fd)

data CameraModel = CameraModel
  { portalClient :: Client,
    state :: CameraState
  }
  deriving (Eq, Show)

data CameraState
  = StateCheckingPresent
  | StateNotFound
  | StateAccessing
  | StateAccessDenied
  | StateOpeningPipeWire
  | StateOpenedPipeWire Fd
  | StateConnectedToPipewire PipeWireClient (Map Word RegistryObject)
  deriving (Eq, Show)

data CameraEvent
  = Init
  | Dispose
  | SetState CameraState
  | ShowAlert {title :: Text, body :: Text}
  | CamerasChanged (Map Word RegistryObject)

camera :: (CompParentModel s, CompositeEvent e) => Client -> (Text -> Text -> e) -> WidgetNode s e
camera portalClient parentAlert =
  compositeD_ "MonomerFlatpakExample.Camera" (WidgetValue initialModel) buildUI (handleEvent parentAlert) cfg
  where
    cfg = [onInit Init, onDispose Dispose]
    initialModel = CameraModel {portalClient, state = StateCheckingPresent}

buildUI :: UIBuilder CameraModel CameraEvent
buildUI _wenv model =
  label_ (lbl model.state) [multiline] `styleBasic` [padding 40]
  where
    lbl = \case
      StateCheckingPresent ->
        "Checking for camera..."
      StateAccessing ->
        "Requesting access to camera..."
      StateNotFound ->
        "Camera not found."
      StateAccessDenied ->
        "Camera access denied."
      StateOpeningPipeWire ->
        "Opening pipewire..."
      StateOpenedPipeWire fd ->
        "Opened pipewire: " <> pack (show fd)
      StateConnectedToPipewire _client cameras ->
        "Found cameras:\n\n" <> formatCameras cameras

formatCameras :: Map Word RegistryObject -> Text
formatCameras cameras =
  (formatCamera <$> Map.elems cameras)
    & intercalate "\n\n"
  where
    formatCamera c =
      Map.assocs c.props.items
        & fmap (\(key, value) -> key <> ": " <> value)
        & intercalate "\n"

handleEvent :: (Text -> Text -> ep) -> EventHandler CameraModel CameraEvent sp ep
handleEvent parentAlert _env _node model = \case
  Init ->
    [ Producer $ \emit -> do
        catchErrors "Checking for camera failed" emit $ do
          Portal.isCameraPresent model.portalClient >>= \case
            False -> emit (SetState StateNotFound)
            True -> do
              emit (SetState StateAccessing)
              Portal.accessCamera model.portalClient >>= Portal.await >>= \case
                Nothing -> emit (SetState StateAccessDenied)
                Just () -> do
                  emit (SetState StateOpeningPipeWire)
                  fd <- Portal.openPipeWireRemote model.portalClient
                  emit (SetState (StateOpenedPipeWire fd))
                  let cbs =
                        PipeWireCallbacks
                          { cameraAdded = \cameras _ -> emit (CamerasChanged cameras),
                            cameraRemoved = \cameras _ -> emit (CamerasChanged cameras)
                          }
                  pwClient <- PipeWire.run fd cbs
                  emit (SetState (StateConnectedToPipewire pwClient mempty))
                  -- need to keep thread alive so monomer keeps accepting our events!
                  PipeWire.waitForQuit pwClient
    ]
  Dispose ->
    [ Producer $ \_emit -> do
        case model.state of
          StateConnectedToPipewire pwClient _ ->
            PipeWire.quit pwClient
          _ ->
            pure ()
    ]
  SetState state ->
    [Model model {state}]
  ShowAlert {title, body} ->
    [Report (parentAlert title body)]
  CamerasChanged cameras ->
    case model.state of
      StateConnectedToPipewire client _cameras ->
        [Model model {state = StateConnectedToPipewire client cameras}]
      _ -> []

catchErrors :: Text -> (CameraEvent -> IO ()) -> IO () -> IO ()
catchErrors title emit cmd = catch cmd handler
  where
    handler (e :: SomeException) =
      emit (ShowAlert title (pack (show e)))