1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Server.ControlRoom where
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Swagger (ToSchema (..))
import Data.Text (Text)
import GTFS
import Lucid
import Servant
import Servant.API (Capture, Get, JSON, NoContent,
PlainText, Post, QueryParam,
ReqBody, type (:<|>) ((:<|>)))
import Servant.HTML.Lucid (HTML)
import Server.Util
import Web.Internal.FormUrlEncoded (Form)
data TripList = TripList
{ tripListHeader :: Text
, tripListType :: Text
, tripListTrips :: [TripID]
}
type ControlRoomAPI =
Get '[HTML] TripList
:<|> "irgendwo" :> ReqBody '[FormUrlEncoded] CalendarDate :> Post '[PlainText] Text
controlRoomServer :: Service ControlRoomAPI
controlRoomServer =
(pure (TripList "hallo" "welt" []))
:<|> (\text -> do
liftIO $ putStrLn (show text)
pure "hello"
)
instance ToHtml TripList where
toHtml TripList{..} = form_ [action_ "./irgendwo", method_ "post"] $ do
input_ [type_ "text", name_ "caldateServiceId"]
input_ [type_ "text", name_ "caldateDate"]
input_ [type_ "text", name_ "caldateExceptionType"]
input_ [type_ "submit", value_ "hallo!"]
instance ToSchema Form where
declareNamedSchema _ = undefined
instance ToSchema TripList where
declareNamedSchema _ = undefined
instance ToSchema CalendarDate where
declareNamedSchema _ = undefined
|
