{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- A web service for Swarm.
--
-- The service can be started using the `--port 5357` command line argument,
-- or through the REPL by calling `Swarm.App.demoWeb`.
--
-- See 'SwarmAPI' for the available endpoints. You can also see them in your
-- browser on the top level endpoint:
-- @lynx localhost:5357 -dump@
-- or you can output the markdown documentation to your terminal:
-- @cabal run swarm -O0 -- generate endpoints@
--
-- Missing endpoints:
--
--   * TODO: #625 run endpoint to load definitions
--   * TODO: #493 export the whole game state
module Swarm.Web (
  startWebThread,
  defaultPort,

  -- ** Docs
  SwarmAPI,
  swarmApiHtml,
  swarmApiMarkdown,

  -- ** Development
  webMain,
) where

import Brick.BChan
import Commonmark qualified as Mark (commonmark, renderHtml)
import Control.Arrow (left)
import Control.Concurrent (forkIO)
import Control.Concurrent.MVar
import Control.Exception (Exception (displayException), IOException, catch, throwIO)
import Control.Lens
import Control.Monad (void)
import Control.Monad.IO.Class (liftIO)
import Data.ByteString.Lazy (ByteString)
import Data.Foldable (toList)
import Data.IntMap qualified as IM
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as M
import Data.Map.NonEmpty qualified as NEM
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Lazy.Encoding (encodeUtf8)
import Data.Tree (Tree (Node), drawTree)
import Network.HTTP.Types (ok200)
import Network.Wai (responseLBS)
import Network.Wai qualified
import Network.Wai.Application.Static (defaultFileServerSettings, ssIndices)
import Network.Wai.Handler.Warp qualified as Warp
import Servant
import Servant.Docs (ToCapture)
import Servant.Docs qualified as SD
import Servant.Docs.Internal qualified as SD (renderCurlBasePath)
import Swarm.Doc.Command
import Swarm.Game.Entity (EntityName, entityName)
import Swarm.Game.Robot
import Swarm.Game.Scenario.Objective
import Swarm.Game.Scenario.Objective.Graph
import Swarm.Game.Scenario.Objective.WinCheck
import Swarm.Game.Scenario.Topography.Area (AreaDimensions (..))
import Swarm.Game.Scenario.Topography.Structure.Recognition
import Swarm.Game.Scenario.Topography.Structure.Recognition.Log
import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry
import Swarm.Game.State
import Swarm.Game.State.Robot
import Swarm.Game.State.Substate
import Swarm.Game.Step.Path.Type
import Swarm.Language.Pipeline (processTermEither)
import Swarm.Language.Pretty (prettyTextLine)
import Swarm.TUI.Model hiding (SwarmKeyDispatchers (..))
import Swarm.TUI.Model.Goal
import Swarm.TUI.Model.Repl (REPLHistItem, replHistory, replSeq)
import Swarm.TUI.Model.UI
import Swarm.Util.ReadableIORef
import Swarm.Util.RingBuffer
import Swarm.Web.Worldview
import System.Timeout (timeout)
import Text.Read (readEither)
import WaiAppStatic.Types (unsafeToPiece)
import Witch (into)

-- ------------------------------------------------------------------
-- Docs
-- ------------------------------------------------------------------

newtype RobotID = RobotID Int

type SwarmAPI =
  "robots" :> Get '[JSON] [Robot]
    :<|> "robot" :> Capture "id" RobotID :> Get '[JSON] (Maybe Robot)
    :<|> "goals" :> "prereqs" :> Get '[JSON] [PrereqSatisfaction]
    :<|> "goals" :> "active" :> Get '[JSON] [Objective]
    :<|> "goals" :> "graph" :> Get '[JSON] (Maybe GraphInfo)
    :<|> "goals" :> "uigoal" :> Get '[JSON] GoalTracking
    :<|> "goals" :> Get '[JSON] WinCondition
    :<|> "recognize" :> "log" :> Get '[JSON] [SearchLog EntityName]
    :<|> "recognize" :> "found" :> Get '[JSON] [StructureLocation]
    :<|> "code" :> "render" :> ReqBody '[PlainText] T.Text :> Post '[PlainText] T.Text
    :<|> "code" :> "run" :> ReqBody '[PlainText] T.Text :> Post '[PlainText] T.Text
    :<|> "paths" :> "log" :> Get '[JSON] (RingBuffer CacheLogEntry)
    :<|> "commands" :> Get '[JSON] CommandCatalog
    :<|> "repl" :> "history" :> "full" :> Get '[JSON] [REPLHistItem]
    :<|> "map" :> Capture "size" AreaDimensions :> Get '[JSON] GridResponse

swarmApi :: Proxy SwarmAPI
swarmApi :: Proxy SwarmAPI
swarmApi = Proxy SwarmAPI
forall {k} (t :: k). Proxy t
Proxy

type ToplevelAPI =
  SwarmAPI
    :<|> "api" :> Raw
    :<|> Raw

api :: Proxy ToplevelAPI
api :: Proxy ToplevelAPI
api = Proxy ToplevelAPI
forall {k} (t :: k). Proxy t
Proxy

swarmApiHtml :: ByteString
swarmApiHtml :: ByteString
swarmApiHtml =
  Text -> ByteString
encodeUtf8
    (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseError -> Text)
-> (Html () -> Text) -> Either ParseError (Html ()) -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> (ParseError -> String) -> ParseError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> String
forall a. Show a => a -> String
show) (forall a. Html a -> Text
Mark.renderHtml @())
    (Either ParseError (Html ()) -> Text)
-> (Text -> Either ParseError (Html ())) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text -> Either ParseError (Html ())
forall il bl.
IsBlock il bl =>
String -> Text -> Either ParseError bl
Mark.commonmark String
""
    (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
swarmApiMarkdown

swarmApiMarkdown :: String
swarmApiMarkdown :: String
swarmApiMarkdown =
  RenderingOptions -> API -> String
SD.markdownWith
    ( RenderingOptions
SD.defRenderingOptions
        RenderingOptions
-> (RenderingOptions -> RenderingOptions) -> RenderingOptions
forall a b. a -> (a -> b) -> b
& (ShowContentTypes -> Identity ShowContentTypes)
-> RenderingOptions -> Identity RenderingOptions
Lens' RenderingOptions ShowContentTypes
SD.requestExamples ((ShowContentTypes -> Identity ShowContentTypes)
 -> RenderingOptions -> Identity RenderingOptions)
-> ShowContentTypes -> RenderingOptions -> RenderingOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ShowContentTypes
SD.FirstContentType
        RenderingOptions
-> (RenderingOptions -> RenderingOptions) -> RenderingOptions
forall a b. a -> (a -> b) -> b
& (ShowContentTypes -> Identity ShowContentTypes)
-> RenderingOptions -> Identity RenderingOptions
Lens' RenderingOptions ShowContentTypes
SD.responseExamples ((ShowContentTypes -> Identity ShowContentTypes)
 -> RenderingOptions -> Identity RenderingOptions)
-> ShowContentTypes -> RenderingOptions -> RenderingOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ShowContentTypes
SD.FirstContentType
        RenderingOptions
-> (RenderingOptions -> RenderingOptions) -> RenderingOptions
forall a b. a -> (a -> b) -> b
& (Maybe String -> Identity (Maybe String))
-> RenderingOptions -> Identity RenderingOptions
Lens' RenderingOptions (Maybe String)
SD.renderCurlBasePath ((Maybe String -> Identity (Maybe String))
 -> RenderingOptions -> Identity RenderingOptions)
-> String -> RenderingOptions -> RenderingOptions
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ String
"http://localhost:" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Port -> String
forall a. Show a => a -> String
show Port
defaultPort
    )
    (API -> String) -> API -> String
forall a b. (a -> b) -> a -> b
$ [DocIntro] -> Proxy SwarmAPI -> API
forall {k} (api :: k).
HasDocs api =>
[DocIntro] -> Proxy api -> API
SD.docsWithIntros [DocIntro
intro] Proxy SwarmAPI
swarmApi
 where
  intro :: DocIntro
intro = String -> [String] -> DocIntro
SD.DocIntro String
"Swarm Web API" [String
"All of the valid endpoints are documented below."]

-- ------------------------------------------------------------------
-- Handlers
-- ------------------------------------------------------------------

mkApp ::
  ReadableIORef AppState ->
  -- | Writable channel to send events to the game
  BChan AppEvent ->
  Servant.Server SwarmAPI
mkApp :: ReadableIORef AppState -> BChan AppEvent -> Server SwarmAPI
mkApp ReadableIORef AppState
state BChan AppEvent
events =
  ReadableIORef AppState -> Handler [Robot]
robotsHandler ReadableIORef AppState
state
    Handler [Robot]
-> ((RobotID -> Handler (Maybe Robot))
    :<|> (Handler [PrereqSatisfaction]
          :<|> (Handler [Objective]
                :<|> (Handler (Maybe GraphInfo)
                      :<|> (Handler GoalTracking
                            :<|> (Handler WinCondition
                                  :<|> (Handler [SearchLog Text]
                                        :<|> (Handler [StructureLocation]
                                              :<|> ((Text -> Handler Text)
                                                    :<|> ((Text -> Handler Text)
                                                          :<|> (Handler (RingBuffer CacheLogEntry)
                                                                :<|> (Handler CommandCatalog
                                                                      :<|> (Handler [REPLHistItem]
                                                                            :<|> (AreaDimensions
                                                                                  -> Handler
                                                                                       GridResponse))))))))))))))
-> Handler [Robot]
   :<|> ((RobotID -> Handler (Maybe Robot))
         :<|> (Handler [PrereqSatisfaction]
               :<|> (Handler [Objective]
                     :<|> (Handler (Maybe GraphInfo)
                           :<|> (Handler GoalTracking
                                 :<|> (Handler WinCondition
                                       :<|> (Handler [SearchLog Text]
                                             :<|> (Handler [StructureLocation]
                                                   :<|> ((Text -> Handler Text)
                                                         :<|> ((Text -> Handler Text)
                                                               :<|> (Handler
                                                                       (RingBuffer CacheLogEntry)
                                                                     :<|> (Handler CommandCatalog
                                                                           :<|> (Handler
                                                                                   [REPLHistItem]
                                                                                 :<|> (AreaDimensions
                                                                                       -> Handler
                                                                                            GridResponse))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> ReadableIORef AppState -> RobotID -> Handler (Maybe Robot)
robotHandler ReadableIORef AppState
state
    (RobotID -> Handler (Maybe Robot))
-> (Handler [PrereqSatisfaction]
    :<|> (Handler [Objective]
          :<|> (Handler (Maybe GraphInfo)
                :<|> (Handler GoalTracking
                      :<|> (Handler WinCondition
                            :<|> (Handler [SearchLog Text]
                                  :<|> (Handler [StructureLocation]
                                        :<|> ((Text -> Handler Text)
                                              :<|> ((Text -> Handler Text)
                                                    :<|> (Handler (RingBuffer CacheLogEntry)
                                                          :<|> (Handler CommandCatalog
                                                                :<|> (Handler [REPLHistItem]
                                                                      :<|> (AreaDimensions
                                                                            -> Handler
                                                                                 GridResponse)))))))))))))
-> (RobotID -> Handler (Maybe Robot))
   :<|> (Handler [PrereqSatisfaction]
         :<|> (Handler [Objective]
               :<|> (Handler (Maybe GraphInfo)
                     :<|> (Handler GoalTracking
                           :<|> (Handler WinCondition
                                 :<|> (Handler [SearchLog Text]
                                       :<|> (Handler [StructureLocation]
                                             :<|> ((Text -> Handler Text)
                                                   :<|> ((Text -> Handler Text)
                                                         :<|> (Handler (RingBuffer CacheLogEntry)
                                                               :<|> (Handler CommandCatalog
                                                                     :<|> (Handler [REPLHistItem]
                                                                           :<|> (AreaDimensions
                                                                                 -> Handler
                                                                                      GridResponse)))))))))))))
forall a b. a -> b -> a :<|> b
:<|> ReadableIORef AppState -> Handler [PrereqSatisfaction]
prereqsHandler ReadableIORef AppState
state
    Handler [PrereqSatisfaction]
-> (Handler [Objective]
    :<|> (Handler (Maybe GraphInfo)
          :<|> (Handler GoalTracking
                :<|> (Handler WinCondition
                      :<|> (Handler [SearchLog Text]
                            :<|> (Handler [StructureLocation]
                                  :<|> ((Text -> Handler Text)
                                        :<|> ((Text -> Handler Text)
                                              :<|> (Handler (RingBuffer CacheLogEntry)
                                                    :<|> (Handler CommandCatalog
                                                          :<|> (Handler [REPLHistItem]
                                                                :<|> (AreaDimensions
                                                                      -> Handler
                                                                           GridResponse))))))))))))
-> Handler [PrereqSatisfaction]
   :<|> (Handler [Objective]
         :<|> (Handler (Maybe GraphInfo)
               :<|> (Handler GoalTracking
                     :<|> (Handler WinCondition
                           :<|> (Handler [SearchLog Text]
                                 :<|> (Handler [StructureLocation]
                                       :<|> ((Text -> Handler Text)
                                             :<|> ((Text -> Handler Text)
                                                   :<|> (Handler (RingBuffer CacheLogEntry)
                                                         :<|> (Handler CommandCatalog
                                                               :<|> (Handler [REPLHistItem]
                                                                     :<|> (AreaDimensions
                                                                           -> Handler
                                                                                GridResponse))))))))))))
forall a b. a -> b -> a :<|> b
:<|> ReadableIORef AppState -> Handler [Objective]
activeGoalsHandler ReadableIORef AppState
state
    Handler [Objective]
-> (Handler (Maybe GraphInfo)
    :<|> (Handler GoalTracking
          :<|> (Handler WinCondition
                :<|> (Handler [SearchLog Text]
                      :<|> (Handler [StructureLocation]
                            :<|> ((Text -> Handler Text)
                                  :<|> ((Text -> Handler Text)
                                        :<|> (Handler (RingBuffer CacheLogEntry)
                                              :<|> (Handler CommandCatalog
                                                    :<|> (Handler [REPLHistItem]
                                                          :<|> (AreaDimensions
                                                                -> Handler GridResponse)))))))))))
-> Handler [Objective]
   :<|> (Handler (Maybe GraphInfo)
         :<|> (Handler GoalTracking
               :<|> (Handler WinCondition
                     :<|> (Handler [SearchLog Text]
                           :<|> (Handler [StructureLocation]
                                 :<|> ((Text -> Handler Text)
                                       :<|> ((Text -> Handler Text)
                                             :<|> (Handler (RingBuffer CacheLogEntry)
                                                   :<|> (Handler CommandCatalog
                                                         :<|> (Handler [REPLHistItem]
                                                               :<|> (AreaDimensions
                                                                     -> Handler
                                                                          GridResponse)))))))))))
forall a b. a -> b -> a :<|> b
:<|> ReadableIORef AppState -> Handler (Maybe GraphInfo)
goalsGraphHandler ReadableIORef AppState
state
    Handler (Maybe GraphInfo)
-> (Handler GoalTracking
    :<|> (Handler WinCondition
          :<|> (Handler [SearchLog Text]
                :<|> (Handler [StructureLocation]
                      :<|> ((Text -> Handler Text)
                            :<|> ((Text -> Handler Text)
                                  :<|> (Handler (RingBuffer CacheLogEntry)
                                        :<|> (Handler CommandCatalog
                                              :<|> (Handler [REPLHistItem]
                                                    :<|> (AreaDimensions
                                                          -> Handler GridResponse))))))))))
-> Handler (Maybe GraphInfo)
   :<|> (Handler GoalTracking
         :<|> (Handler WinCondition
               :<|> (Handler [SearchLog Text]
                     :<|> (Handler [StructureLocation]
                           :<|> ((Text -> Handler Text)
                                 :<|> ((Text -> Handler Text)
                                       :<|> (Handler (RingBuffer CacheLogEntry)
                                             :<|> (Handler CommandCatalog
                                                   :<|> (Handler [REPLHistItem]
                                                         :<|> (AreaDimensions
                                                               -> Handler GridResponse))))))))))
forall a b. a -> b -> a :<|> b
:<|> ReadableIORef AppState -> Handler GoalTracking
uiGoalHandler ReadableIORef AppState
state
    Handler GoalTracking
-> (Handler WinCondition
    :<|> (Handler [SearchLog Text]
          :<|> (Handler [StructureLocation]
                :<|> ((Text -> Handler Text)
                      :<|> ((Text -> Handler Text)
                            :<|> (Handler (RingBuffer CacheLogEntry)
                                  :<|> (Handler CommandCatalog
                                        :<|> (Handler [REPLHistItem]
                                              :<|> (AreaDimensions -> Handler GridResponse)))))))))
-> Handler GoalTracking
   :<|> (Handler WinCondition
         :<|> (Handler [SearchLog Text]
               :<|> (Handler [StructureLocation]
                     :<|> ((Text -> Handler Text)
                           :<|> ((Text -> Handler Text)
                                 :<|> (Handler (RingBuffer CacheLogEntry)
                                       :<|> (Handler CommandCatalog
                                             :<|> (Handler [REPLHistItem]
                                                   :<|> (AreaDimensions
                                                         -> Handler GridResponse)))))))))
forall a b. a -> b -> a :<|> b
:<|> ReadableIORef AppState -> Handler WinCondition
goalsHandler ReadableIORef AppState
state
    Handler WinCondition
-> (Handler [SearchLog Text]
    :<|> (Handler [StructureLocation]
          :<|> ((Text -> Handler Text)
                :<|> ((Text -> Handler Text)
                      :<|> (Handler (RingBuffer CacheLogEntry)
                            :<|> (Handler CommandCatalog
                                  :<|> (Handler [REPLHistItem]
                                        :<|> (AreaDimensions -> Handler GridResponse))))))))
-> Handler WinCondition
   :<|> (Handler [SearchLog Text]
         :<|> (Handler [StructureLocation]
               :<|> ((Text -> Handler Text)
                     :<|> ((Text -> Handler Text)
                           :<|> (Handler (RingBuffer CacheLogEntry)
                                 :<|> (Handler CommandCatalog
                                       :<|> (Handler [REPLHistItem]
                                             :<|> (AreaDimensions -> Handler GridResponse))))))))
forall a b. a -> b -> a :<|> b
:<|> ReadableIORef AppState -> Handler [SearchLog Text]
recogLogHandler ReadableIORef AppState
state
    Handler [SearchLog Text]
-> (Handler [StructureLocation]
    :<|> ((Text -> Handler Text)
          :<|> ((Text -> Handler Text)
                :<|> (Handler (RingBuffer CacheLogEntry)
                      :<|> (Handler CommandCatalog
                            :<|> (Handler [REPLHistItem]
                                  :<|> (AreaDimensions -> Handler GridResponse)))))))
-> Handler [SearchLog Text]
   :<|> (Handler [StructureLocation]
         :<|> ((Text -> Handler Text)
               :<|> ((Text -> Handler Text)
                     :<|> (Handler (RingBuffer CacheLogEntry)
                           :<|> (Handler CommandCatalog
                                 :<|> (Handler [REPLHistItem]
                                       :<|> (AreaDimensions -> Handler GridResponse)))))))
forall a b. a -> b -> a :<|> b
:<|> ReadableIORef AppState -> Handler [StructureLocation]
recogFoundHandler ReadableIORef AppState
state
    Handler [StructureLocation]
-> ((Text -> Handler Text)
    :<|> ((Text -> Handler Text)
          :<|> (Handler (RingBuffer CacheLogEntry)
                :<|> (Handler CommandCatalog
                      :<|> (Handler [REPLHistItem]
                            :<|> (AreaDimensions -> Handler GridResponse))))))
-> Handler [StructureLocation]
   :<|> ((Text -> Handler Text)
         :<|> ((Text -> Handler Text)
               :<|> (Handler (RingBuffer CacheLogEntry)
                     :<|> (Handler CommandCatalog
                           :<|> (Handler [REPLHistItem]
                                 :<|> (AreaDimensions -> Handler GridResponse))))))
forall a b. a -> b -> a :<|> b
:<|> Text -> Handler Text
codeRenderHandler
    (Text -> Handler Text)
-> ((Text -> Handler Text)
    :<|> (Handler (RingBuffer CacheLogEntry)
          :<|> (Handler CommandCatalog
                :<|> (Handler [REPLHistItem]
                      :<|> (AreaDimensions -> Handler GridResponse)))))
-> (Text -> Handler Text)
   :<|> ((Text -> Handler Text)
         :<|> (Handler (RingBuffer CacheLogEntry)
               :<|> (Handler CommandCatalog
                     :<|> (Handler [REPLHistItem]
                           :<|> (AreaDimensions -> Handler GridResponse)))))
forall a b. a -> b -> a :<|> b
:<|> BChan AppEvent -> Text -> Handler Text
codeRunHandler BChan AppEvent
events
    (Text -> Handler Text)
-> (Handler (RingBuffer CacheLogEntry)
    :<|> (Handler CommandCatalog
          :<|> (Handler [REPLHistItem]
                :<|> (AreaDimensions -> Handler GridResponse))))
-> (Text -> Handler Text)
   :<|> (Handler (RingBuffer CacheLogEntry)
         :<|> (Handler CommandCatalog
               :<|> (Handler [REPLHistItem]
                     :<|> (AreaDimensions -> Handler GridResponse))))
forall a b. a -> b -> a :<|> b
:<|> ReadableIORef AppState -> Handler (RingBuffer CacheLogEntry)
pathsLogHandler ReadableIORef AppState
state
    Handler (RingBuffer CacheLogEntry)
-> (Handler CommandCatalog
    :<|> (Handler [REPLHistItem]
          :<|> (AreaDimensions -> Handler GridResponse)))
-> Handler (RingBuffer CacheLogEntry)
   :<|> (Handler CommandCatalog
         :<|> (Handler [REPLHistItem]
               :<|> (AreaDimensions -> Handler GridResponse)))
forall a b. a -> b -> a :<|> b
:<|> ReadableIORef AppState -> Handler CommandCatalog
cmdMatrixHandler ReadableIORef AppState
state
    Handler CommandCatalog
-> (Handler [REPLHistItem]
    :<|> (AreaDimensions -> Handler GridResponse))
-> Handler CommandCatalog
   :<|> (Handler [REPLHistItem]
         :<|> (AreaDimensions -> Handler GridResponse))
forall a b. a -> b -> a :<|> b
:<|> ReadableIORef AppState -> Handler [REPLHistItem]
replHistHandler ReadableIORef AppState
state
    Handler [REPLHistItem]
-> (AreaDimensions -> Handler GridResponse)
-> Handler [REPLHistItem]
   :<|> (AreaDimensions -> Handler GridResponse)
forall a b. a -> b -> a :<|> b
:<|> ReadableIORef AppState -> AreaDimensions -> Handler GridResponse
mapViewHandler ReadableIORef AppState
state

robotsHandler :: ReadableIORef AppState -> Handler [Robot]
robotsHandler :: ReadableIORef AppState -> Handler [Robot]
robotsHandler ReadableIORef AppState
appStateRef = do
  AppState
appState <- IO AppState -> Handler AppState
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReadableIORef AppState -> IO AppState
forall a. ReadableIORef a -> IO a
readIORef ReadableIORef AppState
appStateRef)
  [Robot] -> Handler [Robot]
forall a. a -> Handler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Robot] -> Handler [Robot]) -> [Robot] -> Handler [Robot]
forall a b. (a -> b) -> a -> b
$ IntMap Robot -> [Robot]
forall a. IntMap a -> [a]
IM.elems (IntMap Robot -> [Robot]) -> IntMap Robot -> [Robot]
forall a b. (a -> b) -> a -> b
$ AppState
appState AppState
-> Getting (IntMap Robot) AppState (IntMap Robot) -> IntMap Robot
forall s a. s -> Getting a s a -> a
^. (GameState -> Const (IntMap Robot) GameState)
-> AppState -> Const (IntMap Robot) AppState
Lens' AppState GameState
gameState ((GameState -> Const (IntMap Robot) GameState)
 -> AppState -> Const (IntMap Robot) AppState)
-> ((IntMap Robot -> Const (IntMap Robot) (IntMap Robot))
    -> GameState -> Const (IntMap Robot) GameState)
-> Getting (IntMap Robot) AppState (IntMap Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robots -> Const (IntMap Robot) Robots)
-> GameState -> Const (IntMap Robot) GameState
Lens' GameState Robots
robotInfo ((Robots -> Const (IntMap Robot) Robots)
 -> GameState -> Const (IntMap Robot) GameState)
-> ((IntMap Robot -> Const (IntMap Robot) (IntMap Robot))
    -> Robots -> Const (IntMap Robot) Robots)
-> (IntMap Robot -> Const (IntMap Robot) (IntMap Robot))
-> GameState
-> Const (IntMap Robot) GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap Robot -> Const (IntMap Robot) (IntMap Robot))
-> Robots -> Const (IntMap Robot) Robots
Lens' Robots (IntMap Robot)
robotMap

robotHandler :: ReadableIORef AppState -> RobotID -> Handler (Maybe Robot)
robotHandler :: ReadableIORef AppState -> RobotID -> Handler (Maybe Robot)
robotHandler ReadableIORef AppState
appStateRef (RobotID Port
rid) = do
  AppState
appState <- IO AppState -> Handler AppState
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReadableIORef AppState -> IO AppState
forall a. ReadableIORef a -> IO a
readIORef ReadableIORef AppState
appStateRef)
  Maybe Robot -> Handler (Maybe Robot)
forall a. a -> Handler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Robot -> Handler (Maybe Robot))
-> Maybe Robot -> Handler (Maybe Robot)
forall a b. (a -> b) -> a -> b
$ Port -> IntMap Robot -> Maybe Robot
forall a. Port -> IntMap a -> Maybe a
IM.lookup Port
rid (AppState
appState AppState
-> Getting (IntMap Robot) AppState (IntMap Robot) -> IntMap Robot
forall s a. s -> Getting a s a -> a
^. (GameState -> Const (IntMap Robot) GameState)
-> AppState -> Const (IntMap Robot) AppState
Lens' AppState GameState
gameState ((GameState -> Const (IntMap Robot) GameState)
 -> AppState -> Const (IntMap Robot) AppState)
-> ((IntMap Robot -> Const (IntMap Robot) (IntMap Robot))
    -> GameState -> Const (IntMap Robot) GameState)
-> Getting (IntMap Robot) AppState (IntMap Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robots -> Const (IntMap Robot) Robots)
-> GameState -> Const (IntMap Robot) GameState
Lens' GameState Robots
robotInfo ((Robots -> Const (IntMap Robot) Robots)
 -> GameState -> Const (IntMap Robot) GameState)
-> ((IntMap Robot -> Const (IntMap Robot) (IntMap Robot))
    -> Robots -> Const (IntMap Robot) Robots)
-> (IntMap Robot -> Const (IntMap Robot) (IntMap Robot))
-> GameState
-> Const (IntMap Robot) GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap Robot -> Const (IntMap Robot) (IntMap Robot))
-> Robots -> Const (IntMap Robot) Robots
Lens' Robots (IntMap Robot)
robotMap)

prereqsHandler :: ReadableIORef AppState -> Handler [PrereqSatisfaction]
prereqsHandler :: ReadableIORef AppState -> Handler [PrereqSatisfaction]
prereqsHandler ReadableIORef AppState
appStateRef = do
  AppState
appState <- IO AppState -> Handler AppState
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReadableIORef AppState -> IO AppState
forall a. ReadableIORef a -> IO a
readIORef ReadableIORef AppState
appStateRef)
  case AppState
appState AppState
-> Getting WinCondition AppState WinCondition -> WinCondition
forall s a. s -> Getting a s a -> a
^. (GameState -> Const WinCondition GameState)
-> AppState -> Const WinCondition AppState
Lens' AppState GameState
gameState ((GameState -> Const WinCondition GameState)
 -> AppState -> Const WinCondition AppState)
-> ((WinCondition -> Const WinCondition WinCondition)
    -> GameState -> Const WinCondition GameState)
-> Getting WinCondition AppState WinCondition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WinCondition -> Const WinCondition WinCondition)
-> GameState -> Const WinCondition GameState
Lens' GameState WinCondition
winCondition of
    WinConditions WinStatus
_winState ObjectiveCompletion
oc -> [PrereqSatisfaction] -> Handler [PrereqSatisfaction]
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PrereqSatisfaction] -> Handler [PrereqSatisfaction])
-> [PrereqSatisfaction] -> Handler [PrereqSatisfaction]
forall a b. (a -> b) -> a -> b
$ ObjectiveCompletion -> [PrereqSatisfaction]
getSatisfaction ObjectiveCompletion
oc
    WinCondition
_ -> [PrereqSatisfaction] -> Handler [PrereqSatisfaction]
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return []

activeGoalsHandler :: ReadableIORef AppState -> Handler [Objective]
activeGoalsHandler :: ReadableIORef AppState -> Handler [Objective]
activeGoalsHandler ReadableIORef AppState
appStateRef = do
  AppState
appState <- IO AppState -> Handler AppState
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReadableIORef AppState -> IO AppState
forall a. ReadableIORef a -> IO a
readIORef ReadableIORef AppState
appStateRef)
  case AppState
appState AppState
-> Getting WinCondition AppState WinCondition -> WinCondition
forall s a. s -> Getting a s a -> a
^. (GameState -> Const WinCondition GameState)
-> AppState -> Const WinCondition AppState
Lens' AppState GameState
gameState ((GameState -> Const WinCondition GameState)
 -> AppState -> Const WinCondition AppState)
-> ((WinCondition -> Const WinCondition WinCondition)
    -> GameState -> Const WinCondition GameState)
-> Getting WinCondition AppState WinCondition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WinCondition -> Const WinCondition WinCondition)
-> GameState -> Const WinCondition GameState
Lens' GameState WinCondition
winCondition of
    WinConditions WinStatus
_winState ObjectiveCompletion
oc -> [Objective] -> Handler [Objective]
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Objective] -> Handler [Objective])
-> [Objective] -> Handler [Objective]
forall a b. (a -> b) -> a -> b
$ ObjectiveCompletion -> [Objective]
getActiveObjectives ObjectiveCompletion
oc
    WinCondition
_ -> [Objective] -> Handler [Objective]
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return []

goalsGraphHandler :: ReadableIORef AppState -> Handler (Maybe GraphInfo)
goalsGraphHandler :: ReadableIORef AppState -> Handler (Maybe GraphInfo)
goalsGraphHandler ReadableIORef AppState
appStateRef = do
  AppState
appState <- IO AppState -> Handler AppState
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReadableIORef AppState -> IO AppState
forall a. ReadableIORef a -> IO a
readIORef ReadableIORef AppState
appStateRef)
  Maybe GraphInfo -> Handler (Maybe GraphInfo)
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GraphInfo -> Handler (Maybe GraphInfo))
-> Maybe GraphInfo -> Handler (Maybe GraphInfo)
forall a b. (a -> b) -> a -> b
$ case AppState
appState AppState
-> Getting WinCondition AppState WinCondition -> WinCondition
forall s a. s -> Getting a s a -> a
^. (GameState -> Const WinCondition GameState)
-> AppState -> Const WinCondition AppState
Lens' AppState GameState
gameState ((GameState -> Const WinCondition GameState)
 -> AppState -> Const WinCondition AppState)
-> ((WinCondition -> Const WinCondition WinCondition)
    -> GameState -> Const WinCondition GameState)
-> Getting WinCondition AppState WinCondition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WinCondition -> Const WinCondition WinCondition)
-> GameState -> Const WinCondition GameState
Lens' GameState WinCondition
winCondition of
    WinConditions WinStatus
_winState ObjectiveCompletion
oc -> GraphInfo -> Maybe GraphInfo
forall a. a -> Maybe a
Just (GraphInfo -> Maybe GraphInfo) -> GraphInfo -> Maybe GraphInfo
forall a b. (a -> b) -> a -> b
$ ObjectiveCompletion -> GraphInfo
makeGraphInfo ObjectiveCompletion
oc
    WinCondition
_ -> Maybe GraphInfo
forall a. Maybe a
Nothing

uiGoalHandler :: ReadableIORef AppState -> Handler GoalTracking
uiGoalHandler :: ReadableIORef AppState -> Handler GoalTracking
uiGoalHandler ReadableIORef AppState
appStateRef = do
  AppState
appState <- IO AppState -> Handler AppState
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReadableIORef AppState -> IO AppState
forall a. ReadableIORef a -> IO a
readIORef ReadableIORef AppState
appStateRef)
  GoalTracking -> Handler GoalTracking
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return (GoalTracking -> Handler GoalTracking)
-> GoalTracking -> Handler GoalTracking
forall a b. (a -> b) -> a -> b
$ AppState
appState AppState
-> Getting GoalTracking AppState GoalTracking -> GoalTracking
forall s a. s -> Getting a s a -> a
^. (UIState -> Const GoalTracking UIState)
-> AppState -> Const GoalTracking AppState
Lens' AppState UIState
uiState ((UIState -> Const GoalTracking UIState)
 -> AppState -> Const GoalTracking AppState)
-> ((GoalTracking -> Const GoalTracking GoalTracking)
    -> UIState -> Const GoalTracking UIState)
-> Getting GoalTracking AppState GoalTracking
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const GoalTracking UIGameplay)
-> UIState -> Const GoalTracking UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const GoalTracking UIGameplay)
 -> UIState -> Const GoalTracking UIState)
-> ((GoalTracking -> Const GoalTracking GoalTracking)
    -> UIGameplay -> Const GoalTracking UIGameplay)
-> (GoalTracking -> Const GoalTracking GoalTracking)
-> UIState
-> Const GoalTracking UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GoalDisplay -> Const GoalTracking GoalDisplay)
-> UIGameplay -> Const GoalTracking UIGameplay
Lens' UIGameplay GoalDisplay
uiGoal ((GoalDisplay -> Const GoalTracking GoalDisplay)
 -> UIGameplay -> Const GoalTracking UIGameplay)
-> ((GoalTracking -> Const GoalTracking GoalTracking)
    -> GoalDisplay -> Const GoalTracking GoalDisplay)
-> (GoalTracking -> Const GoalTracking GoalTracking)
-> UIGameplay
-> Const GoalTracking UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GoalTracking -> Const GoalTracking GoalTracking)
-> GoalDisplay -> Const GoalTracking GoalDisplay
Lens' GoalDisplay GoalTracking
goalsContent

goalsHandler :: ReadableIORef AppState -> Handler WinCondition
goalsHandler :: ReadableIORef AppState -> Handler WinCondition
goalsHandler ReadableIORef AppState
appStateRef = do
  AppState
appState <- IO AppState -> Handler AppState
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReadableIORef AppState -> IO AppState
forall a. ReadableIORef a -> IO a
readIORef ReadableIORef AppState
appStateRef)
  WinCondition -> Handler WinCondition
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return (WinCondition -> Handler WinCondition)
-> WinCondition -> Handler WinCondition
forall a b. (a -> b) -> a -> b
$ AppState
appState AppState
-> Getting WinCondition AppState WinCondition -> WinCondition
forall s a. s -> Getting a s a -> a
^. (GameState -> Const WinCondition GameState)
-> AppState -> Const WinCondition AppState
Lens' AppState GameState
gameState ((GameState -> Const WinCondition GameState)
 -> AppState -> Const WinCondition AppState)
-> ((WinCondition -> Const WinCondition WinCondition)
    -> GameState -> Const WinCondition GameState)
-> Getting WinCondition AppState WinCondition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WinCondition -> Const WinCondition WinCondition)
-> GameState -> Const WinCondition GameState
Lens' GameState WinCondition
winCondition

recogLogHandler :: ReadableIORef AppState -> Handler [SearchLog EntityName]
recogLogHandler :: ReadableIORef AppState -> Handler [SearchLog Text]
recogLogHandler ReadableIORef AppState
appStateRef = do
  AppState
appState <- IO AppState -> Handler AppState
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReadableIORef AppState -> IO AppState
forall a. ReadableIORef a -> IO a
readIORef ReadableIORef AppState
appStateRef)
  [SearchLog Text] -> Handler [SearchLog Text]
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([SearchLog Text] -> Handler [SearchLog Text])
-> [SearchLog Text] -> Handler [SearchLog Text]
forall a b. (a -> b) -> a -> b
$
    (SearchLog Entity -> SearchLog Text)
-> [SearchLog Entity] -> [SearchLog Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Entity -> Text) -> SearchLog Entity -> SearchLog Text
forall a b. (a -> b) -> SearchLog a -> SearchLog b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting Text Entity Text -> Entity -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Entity Text
Lens' Entity Text
entityName)) ([SearchLog Entity] -> [SearchLog Text])
-> [SearchLog Entity] -> [SearchLog Text]
forall a b. (a -> b) -> a -> b
$
      AppState
appState AppState
-> Getting [SearchLog Entity] AppState [SearchLog Entity]
-> [SearchLog Entity]
forall s a. s -> Getting a s a -> a
^. (GameState -> Const [SearchLog Entity] GameState)
-> AppState -> Const [SearchLog Entity] AppState
Lens' AppState GameState
gameState ((GameState -> Const [SearchLog Entity] GameState)
 -> AppState -> Const [SearchLog Entity] AppState)
-> (([SearchLog Entity]
     -> Const [SearchLog Entity] [SearchLog Entity])
    -> GameState -> Const [SearchLog Entity] GameState)
-> Getting [SearchLog Entity] AppState [SearchLog Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Discovery -> Const [SearchLog Entity] Discovery)
-> GameState -> Const [SearchLog Entity] GameState
Lens' GameState Discovery
discovery ((Discovery -> Const [SearchLog Entity] Discovery)
 -> GameState -> Const [SearchLog Entity] GameState)
-> (([SearchLog Entity]
     -> Const [SearchLog Entity] [SearchLog Entity])
    -> Discovery -> Const [SearchLog Entity] Discovery)
-> ([SearchLog Entity]
    -> Const [SearchLog Entity] [SearchLog Entity])
-> GameState
-> Const [SearchLog Entity] GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureRecognizer StructureCells Entity
 -> Const
      [SearchLog Entity] (StructureRecognizer StructureCells Entity))
-> Discovery -> Const [SearchLog Entity] Discovery
Lens' Discovery (StructureRecognizer StructureCells Entity)
structureRecognition ((StructureRecognizer StructureCells Entity
  -> Const
       [SearchLog Entity] (StructureRecognizer StructureCells Entity))
 -> Discovery -> Const [SearchLog Entity] Discovery)
-> (([SearchLog Entity]
     -> Const [SearchLog Entity] [SearchLog Entity])
    -> StructureRecognizer StructureCells Entity
    -> Const
         [SearchLog Entity] (StructureRecognizer StructureCells Entity))
-> ([SearchLog Entity]
    -> Const [SearchLog Entity] [SearchLog Entity])
-> Discovery
-> Const [SearchLog Entity] Discovery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SearchLog Entity] -> Const [SearchLog Entity] [SearchLog Entity])
-> StructureRecognizer StructureCells Entity
-> Const
     [SearchLog Entity] (StructureRecognizer StructureCells Entity)
forall b a (f :: * -> *).
Functor f =>
([SearchLog a] -> f [SearchLog a])
-> StructureRecognizer b a -> f (StructureRecognizer b a)
recognitionLog

recogFoundHandler :: ReadableIORef AppState -> Handler [StructureLocation]
recogFoundHandler :: ReadableIORef AppState -> Handler [StructureLocation]
recogFoundHandler ReadableIORef AppState
appStateRef = do
  AppState
appState <- IO AppState -> Handler AppState
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReadableIORef AppState -> IO AppState
forall a. ReadableIORef a -> IO a
readIORef ReadableIORef AppState
appStateRef)
  let registry :: FoundRegistry StructureCells Entity
registry = AppState
appState AppState
-> Getting
     (FoundRegistry StructureCells Entity)
     AppState
     (FoundRegistry StructureCells Entity)
-> FoundRegistry StructureCells Entity
forall s a. s -> Getting a s a -> a
^. (GameState
 -> Const (FoundRegistry StructureCells Entity) GameState)
-> AppState -> Const (FoundRegistry StructureCells Entity) AppState
Lens' AppState GameState
gameState ((GameState
  -> Const (FoundRegistry StructureCells Entity) GameState)
 -> AppState
 -> Const (FoundRegistry StructureCells Entity) AppState)
-> ((FoundRegistry StructureCells Entity
     -> Const
          (FoundRegistry StructureCells Entity)
          (FoundRegistry StructureCells Entity))
    -> GameState
    -> Const (FoundRegistry StructureCells Entity) GameState)
-> Getting
     (FoundRegistry StructureCells Entity)
     AppState
     (FoundRegistry StructureCells Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Discovery
 -> Const (FoundRegistry StructureCells Entity) Discovery)
-> GameState
-> Const (FoundRegistry StructureCells Entity) GameState
Lens' GameState Discovery
discovery ((Discovery
  -> Const (FoundRegistry StructureCells Entity) Discovery)
 -> GameState
 -> Const (FoundRegistry StructureCells Entity) GameState)
-> ((FoundRegistry StructureCells Entity
     -> Const
          (FoundRegistry StructureCells Entity)
          (FoundRegistry StructureCells Entity))
    -> Discovery
    -> Const (FoundRegistry StructureCells Entity) Discovery)
-> (FoundRegistry StructureCells Entity
    -> Const
         (FoundRegistry StructureCells Entity)
         (FoundRegistry StructureCells Entity))
-> GameState
-> Const (FoundRegistry StructureCells Entity) GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureRecognizer StructureCells Entity
 -> Const
      (FoundRegistry StructureCells Entity)
      (StructureRecognizer StructureCells Entity))
-> Discovery
-> Const (FoundRegistry StructureCells Entity) Discovery
Lens' Discovery (StructureRecognizer StructureCells Entity)
structureRecognition ((StructureRecognizer StructureCells Entity
  -> Const
       (FoundRegistry StructureCells Entity)
       (StructureRecognizer StructureCells Entity))
 -> Discovery
 -> Const (FoundRegistry StructureCells Entity) Discovery)
-> ((FoundRegistry StructureCells Entity
     -> Const
          (FoundRegistry StructureCells Entity)
          (FoundRegistry StructureCells Entity))
    -> StructureRecognizer StructureCells Entity
    -> Const
         (FoundRegistry StructureCells Entity)
         (StructureRecognizer StructureCells Entity))
-> (FoundRegistry StructureCells Entity
    -> Const
         (FoundRegistry StructureCells Entity)
         (FoundRegistry StructureCells Entity))
-> Discovery
-> Const (FoundRegistry StructureCells Entity) Discovery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FoundRegistry StructureCells Entity
 -> Const
      (FoundRegistry StructureCells Entity)
      (FoundRegistry StructureCells Entity))
-> StructureRecognizer StructureCells Entity
-> Const
     (FoundRegistry StructureCells Entity)
     (StructureRecognizer StructureCells Entity)
forall b a (f :: * -> *).
Functor f =>
(FoundRegistry b a -> f (FoundRegistry b a))
-> StructureRecognizer b a -> f (StructureRecognizer b a)
foundStructures
  [StructureLocation] -> Handler [StructureLocation]
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return
    ([StructureLocation] -> Handler [StructureLocation])
-> (Map
      Text
      (NEMap (Cosmic Location) (StructureWithGrid StructureCells Entity))
    -> [StructureLocation])
-> Map
     Text
     (NEMap (Cosmic Location) (StructureWithGrid StructureCells Entity))
-> Handler [StructureLocation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Cosmic Location) -> StructureLocation)
-> [(Text, Cosmic Location)] -> [StructureLocation]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Cosmic Location -> StructureLocation)
-> (Text, Cosmic Location) -> StructureLocation
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Cosmic Location -> StructureLocation
StructureLocation)
    ([(Text, Cosmic Location)] -> [StructureLocation])
-> (Map
      Text
      (NEMap (Cosmic Location) (StructureWithGrid StructureCells Entity))
    -> [(Text, Cosmic Location)])
-> Map
     Text
     (NEMap (Cosmic Location) (StructureWithGrid StructureCells Entity))
-> [StructureLocation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, NonEmpty (Cosmic Location)) -> [(Text, Cosmic Location)])
-> [(Text, NonEmpty (Cosmic Location))]
-> [(Text, Cosmic Location)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Text
x, NonEmpty (Cosmic Location)
ys) -> (Cosmic Location -> (Text, Cosmic Location))
-> [Cosmic Location] -> [(Text, Cosmic Location)]
forall a b. (a -> b) -> [a] -> [b]
map (Text
x,) ([Cosmic Location] -> [(Text, Cosmic Location)])
-> [Cosmic Location] -> [(Text, Cosmic Location)]
forall a b. (a -> b) -> a -> b
$ NonEmpty (Cosmic Location) -> [Cosmic Location]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Cosmic Location)
ys)
    ([(Text, NonEmpty (Cosmic Location))] -> [(Text, Cosmic Location)])
-> (Map
      Text
      (NEMap (Cosmic Location) (StructureWithGrid StructureCells Entity))
    -> [(Text, NonEmpty (Cosmic Location))])
-> Map
     Text
     (NEMap (Cosmic Location) (StructureWithGrid StructureCells Entity))
-> [(Text, Cosmic Location)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text (NonEmpty (Cosmic Location))
-> [(Text, NonEmpty (Cosmic Location))]
forall k a. Map k a -> [(k, a)]
M.toList
    (Map Text (NonEmpty (Cosmic Location))
 -> [(Text, NonEmpty (Cosmic Location))])
-> (Map
      Text
      (NEMap (Cosmic Location) (StructureWithGrid StructureCells Entity))
    -> Map Text (NonEmpty (Cosmic Location)))
-> Map
     Text
     (NEMap (Cosmic Location) (StructureWithGrid StructureCells Entity))
-> [(Text, NonEmpty (Cosmic Location))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NEMap (Cosmic Location) (StructureWithGrid StructureCells Entity)
 -> NonEmpty (Cosmic Location))
-> Map
     Text
     (NEMap (Cosmic Location) (StructureWithGrid StructureCells Entity))
-> Map Text (NonEmpty (Cosmic Location))
forall a b k. (a -> b) -> Map k a -> Map k b
M.map NEMap (Cosmic Location) (StructureWithGrid StructureCells Entity)
-> NonEmpty (Cosmic Location)
forall k a. NEMap k a -> NonEmpty k
NEM.keys
    (Map
   Text
   (NEMap (Cosmic Location) (StructureWithGrid StructureCells Entity))
 -> Handler [StructureLocation])
-> Map
     Text
     (NEMap (Cosmic Location) (StructureWithGrid StructureCells Entity))
-> Handler [StructureLocation]
forall a b. (a -> b) -> a -> b
$ FoundRegistry StructureCells Entity
-> Map
     Text
     (NEMap (Cosmic Location) (StructureWithGrid StructureCells Entity))
forall b a.
FoundRegistry b a
-> Map Text (NEMap (Cosmic Location) (StructureWithGrid b a))
foundByName FoundRegistry StructureCells Entity
registry

codeRenderHandler :: Text -> Handler Text
codeRenderHandler :: Text -> Handler Text
codeRenderHandler Text
contents = do
  Text -> Handler Text
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Handler Text) -> Text -> Handler Text
forall a b. (a -> b) -> a -> b
$ case Text -> Either Text TSyntax
processTermEither Text
contents of
    Right TSyntax
t ->
      forall target source. From source target => source -> target
into @Text (String -> Text) -> (TSyntax -> String) -> TSyntax -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree String -> String
drawTree (Tree String -> String)
-> (TSyntax -> Tree String) -> TSyntax -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TSyntax -> String) -> Tree TSyntax -> Tree String
forall a b. (a -> b) -> Tree a -> Tree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> String
T.unpack (Text -> String) -> (TSyntax -> Text) -> TSyntax -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TSyntax -> Text
forall a. PrettyPrec a => a -> Text
prettyTextLine) (Tree TSyntax -> Tree String)
-> (TSyntax -> Tree TSyntax) -> TSyntax -> Tree String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TSyntax -> [Tree TSyntax] -> Tree TSyntax)
-> TSyntax -> Tree TSyntax
forall a r. Plated a => (a -> [r] -> r) -> a -> r
para TSyntax -> [Tree TSyntax] -> Tree TSyntax
forall a. a -> [Tree a] -> Tree a
Node (TSyntax -> Text) -> TSyntax -> Text
forall a b. (a -> b) -> a -> b
$ TSyntax
t
    Left Text
x -> Text
x

codeRunHandler :: BChan AppEvent -> Text -> Handler Text
codeRunHandler :: BChan AppEvent -> Text -> Handler Text
codeRunHandler BChan AppEvent
chan Text
contents = do
  IO () -> Handler ()
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Handler ())
-> (WebCommand -> IO ()) -> WebCommand -> Handler ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BChan AppEvent -> AppEvent -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan AppEvent
chan (AppEvent -> IO ())
-> (WebCommand -> AppEvent) -> WebCommand -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebCommand -> AppEvent
Web (WebCommand -> Handler ()) -> WebCommand -> Handler ()
forall a b. (a -> b) -> a -> b
$ Text -> WebCommand
RunWebCode Text
contents
  Text -> Handler Text
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Handler Text) -> Text -> Handler Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
"Sent\n"

pathsLogHandler :: ReadableIORef AppState -> Handler (RingBuffer CacheLogEntry)
pathsLogHandler :: ReadableIORef AppState -> Handler (RingBuffer CacheLogEntry)
pathsLogHandler ReadableIORef AppState
appStateRef = do
  AppState
appState <- IO AppState -> Handler AppState
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReadableIORef AppState -> IO AppState
forall a. ReadableIORef a -> IO a
readIORef ReadableIORef AppState
appStateRef)
  RingBuffer CacheLogEntry -> Handler (RingBuffer CacheLogEntry)
forall a. a -> Handler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RingBuffer CacheLogEntry -> Handler (RingBuffer CacheLogEntry))
-> RingBuffer CacheLogEntry -> Handler (RingBuffer CacheLogEntry)
forall a b. (a -> b) -> a -> b
$ AppState
appState AppState
-> Getting
     (RingBuffer CacheLogEntry) AppState (RingBuffer CacheLogEntry)
-> RingBuffer CacheLogEntry
forall s a. s -> Getting a s a -> a
^. (GameState -> Const (RingBuffer CacheLogEntry) GameState)
-> AppState -> Const (RingBuffer CacheLogEntry) AppState
Lens' AppState GameState
gameState ((GameState -> Const (RingBuffer CacheLogEntry) GameState)
 -> AppState -> Const (RingBuffer CacheLogEntry) AppState)
-> ((RingBuffer CacheLogEntry
     -> Const (RingBuffer CacheLogEntry) (RingBuffer CacheLogEntry))
    -> GameState -> Const (RingBuffer CacheLogEntry) GameState)
-> Getting
     (RingBuffer CacheLogEntry) AppState (RingBuffer CacheLogEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathCaching -> Const (RingBuffer CacheLogEntry) PathCaching)
-> GameState -> Const (RingBuffer CacheLogEntry) GameState
Lens' GameState PathCaching
pathCaching ((PathCaching -> Const (RingBuffer CacheLogEntry) PathCaching)
 -> GameState -> Const (RingBuffer CacheLogEntry) GameState)
-> ((RingBuffer CacheLogEntry
     -> Const (RingBuffer CacheLogEntry) (RingBuffer CacheLogEntry))
    -> PathCaching -> Const (RingBuffer CacheLogEntry) PathCaching)
-> (RingBuffer CacheLogEntry
    -> Const (RingBuffer CacheLogEntry) (RingBuffer CacheLogEntry))
-> GameState
-> Const (RingBuffer CacheLogEntry) GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RingBuffer CacheLogEntry
 -> Const (RingBuffer CacheLogEntry) (RingBuffer CacheLogEntry))
-> PathCaching -> Const (RingBuffer CacheLogEntry) PathCaching
Lens' PathCaching (RingBuffer CacheLogEntry)
pathCachingLog

cmdMatrixHandler :: ReadableIORef AppState -> Handler CommandCatalog
cmdMatrixHandler :: ReadableIORef AppState -> Handler CommandCatalog
cmdMatrixHandler ReadableIORef AppState
_ = CommandCatalog -> Handler CommandCatalog
forall a. a -> Handler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CommandCatalog
getCatalog

replHistHandler :: ReadableIORef AppState -> Handler [REPLHistItem]
replHistHandler :: ReadableIORef AppState -> Handler [REPLHistItem]
replHistHandler ReadableIORef AppState
appStateRef = do
  AppState
appState <- IO AppState -> Handler AppState
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReadableIORef AppState -> IO AppState
forall a. ReadableIORef a -> IO a
readIORef ReadableIORef AppState
appStateRef)
  let replHistorySeq :: Seq REPLHistItem
replHistorySeq = AppState
appState AppState
-> Getting (Seq REPLHistItem) AppState (Seq REPLHistItem)
-> Seq REPLHistItem
forall s a. s -> Getting a s a -> a
^. (UIState -> Const (Seq REPLHistItem) UIState)
-> AppState -> Const (Seq REPLHistItem) AppState
Lens' AppState UIState
uiState ((UIState -> Const (Seq REPLHistItem) UIState)
 -> AppState -> Const (Seq REPLHistItem) AppState)
-> ((Seq REPLHistItem
     -> Const (Seq REPLHistItem) (Seq REPLHistItem))
    -> UIState -> Const (Seq REPLHistItem) UIState)
-> Getting (Seq REPLHistItem) AppState (Seq REPLHistItem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (Seq REPLHistItem) UIGameplay)
-> UIState -> Const (Seq REPLHistItem) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const (Seq REPLHistItem) UIGameplay)
 -> UIState -> Const (Seq REPLHistItem) UIState)
-> ((Seq REPLHistItem
     -> Const (Seq REPLHistItem) (Seq REPLHistItem))
    -> UIGameplay -> Const (Seq REPLHistItem) UIGameplay)
-> (Seq REPLHistItem
    -> Const (Seq REPLHistItem) (Seq REPLHistItem))
-> UIState
-> Const (Seq REPLHistItem) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Const (Seq REPLHistItem) REPLState)
-> UIGameplay -> Const (Seq REPLHistItem) UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Const (Seq REPLHistItem) REPLState)
 -> UIGameplay -> Const (Seq REPLHistItem) UIGameplay)
-> ((Seq REPLHistItem
     -> Const (Seq REPLHistItem) (Seq REPLHistItem))
    -> REPLState -> Const (Seq REPLHistItem) REPLState)
-> (Seq REPLHistItem
    -> Const (Seq REPLHistItem) (Seq REPLHistItem))
-> UIGameplay
-> Const (Seq REPLHistItem) UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLHistory -> Const (Seq REPLHistItem) REPLHistory)
-> REPLState -> Const (Seq REPLHistItem) REPLState
Lens' REPLState REPLHistory
replHistory ((REPLHistory -> Const (Seq REPLHistItem) REPLHistory)
 -> REPLState -> Const (Seq REPLHistItem) REPLState)
-> ((Seq REPLHistItem
     -> Const (Seq REPLHistItem) (Seq REPLHistItem))
    -> REPLHistory -> Const (Seq REPLHistItem) REPLHistory)
-> (Seq REPLHistItem
    -> Const (Seq REPLHistItem) (Seq REPLHistItem))
-> REPLState
-> Const (Seq REPLHistItem) REPLState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq REPLHistItem -> Const (Seq REPLHistItem) (Seq REPLHistItem))
-> REPLHistory -> Const (Seq REPLHistItem) REPLHistory
Lens' REPLHistory (Seq REPLHistItem)
replSeq
      items :: [REPLHistItem]
items = Seq REPLHistItem -> [REPLHistItem]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq REPLHistItem
replHistorySeq
  [REPLHistItem] -> Handler [REPLHistItem]
forall a. a -> Handler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [REPLHistItem]
items

mapViewHandler :: ReadableIORef AppState -> AreaDimensions -> Handler GridResponse
mapViewHandler :: ReadableIORef AppState -> AreaDimensions -> Handler GridResponse
mapViewHandler ReadableIORef AppState
appStateRef AreaDimensions
areaSize = do
  AppState
appState <- IO AppState -> Handler AppState
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReadableIORef AppState -> IO AppState
forall a. ReadableIORef a -> IO a
readIORef ReadableIORef AppState
appStateRef)
  let maybeScenario :: Maybe Scenario
maybeScenario = (Scenario, ScenarioInfo) -> Scenario
forall a b. (a, b) -> a
fst ((Scenario, ScenarioInfo) -> Scenario)
-> Maybe (Scenario, ScenarioInfo) -> Maybe Scenario
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AppState
appState AppState
-> Getting
     (Maybe (Scenario, ScenarioInfo))
     AppState
     (Maybe (Scenario, ScenarioInfo))
-> Maybe (Scenario, ScenarioInfo)
forall s a. s -> Getting a s a -> a
^. (UIState -> Const (Maybe (Scenario, ScenarioInfo)) UIState)
-> AppState -> Const (Maybe (Scenario, ScenarioInfo)) AppState
Lens' AppState UIState
uiState ((UIState -> Const (Maybe (Scenario, ScenarioInfo)) UIState)
 -> AppState -> Const (Maybe (Scenario, ScenarioInfo)) AppState)
-> ((Maybe (Scenario, ScenarioInfo)
     -> Const
          (Maybe (Scenario, ScenarioInfo)) (Maybe (Scenario, ScenarioInfo)))
    -> UIState -> Const (Maybe (Scenario, ScenarioInfo)) UIState)
-> Getting
     (Maybe (Scenario, ScenarioInfo))
     AppState
     (Maybe (Scenario, ScenarioInfo))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (Maybe (Scenario, ScenarioInfo)) UIGameplay)
-> UIState -> Const (Maybe (Scenario, ScenarioInfo)) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const (Maybe (Scenario, ScenarioInfo)) UIGameplay)
 -> UIState -> Const (Maybe (Scenario, ScenarioInfo)) UIState)
-> ((Maybe (Scenario, ScenarioInfo)
     -> Const
          (Maybe (Scenario, ScenarioInfo)) (Maybe (Scenario, ScenarioInfo)))
    -> UIGameplay -> Const (Maybe (Scenario, ScenarioInfo)) UIGameplay)
-> (Maybe (Scenario, ScenarioInfo)
    -> Const
         (Maybe (Scenario, ScenarioInfo)) (Maybe (Scenario, ScenarioInfo)))
-> UIState
-> Const (Maybe (Scenario, ScenarioInfo)) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Scenario, ScenarioInfo)
 -> Const
      (Maybe (Scenario, ScenarioInfo)) (Maybe (Scenario, ScenarioInfo)))
-> UIGameplay -> Const (Maybe (Scenario, ScenarioInfo)) UIGameplay
Lens' UIGameplay (Maybe (Scenario, ScenarioInfo))
scenarioRef
  GridResponse -> Handler GridResponse
forall a. a -> Handler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GridResponse -> Handler GridResponse)
-> GridResponse -> Handler GridResponse
forall a b. (a -> b) -> a -> b
$ case Maybe Scenario
maybeScenario of
    Just Scenario
s ->
      Bool -> Maybe CellGrid -> GridResponse
GridResponse Bool
True
        (Maybe CellGrid -> GridResponse)
-> (AreaDimensions -> Maybe CellGrid)
-> AreaDimensions
-> GridResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellGrid -> Maybe CellGrid
forall a. a -> Maybe a
Just
        (CellGrid -> Maybe CellGrid)
-> (AreaDimensions -> CellGrid) -> AreaDimensions -> Maybe CellGrid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scenario -> GameState -> AreaDimensions -> CellGrid
getCellGrid Scenario
s (AppState
appState AppState -> Getting GameState AppState GameState -> GameState
forall s a. s -> Getting a s a -> a
^. Getting GameState AppState GameState
Lens' AppState GameState
gameState)
        (AreaDimensions -> GridResponse) -> AreaDimensions -> GridResponse
forall a b. (a -> b) -> a -> b
$ AreaDimensions
areaSize
    Maybe Scenario
Nothing -> Bool -> Maybe CellGrid -> GridResponse
GridResponse Bool
False Maybe CellGrid
forall a. Maybe a
Nothing

-- ------------------------------------------------------------------
-- Main app (used by service and for development)
-- ------------------------------------------------------------------

-- | Simple result type to report errors from forked startup thread.
data WebStartResult = WebStarted | WebStartError String

webMain ::
  Maybe (MVar WebStartResult) ->
  Warp.Port ->
  -- | Read-only reference to the application state.
  ReadableIORef AppState ->
  -- | Writable channel to send events to the game
  BChan AppEvent ->
  IO ()
webMain :: Maybe (MVar WebStartResult)
-> Port -> ReadableIORef AppState -> BChan AppEvent -> IO ()
webMain Maybe (MVar WebStartResult)
baton Port
port ReadableIORef AppState
appStateRef BChan AppEvent
chan = IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (Settings -> Application -> IO ()
Warp.runSettings Settings
settings Application
app) IOException -> IO ()
handleErr
 where
  settings :: Settings
settings = Port -> Settings -> Settings
Warp.setPort Port
port (Settings -> Settings) -> Settings -> Settings
forall a b. (a -> b) -> a -> b
$ Settings -> Settings
onReady Settings
Warp.defaultSettings
  onReady :: Settings -> Settings
onReady = case Maybe (MVar WebStartResult)
baton of
    Just MVar WebStartResult
mv -> IO () -> Settings -> Settings
Warp.setBeforeMainLoop (IO () -> Settings -> Settings) -> IO () -> Settings -> Settings
forall a b. (a -> b) -> a -> b
$ MVar WebStartResult -> WebStartResult -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar WebStartResult
mv WebStartResult
WebStarted
    Maybe (MVar WebStartResult)
Nothing -> Settings -> Settings
forall a. a -> a
id

  server :: Server ToplevelAPI
  server :: Server ToplevelAPI
server =
    ReadableIORef AppState -> BChan AppEvent -> Server SwarmAPI
mkApp ReadableIORef AppState
appStateRef BChan AppEvent
chan
      (Handler [Robot]
 :<|> ((RobotID -> Handler (Maybe Robot))
       :<|> (Handler [PrereqSatisfaction]
             :<|> (Handler [Objective]
                   :<|> (Handler (Maybe GraphInfo)
                         :<|> (Handler GoalTracking
                               :<|> (Handler WinCondition
                                     :<|> (Handler [SearchLog Text]
                                           :<|> (Handler [StructureLocation]
                                                 :<|> ((Text -> Handler Text)
                                                       :<|> ((Text -> Handler Text)
                                                             :<|> (Handler
                                                                     (RingBuffer CacheLogEntry)
                                                                   :<|> (Handler CommandCatalog
                                                                         :<|> (Handler
                                                                                 [REPLHistItem]
                                                                               :<|> (AreaDimensions
                                                                                     -> Handler
                                                                                          GridResponse)))))))))))))))
-> (Tagged Handler Application :<|> Tagged Handler Application)
-> (Handler [Robot]
    :<|> ((RobotID -> Handler (Maybe Robot))
          :<|> (Handler [PrereqSatisfaction]
                :<|> (Handler [Objective]
                      :<|> (Handler (Maybe GraphInfo)
                            :<|> (Handler GoalTracking
                                  :<|> (Handler WinCondition
                                        :<|> (Handler [SearchLog Text]
                                              :<|> (Handler [StructureLocation]
                                                    :<|> ((Text -> Handler Text)
                                                          :<|> ((Text -> Handler Text)
                                                                :<|> (Handler
                                                                        (RingBuffer CacheLogEntry)
                                                                      :<|> (Handler CommandCatalog
                                                                            :<|> (Handler
                                                                                    [REPLHistItem]
                                                                                  :<|> (AreaDimensions
                                                                                        -> Handler
                                                                                             GridResponse)))))))))))))))
   :<|> (Tagged Handler Application :<|> Tagged Handler Application)
forall a b. a -> b -> a :<|> b
:<|> Application -> Tagged Handler Application
forall {k} (s :: k) b. b -> Tagged s b
Tagged Application
forall {p} {b}. p -> (Response -> b) -> b
serveDocs
      Tagged Handler Application
-> Tagged Handler Application
-> Tagged Handler Application :<|> Tagged Handler Application
forall a b. a -> b -> a :<|> b
:<|> StaticSettings -> ServerT Raw Handler
forall (m :: * -> *). StaticSettings -> ServerT Raw m
serveDirectoryWith (String -> StaticSettings
defaultFileServerSettings String
"web") {ssIndices = [unsafeToPiece "index.html"]}
   where
    serveDocs :: p -> (Response -> b) -> b
serveDocs p
_ Response -> b
resp =
      Response -> b
resp (Response -> b) -> Response -> b
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
ok200 [(HeaderName, ByteString)
plain] ByteString
swarmApiHtml
    plain :: (HeaderName, ByteString)
plain = (HeaderName
"Content-Type", ByteString
"text/html")

  app :: Network.Wai.Application
  app :: Application
app = Proxy ToplevelAPI -> Server ToplevelAPI -> Application
forall api.
HasServer api '[] =>
Proxy api -> Server api -> Application
Servant.serve Proxy ToplevelAPI
api Server ToplevelAPI
server

  handleErr :: IOException -> IO ()
  handleErr :: IOException -> IO ()
handleErr IOException
e = case Maybe (MVar WebStartResult)
baton of
    Just MVar WebStartResult
mv -> MVar WebStartResult -> WebStartResult -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar WebStartResult
mv (String -> WebStartResult
WebStartError (String -> WebStartResult) -> String -> WebStartResult
forall a b. (a -> b) -> a -> b
$ IOException -> String
forall e. Exception e => e -> String
displayException IOException
e)
    Maybe (MVar WebStartResult)
Nothing -> IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO IOException
e

-- ------------------------------------------------------------------
-- Web service
-- ------------------------------------------------------------------

defaultPort :: Warp.Port
defaultPort :: Port
defaultPort = Port
5357

-- | Attempt to start a web thread on the requested port, or a default
--   one if none is requested (or don't start a web thread if the
--   requested port is 0).  If an explicit port was requested, fail if
--   startup doesn't work.  Otherwise, ignore the failure.  In any
--   case, return a @Maybe Port@ value representing whether a web
--   server is actually running, and if so, what port it is on.
startWebThread ::
  Maybe Warp.Port ->
  -- | Read-only reference to the application state.
  ReadableIORef AppState ->
  -- | Writable channel to send events to the game
  BChan AppEvent ->
  IO (Either String Warp.Port)
-- User explicitly provided port '0': don't run the web server
startWebThread :: Maybe Port
-> ReadableIORef AppState
-> BChan AppEvent
-> IO (Either String Port)
startWebThread (Just Port
0) ReadableIORef AppState
_ BChan AppEvent
_ = Either String Port -> IO (Either String Port)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Port -> IO (Either String Port))
-> Either String Port -> IO (Either String Port)
forall a b. (a -> b) -> a -> b
$ String -> Either String Port
forall a b. a -> Either a b
Left String
"The web port has been turned off."
startWebThread Maybe Port
userPort ReadableIORef AppState
appStateRef BChan AppEvent
chan = do
  MVar WebStartResult
baton <- IO (MVar WebStartResult)
forall a. IO (MVar a)
newEmptyMVar
  let port :: Port
port = Port -> Maybe Port -> Port
forall a. a -> Maybe a -> a
fromMaybe Port
defaultPort Maybe Port
userPort
      failMsg :: String
failMsg = String
"Failed to start the web API on :" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Port -> String
forall a. Show a => a -> String
show Port
port
  IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Maybe (MVar WebStartResult)
-> Port -> ReadableIORef AppState -> BChan AppEvent -> IO ()
webMain (MVar WebStartResult -> Maybe (MVar WebStartResult)
forall a. a -> Maybe a
Just MVar WebStartResult
baton) Port
port ReadableIORef AppState
appStateRef BChan AppEvent
chan
  Maybe WebStartResult
res <- Port -> IO WebStartResult -> IO (Maybe WebStartResult)
forall a. Port -> IO a -> IO (Maybe a)
timeout Port
500_000 (MVar WebStartResult -> IO WebStartResult
forall a. MVar a -> IO a
takeMVar MVar WebStartResult
baton)
  case Maybe WebStartResult
res of
    Just WebStartResult
WebStarted -> Either String Port -> IO (Either String Port)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Port -> Either String Port
forall a b. b -> Either a b
Right Port
port)
    Just (WebStartError String
e) -> Either String Port -> IO (Either String Port)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Port -> IO (Either String Port))
-> (String -> Either String Port)
-> String
-> IO (Either String Port)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Port
forall a b. a -> Either a b
Left (String -> IO (Either String Port))
-> String -> IO (Either String Port)
forall a b. (a -> b) -> a -> b
$ String
failMsg String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" - " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
e
    -- If user explicitly specified port exit, otherwise just report timeout
    Maybe WebStartResult
Nothing -> case Maybe Port
userPort of
      Just Port
_p -> String -> IO (Either String Port)
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
failMsg
      Maybe Port
Nothing -> Either String Port -> IO (Either String Port)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Port -> IO (Either String Port))
-> (String -> Either String Port)
-> String
-> IO (Either String Port)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Port
forall a b. a -> Either a b
Left (String -> IO (Either String Port))
-> String -> IO (Either String Port)
forall a b. (a -> b) -> a -> b
$ String
failMsg String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" (timeout)"

-- ------------------------------------------------------------------
-- Necessary instances
-- ------------------------------------------------------------------

instance SD.ToSample T.Text where
  toSamples :: Proxy Text -> [(Text, Text)]
toSamples Proxy Text
_ = [(Text, Text)]
forall a. [(Text, a)]
SD.noSamples

instance FromHttpApiData RobotID where
  parseUrlPiece :: Text -> Either Text RobotID
parseUrlPiece = (Port -> RobotID) -> Either Text Port -> Either Text RobotID
forall a b. (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Port -> RobotID
RobotID (Either Text Port -> Either Text RobotID)
-> (Text -> Either Text Port) -> Text -> Either Text RobotID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text) -> Either String Port -> Either Text Port
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left String -> Text
T.pack (Either String Port -> Either Text Port)
-> (Text -> Either String Port) -> Text -> Either Text Port
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Port
forall a. Read a => String -> Either String a
readEither (String -> Either String Port)
-> (Text -> String) -> Text -> Either String Port
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

instance SD.ToSample RobotID where
  toSamples :: Proxy RobotID -> [(Text, RobotID)]
toSamples Proxy RobotID
_ = [RobotID] -> [(Text, RobotID)]
forall a. [a] -> [(Text, a)]
SD.samples [Port -> RobotID
RobotID Port
0, Port -> RobotID
RobotID Port
1]

instance ToCapture (Capture "id" RobotID) where
  toCapture :: Proxy (Capture "id" RobotID) -> DocCapture
toCapture Proxy (Capture "id" RobotID)
_ =
    String -> String -> DocCapture
SD.DocCapture
      String
"id" -- name
      String
"(integer) robot ID" -- description

instance FromHttpApiData AreaDimensions where
  parseUrlPiece :: Text -> Either Text AreaDimensions
parseUrlPiece Text
x = (String -> Text)
-> Either String AreaDimensions -> Either Text AreaDimensions
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left String -> Text
T.pack (Either String AreaDimensions -> Either Text AreaDimensions)
-> Either String AreaDimensions -> Either Text AreaDimensions
forall a b. (a -> b) -> a -> b
$ do
    [Int32]
pieces <- (Text -> Either String Int32) -> [Text] -> Either String [Int32]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (String -> Either String Int32
forall a. Read a => String -> Either String a
readEither (String -> Either String Int32)
-> (Text -> String) -> Text -> Either String Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) ([Text] -> Either String [Int32])
-> [Text] -> Either String [Int32]
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"x" Text
x
    case [Int32]
pieces of
      [Int32
w, Int32
h] -> AreaDimensions -> Either String AreaDimensions
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (AreaDimensions -> Either String AreaDimensions)
-> AreaDimensions -> Either String AreaDimensions
forall a b. (a -> b) -> a -> b
$ Int32 -> Int32 -> AreaDimensions
AreaDimensions Int32
w Int32
h
      [Int32]
_ -> String -> Either String AreaDimensions
forall a b. a -> Either a b
Left String
"Need two dimensions"

instance SD.ToSample AreaDimensions where
  toSamples :: Proxy AreaDimensions -> [(Text, AreaDimensions)]
toSamples Proxy AreaDimensions
_ = [AreaDimensions] -> [(Text, AreaDimensions)]
forall a. [a] -> [(Text, a)]
SD.samples [Int32 -> Int32 -> AreaDimensions
AreaDimensions Int32
20 Int32
30]

instance ToCapture (Capture "size" AreaDimensions) where
  toCapture :: Proxy (Capture "size" AreaDimensions) -> DocCapture
toCapture Proxy (Capture "size" AreaDimensions)
_ =
    String -> String -> DocCapture
SD.DocCapture
      String
"size" -- name
      String
"(integer, integer) dimensions of area" -- description