From 198290cf11d859aa7f10e9377db8b65646340bca Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Sun, 3 Jul 2022 22:41:46 +0200
Subject: barebones webform API & frontend

---
 lib/Server/ControlRoom.hs | 53 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 53 insertions(+)
 create mode 100644 lib/Server/ControlRoom.hs

(limited to 'lib/Server/ControlRoom.hs')

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
-- 
cgit v1.2.3