{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Main entry point for the Swarm application.
module Swarm.App where

import Brick
import Brick.BChan
import Control.Carrier.Lift (runM)
import Control.Carrier.Throw.Either (runThrow)
import Control.Concurrent (forkIO, threadDelay)
import Control.Lens (view, (%~), (&), (?~))
import Control.Monad (forever, void, when)
import Control.Monad.IO.Class (liftIO)
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.Failure (SystemFailure)
import Swarm.Language.Pretty (prettyText)
import Swarm.Log (LogSource (SystemLog), Severity (..))
import Swarm.ReadableIORef (mkReadonly)
import Swarm.TUI.Controller
import Swarm.TUI.Model
import Swarm.TUI.Model.StateUpdate
import Swarm.TUI.Model.UI (uiAttrMap)
import Swarm.TUI.View
import Swarm.Version (getNewerReleaseVersion)
import Swarm.Web
import System.IO (stderr)

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

-- | The configuration of the Swarm app which we pass to 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 s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState AttrMap
uiAttrMap
    }

-- | 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 SystemFailure AppState
res <- forall (m :: * -> *) a. LiftC m a -> m a
runM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ThrowC e m a -> m (Either e a)
runThrow forall a b. (a -> b) -> a -> b
$ forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AppOpts -> m AppState
initAppState AppOpts
opts
  case Either SystemFailure AppState
res of
    Left SystemFailure
err -> Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr (forall a. PrettyPrec a => a -> Text
prettyText @SystemFailure SystemFailure
err)
    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 <- Maybe GitInfo -> IO (Either NewReleaseFailure String)
getNewerReleaseVersion (AppOpts -> Maybe GitInfo
repoGitInfo AppOpts
opts)
        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.
      -- NOTE: This reference should be considered read-only by
      -- the web service; the game alone shall host the canonical state.
      IORef AppState
appStateRef <- forall a. a -> IO (IORef a)
newIORef AppState
s
      Either String Int
eport <-
        Maybe Int
-> ReadableIORef AppState
-> BChan AppEvent
-> IO (Either String Int)
Swarm.Web.startWebThread
          (AppOpts -> Maybe Int
userWebPort AppOpts
opts)
          (forall a. IORef a -> ReadableIORef a
mkReadonly IORef AppState
appStateRef)
          BChan AppEvent
chan

      let logP :: a -> Notifications LogEntry -> Notifications LogEntry
logP a
p = LogSource
-> Severity
-> Text
-> Text
-> Notifications LogEntry
-> Notifications LogEntry
logEvent LogSource
SystemLog Severity
Info Text
"Web API" (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
-> Severity
-> Text
-> Text
-> Notifications LogEntry
-> Notifications LogEntry
logEvent LogSource
SystemLog Severity
Error Text
"Web API" (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 AppState
appStateRef AppState
curSt
            EventHandler
handleEvent BrickEvent Name AppEvent
e

      -- Setup virtual terminal
      let buildVty :: IO Vty
buildVty = Config -> IO Vty
V.mkVty forall a b. (a -> b) -> a -> b
$ Config
V.defaultConfig {colorMode :: Maybe ColorMode
V.colorMode = AppOpts -> Maybe ColorMode
colorMode AppOpts
opts}
      Vty
initialVty <- IO Vty
buildVty
      Output -> Mode -> Bool -> IO ()
V.setMode (Vty -> Output
V.outputIface Vty
initialVty) Mode
V.Mouse Bool
True

      -- Run the app.
      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 SystemFailure AppState
res <-
    forall (m :: * -> *) a. LiftC m a -> m a
runM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ThrowC e m a -> m (Either e a)
runThrow forall a b. (a -> b) -> a -> b
$ forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AppOpts -> m AppState
initAppState (AppOpts
defaultAppOpts {userScenario :: Maybe String
userScenario = Maybe String
demoScenario})
  case Either SystemFailure AppState
res of
    Left SystemFailure
err -> Text -> IO ()
T.putStrLn (forall a. PrettyPrec a => a -> Text
prettyText @SystemFailure SystemFailure
err)
    Right AppState
s -> do
      IORef AppState
appStateRef <- forall a. a -> IO (IORef a)
newIORef AppState
s
      BChan AppEvent
chan <- forall a. Int -> IO (BChan a)
newBChan Int
5
      Maybe (MVar WebStartResult)
-> Int -> ReadableIORef AppState -> BChan AppEvent -> IO ()
webMain
        forall a. Maybe a
Nothing
        Int
demoPort
        (forall a. IORef a -> ReadableIORef a
mkReadonly IORef AppState
appStateRef)
        BChan AppEvent
chan
 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