aboutsummaryrefslogtreecommitdiff
path: root/lib/Server/ControlRoom.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Server/ControlRoom.hs')
-rw-r--r--lib/Server/ControlRoom.hs53
1 files changed, 53 insertions, 0 deletions
diff --git a/lib/Server/ControlRoom.hs b/lib/Server/ControlRoom.hs
new file mode 100644
index 0000000..6f5999f
--- /dev/null
+++ b/lib/Server/ControlRoom.hs
@@ -0,0 +1,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