diff options
author | Jasper Van der Jeugt | 2020-07-29 15:57:28 +0200 |
---|---|---|
committer | Jasper Van der Jeugt | 2020-07-29 15:57:28 +0200 |
commit | 72b1de1a28c23cf694ff5f982f0f637afd4ba5bc (patch) | |
tree | d12b7bb68aa912c0845433a2ec72e399fb54ee60 /server/lib | |
parent | 125a792ec885d16fc0e41751d073caf2da9f2301 (diff) |
Stub server
Diffstat (limited to 'server/lib')
-rw-r--r-- | server/lib/Cafp/Main/GenerateElmTypes.hs | 17 | ||||
-rw-r--r-- | server/lib/Cafp/Main/Server.hs | 29 |
2 files changed, 46 insertions, 0 deletions
diff --git a/server/lib/Cafp/Main/GenerateElmTypes.hs b/server/lib/Cafp/Main/GenerateElmTypes.hs new file mode 100644 index 0000000..0bd43c1 --- /dev/null +++ b/server/lib/Cafp/Main/GenerateElmTypes.hs @@ -0,0 +1,17 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE TemplateHaskell #-} +module Cafp.Main.GenerateElmTypes + ( main + ) where + +import Cafp.Messages +import Elm.Derive +import Elm.Module +import Data.Proxy + +deriveBoth defaultOptions ''ServerMessage + +main :: IO () +main = putStrLn $ makeElmModule "Messages" + [ DefineElm (Proxy :: Proxy ServerMessage) + ] diff --git a/server/lib/Cafp/Main/Server.hs b/server/lib/Cafp/Main/Server.hs new file mode 100644 index 0000000..a2561a3 --- /dev/null +++ b/server/lib/Cafp/Main/Server.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} +module Cafp.Main.Server + ( main + ) where + +import Cafp.Messages +import Control.Concurrent.STM (STM, TVar, newTVar) +import Control.Monad (when) +import qualified Data.HashMap.Strict as HMS +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import qualified Web.Scotty as Scotty + +type RoomId = T.Text + +data Server = Server + { serverRooms :: TVar (HMS.HashMap RoomId ()) + } + +newServer :: STM Server +newServer = Server <$> newTVar HMS.empty + +main :: IO () +main = Scotty.scotty 3000 $ do + Scotty.get "/rooms/:id" $ do + roomId <- Scotty.param "id" + when (T.length roomId < 6) $ + Scotty.raise "Room ID should be at least 6 characters" + Scotty.html $ "<h1>Scotty, " <> TL.fromStrict roomId <> " me up!</h1>" |