{-# 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.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.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.Game.Robot
import Swarm.Game.Scenario.Objective
import Swarm.Game.Scenario.Objective.Graph
import Swarm.Game.Scenario.Objective.WinCheck
import Swarm.Game.State
import Swarm.Language.Module
import Swarm.Language.Pipeline
import Swarm.Language.Pretty (prettyTextLine)
import Swarm.Language.Syntax
import Swarm.ReadableIORef
import Swarm.TUI.Model
import Swarm.TUI.Model.Goal
import Swarm.TUI.Model.UI
import System.Timeout (timeout)
import Text.Read (readEither)
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
    :<|> "code" :> "render" :> ReqBody '[PlainText] T.Text :> Post '[PlainText] T.Text
    :<|> "code" :> "run" :> ReqBody '[PlainText] T.Text :> Post '[PlainText] T.Text
    :<|> "repl" :> "history" :> "full" :> Get '[JSON] [REPLHistItem]

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

type ToplevelAPI = SwarmAPI :<|> Raw

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

swarmApiHtml :: ByteString
swarmApiHtml :: ByteString
swarmApiHtml =
  Text -> ByteString
encodeUtf8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) (forall a. Html a -> Text
Mark.renderHtml @())
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall il bl.
IsBlock il bl =>
String -> Text -> Either ParseError bl
Mark.commonmark String
""
    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
        forall a b. a -> (a -> b) -> b
& Lens' RenderingOptions ShowContentTypes
SD.requestExamples forall s t a b. ASetter s t a b -> b -> s -> t
.~ ShowContentTypes
SD.FirstContentType
        forall a b. a -> (a -> b) -> b
& Lens' RenderingOptions ShowContentTypes
SD.responseExamples forall s t a b. ASetter s t a b -> b -> s -> t
.~ ShowContentTypes
SD.FirstContentType
        forall a b. a -> (a -> b) -> b
& Lens' RenderingOptions (Maybe String)
SD.renderCurlBasePath forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ String
"http://localhost:" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Port
defaultPort
    )
    forall a b. (a -> b) -> a -> b
$ 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
    forall a b. a -> b -> a :<|> b
:<|> ReadableIORef AppState -> RobotID -> Handler (Maybe Robot)
robotHandler ReadableIORef AppState
state
    forall a b. a -> b -> a :<|> b
:<|> ReadableIORef AppState -> Handler [PrereqSatisfaction]
prereqsHandler ReadableIORef AppState
state
    forall a b. a -> b -> a :<|> b
:<|> ReadableIORef AppState -> Handler [Objective]
activeGoalsHandler ReadableIORef AppState
state
    forall a b. a -> b -> a :<|> b
:<|> ReadableIORef AppState -> Handler (Maybe GraphInfo)
goalsGraphHandler ReadableIORef AppState
state
    forall a b. a -> b -> a :<|> b
:<|> ReadableIORef AppState -> Handler GoalTracking
uiGoalHandler ReadableIORef AppState
state
    forall a b. a -> b -> a :<|> b
:<|> ReadableIORef AppState -> Handler WinCondition
goalsHandler ReadableIORef AppState
state
    forall a b. a -> b -> a :<|> b
:<|> Text -> Handler Text
codeRenderHandler
    forall a b. a -> b -> a :<|> b
:<|> BChan AppEvent -> Text -> Handler Text
codeRunHandler BChan AppEvent
events
    forall a b. a -> b -> a :<|> b
:<|> ReadableIORef AppState -> Handler [REPLHistItem]
replHandler ReadableIORef AppState
state

robotsHandler :: ReadableIORef AppState -> Handler [Robot]
robotsHandler :: ReadableIORef AppState -> Handler [Robot]
robotsHandler ReadableIORef AppState
appStateRef = do
  AppState
appState <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. ReadableIORef a -> IO a
readIORef ReadableIORef AppState
appStateRef)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> [a]
IM.elems forall a b. (a -> b) -> a -> b
$ AppState
appState forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState (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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. ReadableIORef a -> IO a
readIORef ReadableIORef AppState
appStateRef)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Port -> IntMap a -> Maybe a
IM.lookup Port
rid (AppState
appState forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState (IntMap Robot)
robotMap)

prereqsHandler :: ReadableIORef AppState -> Handler [PrereqSatisfaction]
prereqsHandler :: ReadableIORef AppState -> Handler [PrereqSatisfaction]
prereqsHandler ReadableIORef AppState
appStateRef = do
  AppState
appState <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. ReadableIORef a -> IO a
readIORef ReadableIORef AppState
appStateRef)
  case AppState
appState forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState WinCondition
winCondition of
    WinConditions WinStatus
_winState ObjectiveCompletion
oc -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ObjectiveCompletion -> [PrereqSatisfaction]
getSatisfaction ObjectiveCompletion
oc
    WinCondition
_ -> 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. ReadableIORef a -> IO a
readIORef ReadableIORef AppState
appStateRef)
  case AppState
appState forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState WinCondition
winCondition of
    WinConditions WinStatus
_winState ObjectiveCompletion
oc -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ObjectiveCompletion -> [Objective]
getActiveObjectives ObjectiveCompletion
oc
    WinCondition
_ -> 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. ReadableIORef a -> IO a
readIORef ReadableIORef AppState
appStateRef)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case AppState
appState forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState WinCondition
winCondition of
    WinConditions WinStatus
_winState ObjectiveCompletion
oc -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ObjectiveCompletion -> GraphInfo
makeGraphInfo ObjectiveCompletion
oc
    WinCondition
_ -> forall a. Maybe a
Nothing

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

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

codeRenderHandler :: Text -> Handler Text
codeRenderHandler :: Text -> Handler Text
codeRenderHandler Text
contents = do
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Text -> Either Text ProcessedTerm
processTermEither Text
contents of
    Right (ProcessedTerm (Module stx :: Syntax' Polytype
stx@(Syntax' SrcLoc
_srcLoc Term' Polytype
_term Polytype
_) Ctx Polytype
_) Requirements
_ ReqCtx
_) ->
      forall target source. From source target => source -> target
into @Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree String -> String
drawTree forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PrettyPrec a => a -> Text
prettyTextLine) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a r. Plated a => (a -> [r] -> r) -> a -> r
para forall a. a -> [Tree a] -> Tree a
Node forall a b. (a -> b) -> a -> b
$ Syntax' Polytype
stx
    Left Text
x -> Text
x

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

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

-- ------------------------------------------------------------------
-- 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 = 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 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 forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO ()
putMVar MVar WebStartResult
mv WebStartResult
WebStarted
    Maybe (MVar WebStartResult)
Nothing -> 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 forall a b. a -> b -> a :<|> b
:<|> forall {k} (s :: k) b. b -> Tagged s b
Tagged forall {p} {b}. p -> (Response -> b) -> b
serveDocs
   where
    serveDocs :: p -> (Response -> b) -> b
serveDocs p
_ Response -> b
resp =
      Response -> b
resp 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 = 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 -> forall a. MVar a -> a -> IO ()
putMVar MVar WebStartResult
mv (String -> WebStartResult
WebStartError forall a b. (a -> b) -> a -> b
$ forall e. Exception e => e -> String
displayException IOException
e)
    Maybe (MVar WebStartResult)
Nothing -> 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
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 <- forall a. IO (MVar a)
newEmptyMVar
  let port :: 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 :" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Port
port
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ Maybe (MVar WebStartResult)
-> Port -> ReadableIORef AppState -> BChan AppEvent -> IO ()
webMain (forall a. a -> Maybe a
Just MVar WebStartResult
baton) Port
port ReadableIORef AppState
appStateRef BChan AppEvent
chan
  Maybe WebStartResult
res <- forall a. Port -> IO a -> IO (Maybe a)
timeout Port
500_000 (forall a. MVar a -> IO a
takeMVar MVar WebStartResult
baton)
  case Maybe WebStartResult
res of
    Just WebStartResult
WebStarted -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right Port
port)
    Just (WebStartError String
e) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
failMsg forall a. Semigroup a => a -> a -> a
<> 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 -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
failMsg
      Maybe Port
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
failMsg 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
_ = forall a. [(Text, a)]
SD.noSamples

instance FromHttpApiData RobotID where
  parseUrlPiece :: Text -> Either Text RobotID
parseUrlPiece = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Port -> RobotID
RobotID forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Either String a
readEither 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
_ = 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