gistfile1.hs

waiApp :: Parseable a => ([(Text, Query a)] -> IO (Async (), MVar (Text,Row))) -> Application
waiApp worker = \req -> do
  -- could make this a Source, but we expect it to be relatively small.
  body <- lazyRequestBody req
  case decode body of
    Nothing -> error "booo"
    Just l -> do
      let (badQ,goodQ) = partitionEithers $ map (\((name::Text),q) -> (name,) `fmap` parsePythia q) l
      started <- worker goodQ
      return (responseSource status200 [] $ do
                 yield $ Chunk $ fromLazyByteString "["
                 source started $= DCC.intersperse (Chunk $ fromLazyByteString ",\n")
                 yield $ Chunk $ fromLazyByteString "]"
             )
source ::  (Async (), MVar (Text,Row))
           -> Source IO (Flush Builder)
source (task,mvar) = do
  l <- liftIO $ race (wait task) (takeMVar mvar)
  case l of
    Left _ -> do
      liftIO $ putStrLn "Source done"
    Right x -> do
      yield $ Chunk (fromLazyByteString $ encode x)
      source (task,mvar)