test3

frameworks/Haskell/spock/spock.cabal

@@ -24,6 +24,10 @@ executable spock-exe
                      , postgresql-simple
                      , random
                      , transformers
+                     , async
+                     , mtl
+                     , resourcet
+                     , http-types
   default-language:    Haskell2010
 
 source-repository head

frameworks/Haskell/spock/src/Main.hs

@@ -3,13 +3,15 @@
 
 module Main where
 
+import           Control.Concurrent.Async           (mapConcurrently)
 import           Control.Monad.IO.Class
 import           Data.Aeson                         hiding (json)
-import           Data.Maybe                         (listToMaybe)
+import           Data.Maybe                         (catMaybes, listToMaybe)
 import qualified Data.Text                          as T
 import qualified Database.PostgreSQL.Simple         as PG
 import           Database.PostgreSQL.Simple.FromRow
 import           GHC.Exts
+import           Network.HTTP.Types.Status
 import           System.Random
 import           Web.Spock.Safe
 
@@ -26,14 +28,10 @@ instance ToJSON World where
         , "randomNumber"  .= _randomNumberW w
         ]
 
+
 instance FromRow World where
     fromRow = World <$> field <*> field
 
-data Fortune = Fortune
-    { _idF      :: Integer
-    , _messageF :: T.Text
-    } deriving (Show)
-
 
 fetchWorldById :: Int -> PG.Connection -> IO (Maybe World)
 fetchWorldById i c =
@@ -42,6 +40,12 @@ fetchWorldById i c =
         (PG.Only i)
 
 
+data Fortune = Fortune
+    { _idF      :: Integer
+    , _messageF :: T.Text
+    } deriving (Show)
+
+
 dbConn :: PoolOrConn PG.Connection
 dbConn =
   PCConn (ConnBuilder
@@ -59,16 +63,26 @@ dbConn =
 main :: IO ()
 main =
     runSpock 3000 $ spock (defaultSpockCfg Nothing dbConn ()) $
+            -- | Test 1: JSON serialization
         do  get "json" $
-                -- | Test 1: JSON serialization
                 json $ Object (fromList [("message", "Hello, World!")])
-            get "db" $ do
-                -- | Test 2: Single database query
-                rand <- liftIO $ randomRIO (1, 10000)
-                maybeWorld <- runQuery $ fetchWorldById rand
-                case maybeWorld of
-                  Just w  -> json w
-                  Nothing -> text "World not found."
+            -- | Test 2: Single database query
+            get "db" $
+                do  rand <- liftIO $ randomRIO (1, 10000)
+                    maybeWorld <- runQuery $ fetchWorldById rand
+                    case maybeWorld of
+                      Just w  -> json w
+                      Nothing -> setStatus status404 >> text "World not found."
+            -- | Test 3: Multiple database queries
+            get "queries" $
+                do  queries <- max 1 . min 500 <$> param' "queries"
+                    let runSQL core = runSpockIO core . runQuery . fetchWorldById =<< randomRIO (1, 10000)
+                    spockCore <- getSpockHeart
+                    maybeWorlds <- liftIO $ mapConcurrently (\_ -> runSQL spockCore) ([1..queries] :: [Int])
+                    json $ catMaybes maybeWorlds
+            -- | Test 4: Fortunes
+            get "fortune" $
+                do  liftIO $ putStrLn "test"
+            -- | Test 6: Plain text
             get "plaintext" $
-                -- | Test 6: Plain text
                 text "Hello, World!"