{-# LANGUAGE OverloadedStrings #-}
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 ()
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
}
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
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
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)
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
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
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'
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"
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