Commit 275d2398 authored by MrMan's avatar MrMan

Working hello world style Servant HTTP server

parent 51fce3ac
......@@ -13,6 +13,8 @@ import Options.Applicative
import System.Environment (getEnvironment)
import Text.Pretty.Simple (pPrint)
import Components.EntityStore.SQLite
import Server (app)
import Network.Wai.Handler.Warp (run)
data Options = Options
{ cfgPath :: Maybe FilePath
......@@ -76,9 +78,13 @@ buildEntityStore cfg = putStrLn "[info] initializing EntityStore with config:"
-- | Start up the server and serve requests
server :: Complete AppConfig -> IO ()
server cfg = buildEntityStore entityStoreCfg
>>= \entityStore -> putStrLn "<SERVER START>"
>>= \entityStore -> startApp
where
entityStoreCfg = runIdentity $ entityStoreConfig cfg
appPort = runIdentity $ port cfg
startApp = putStrLn ("Starting server at port [" <> show appPort <> "]...")
>> run appPort app
main :: IO ()
main = parseOptions
......
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
module Server
(app)
where
import Data.Proxy
import Data.Semigroup ((<>))
import Servant.API
import Servant.Server (Server, Handler, Application, serve)
import qualified Data.Text as DT
type Name = DT.Text
type Greeting = DT.Text
type HelloWorldAPI =
"hello" :> QueryParam "name" DT.Text :> Get '[JSON] Greeting
:<|> "goodbye" :> QueryParam "name" DT.Text :> Get '[JSON] Greeting
helloWorldServer :: Server HelloWorldAPI
helloWorldServer = handleHello
:<|> handleGoodbye
handleHello :: Maybe Name -> Handler Greeting
handleHello Nothing = return $ "hello world"
handleHello (Just name) = return $ "hello " <> name
handleGoodbye :: Maybe Name -> Handler Greeting
handleGoodbye Nothing = return $ "goodbye world"
handleGoodbye (Just name) = return $ "goodbye " <> name
helloWorldAPI :: Proxy HelloWorldAPI
helloWorldAPI = Proxy
app :: Application
app = serve helloWorldAPI helloWorldServer
......@@ -48,6 +48,10 @@ executables:
- haskell-restish-todo
- optparse-applicative
- pretty-simple
- text
- servant
- servant-server
- warp
tests:
haskell-restish-todo-test:
......
......@@ -41,7 +41,7 @@ defaultEntityStoreFilePath :: FilePath
defaultEntityStoreFilePath = ":memory:"
type Host = String
type Port = Integer
type Port = Int
newtype ProcessEnvironment = ProcessEnvironment {getProcessEnv :: [(String, String)]} deriving (Eq)
data ConfigurationError = ConfigParseError String
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment