Skip to content
This repository
Browse code

Fiddle with servers a little.

--HG--
rename : servers/ping/src/Main.hs => servers/ping/src/Snap.hs
  • Loading branch information...
commit 22722ea5f0400e78033ae36f5ecbd6400a160c5a 1 parent 47470a3
Bryan O'Sullivan authored
16 servers/ping/ping-servers.cabal
@@ -5,13 +5,25 @@ Cabal-version: >=1.2
5 5
6 6 Executable ping-server-snap
7 7 hs-source-dirs: src
8   - main-is: Main.hs
  8 + main-is: Snap.hs
9 9
10 10 Build-depends:
11 11 base >= 4 && < 5,
12   - bytestring >= 0.9.1 && < 0.10,
13 12 snap == 0.5.*,
14 13 snap-core == 0.5.*,
15 14 snap-server == 0.5.*
16 15
17 16 ghc-options: -rtsopts -threaded -Wall
  17 +
  18 +Executable ping-server-warp
  19 + hs-source-dirs: src
  20 + main-is: Warp.hs
  21 +
  22 + Build-depends:
  23 + base >= 4 && < 5,
  24 + blaze-builder >= 0.3.0.1,
  25 + http-types >= 0.6.5.1,
  26 + wai >= 0.4.1,
  27 + warp >= 0.4.2
  28 +
  29 + ghc-options: -rtsopts -threaded -Wall
13 servers/ping/src/Application.hs
... ... @@ -1,13 +0,0 @@
1   -module Application
2   - ( Application
3   - , applicationInitializer
4   - ) where
5   -
6   -import Snap.Extension
7   -
8   -type Application = SnapExtend ApplicationState
9   -
10   -type ApplicationState = ()
11   -
12   -applicationInitializer :: Initializer ApplicationState
13   -applicationInitializer = return ()
6 servers/ping/src/Main.hs
... ... @@ -1,6 +0,0 @@
1   -import Snap.Extension.Server
2   -import Application
3   -import Site
4   -
5   -main :: IO ()
6   -main = quickHttpServe applicationInitializer site
8 servers/ping/src/Site.hs
... ... @@ -1,8 +0,0 @@
1   -{-# LANGUAGE OverloadedStrings #-}
2   -
3   -module Site (site) where
4   -
5   -import Application
6   -
7   -site :: Application ()
8   -site = return ()
15 servers/ping/src/Snap.hs
... ... @@ -0,0 +1,15 @@
  1 +{-# LANGUAGE OverloadedStrings #-}
  2 +import Snap.Http.Server (httpServe)
  3 +import Snap.Http.Server.Config (defaultConfig, setAccessLog, setErrorLog, setPort)
  4 +import Snap.Types (Snap, writeBS)
  5 +
  6 +site :: Snap ()
  7 +site = writeBS "PONG"
  8 +
  9 +main :: IO ()
  10 +main = do
  11 + let config = setPort 8000 .
  12 + setAccessLog Nothing .
  13 + setErrorLog Nothing $
  14 + defaultConfig
  15 + httpServe config site
11 servers/ping/src/Warp.hs
... ... @@ -0,0 +1,11 @@
  1 +{-# LANGUAGE OverloadedStrings #-}
  2 +import Blaze.ByteString.Builder (fromByteString)
  3 +import Network.HTTP.Types (status200)
  4 +import Network.Wai (Response(ResponseBuilder))
  5 +import Network.Wai.Handler.Warp (run)
  6 +
  7 +main :: IO ()
  8 +main = run 8000 $ const $ return $ ResponseBuilder
  9 + status200
  10 + [("Content-Type", "text/plain"), ("Content-Length", "4")]
  11 + $ fromByteString "PONG"

0 comments on commit 22722ea

Please sign in to comment.
Something went wrong with that request. Please try again.