{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      :  Swarm.App
-- Copyright   :  Brent Yorgey
-- Maintainer  :  byorgey@gmail.com
--
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Main entry point for the Swarm application.
module Swarm.App where

import Brick
import Brick.BChan
import Control.Concurrent (forkIO, threadDelay)
import Control.Lens ((%~), (&), (?~), (^.))
import Control.Monad.Except
import Data.IORef (newIORef, writeIORef)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Graphics.Vty qualified as V
import Swarm.Game.Robot (LogSource (ErrorTrace, Said))
import Swarm.TUI.Attr
import Swarm.TUI.Controller
import Swarm.TUI.Model
import Swarm.TUI.View
import Swarm.Version (getNewerReleaseVersion)
import Swarm.Web
import System.IO (stderr)

type EventHandler = BrickEvent Name AppEvent -> EventM Name AppState ()

-- | The definition of the app used by the @brick@ library.
app :: EventHandler -> App AppState AppEvent Name
app :: EventHandler -> App AppState AppEvent Name
app EventHandler
eventHandler =
  App
    { appDraw :: AppState -> [Widget Name]
appDraw = AppState -> [Widget Name]
drawUI
    , appChooseCursor :: AppState -> [CursorLocation Name] -> Maybe (CursorLocation Name)
appChooseCursor = forall n.
AppState -> [CursorLocation n] -> Maybe (CursorLocation n)
chooseCursor
    , appHandleEvent :: EventHandler
appHandleEvent = EventHandler
eventHandler
    , appStartEvent :: EventM Name AppState ()
appStartEvent = forall n s. EventM n s ()
enablePasteMode
    , appAttrMap :: AppState -> AttrMap
appAttrMap = forall a b. a -> b -> a
const AttrMap
swarmAttrMap
    }

-- | The main @IO@ computation which initializes the state, sets up
--   some communication channels, and runs the UI.
appMain :: AppOpts -> IO ()
appMain :: AppOpts -> IO ()
appMain AppOpts
opts = do
  Either Text AppState
res <- forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ AppOpts -> ExceptT Text IO AppState
initAppState AppOpts
opts
  case Either Text AppState
res of
    Left Text
errMsg -> Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr Text
errMsg
    Right AppState
s -> do
      -- Send Frame events as at a reasonable rate for 30 fps. The
      -- game is responsible for figuring out how many steps to take
      -- each frame to achieve the desired speed, regardless of the
      -- frame rate.  Note that if the game cannot keep up with 30
      -- fps, it's not a problem: the channel will fill up and this
      -- thread will block.  So the force of the threadDelay is just
      -- to set a *maximum* possible frame rate.
      --
      -- 5 is the size of the bounded channel; when it gets that big,
      -- any writes to it will block.  Probably 1 would work fine,
      -- though it seems like it could be good to have a bit of buffer
      -- just so the app never has to wait for the thread to wake up
      -- and do another write.

      BChan AppEvent
chan <- forall a. Int -> IO (BChan a)
newBChan Int
5
      ThreadId
_ <- IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
          Int -> IO ()
threadDelay Int
33_333 -- cap maximum framerate at 30 FPS
          forall a. BChan a -> a -> IO ()
writeBChan BChan AppEvent
chan AppEvent
Frame

      ThreadId
_ <- IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ do
        Either NewReleaseFailure String
upRel <- IO (Either NewReleaseFailure String)
getNewerReleaseVersion
        forall a. BChan a -> a -> IO ()
writeBChan BChan AppEvent
chan (Either NewReleaseFailure String -> AppEvent
UpstreamVersion Either NewReleaseFailure String
upRel)

      -- Start the web service with a reference to the game state
      IORef GameState
gsRef <- forall a. a -> IO (IORef a)
newIORef (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState)
      Either String Int
eport <- Maybe Int -> IORef GameState -> IO (Either String Int)
Swarm.Web.startWebThread (AppOpts -> Maybe Int
userWebPort AppOpts
opts) IORef GameState
gsRef

      let logP :: a -> Notifications LogEntry -> Notifications LogEntry
logP a
p = LogSource
-> (Text, Int)
-> Text
-> Notifications LogEntry
-> Notifications LogEntry
logEvent LogSource
Said (Text
"Web API", -Int
2) (Text
"started on :" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show a
p))
      let logE :: String -> Notifications LogEntry -> Notifications LogEntry
logE String
e = LogSource
-> (Text, Int)
-> Text
-> Notifications LogEntry
-> Notifications LogEntry
logEvent LogSource
ErrorTrace (Text
"Web API", -Int
2) (String -> Text
T.pack String
e)
      let s' :: AppState
s' =
            AppState
s forall a b. a -> (a -> b) -> b
& Lens' AppState RuntimeState
runtimeState
              forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ case Either String Int
eport of
                Right Int
p -> (Lens' RuntimeState (Maybe Int)
webPort forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Int
p) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lens' RuntimeState (Notifications LogEntry)
eventLog forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall {a}.
Show a =>
a -> Notifications LogEntry -> Notifications LogEntry
logP Int
p)
                Left String
e -> Lens' RuntimeState (Notifications LogEntry)
eventLog forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ String -> Notifications LogEntry -> Notifications LogEntry
logE String
e

      -- Update the reference for every event
      let eventHandler :: EventHandler
eventHandler BrickEvent Name AppEvent
e = do
            AppState
curSt <- forall s (m :: * -> *). MonadState s m => m s
get
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef GameState
gsRef (AppState
curSt forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState)
            EventHandler
handleEvent BrickEvent Name AppEvent
e

      -- Run the app.
      let buildVty :: IO Vty
buildVty = Config -> IO Vty
V.mkVty Config
V.defaultConfig
      Vty
initialVty <- IO Vty
buildVty
      Output -> Mode -> Bool -> IO ()
V.setMode (Vty -> Output
V.outputIface Vty
initialVty) Mode
V.Mouse Bool
True
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall n e s.
Ord n =>
Vty -> IO Vty -> Maybe (BChan e) -> App s e n -> s -> IO s
customMain Vty
initialVty IO Vty
buildVty (forall a. a -> Maybe a
Just BChan AppEvent
chan) (EventHandler -> App AppState AppEvent Name
app EventHandler
eventHandler) AppState
s'

-- | A demo program to run the web service directly, without the terminal application.
-- This is useful to live update the code using `ghcid -W --test "Swarm.App.demoWeb"`
demoWeb :: IO ()
demoWeb :: IO ()
demoWeb = do
  let demoPort :: Int
demoPort = Int
8080
  Either Text AppState
res <-
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$
      AppOpts -> ExceptT Text IO AppState
initAppState forall a b. (a -> b) -> a -> b
$
        AppOpts
          { userSeed :: Maybe Int
userSeed = forall a. Maybe a
Nothing
          , userScenario :: Maybe String
userScenario = Maybe String
demoScenario
          , toRun :: Maybe String
toRun = forall a. Maybe a
Nothing
          , cheatMode :: Bool
cheatMode = Bool
False
          , userWebPort :: Maybe Int
userWebPort = forall a. Maybe a
Nothing
          }
  case Either Text AppState
res of
    Left Text
errMsg -> Text -> IO ()
T.putStrLn Text
errMsg
    Right AppState
s -> do
      IORef GameState
gsRef <- forall a. a -> IO (IORef a)
newIORef (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState)
      Maybe (MVar (Either String ())) -> Int -> IORef GameState -> IO ()
webMain forall a. Maybe a
Nothing Int
demoPort IORef GameState
gsRef
 where
  demoScenario :: Maybe String
demoScenario = forall a. a -> Maybe a
Just String
"./data/scenarios/Testing/475-wait-one.yaml"

-- | If available for the terminal emulator, enable bracketed paste mode.
enablePasteMode :: EventM n s ()
enablePasteMode :: forall n s. EventM n s ()
enablePasteMode = do
  Vty
vty <- forall n s. EventM n s Vty
getVtyHandle
  let output :: Output
output = Vty -> Output
V.outputIface Vty
vty
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Output -> Mode -> Bool
V.supportsMode Output
output Mode
V.BracketedPaste) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
      Output -> Mode -> Bool -> IO ()
V.setMode Output
output Mode
V.BracketedPaste Bool
True