Skip to content

Instantly share code, notes, and snippets.

@jmackie
Last active December 5, 2022 06:37
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save jmackie/6a298d24d8ffac61dc57f6f254d2bf5a to your computer and use it in GitHub Desktop.
Save jmackie/6a298d24d8ffac61dc57f6f254d2bf5a to your computer and use it in GitHub Desktop.
Running a background process alongside a Wai Application
:set -fwarn-unused-binds -fwarn-unused-imports
:load Server.hs
#! /usr/bin/env nix-shell
#! nix-shell -p "haskell.packages.ghc822.ghcWithPackages (hs: with hs; [ http-client text wai warp ])"
#! nix-shell --pure
#! nix-shell -i runghc
{-# LANGUAGE OverloadedStrings #-}
module Main where
import qualified Control.Concurrent as C
import Control.Concurrent.MVar (MVar)
import qualified Control.Concurrent.MVar as MVar
import Data.Monoid ((<>))
import qualified Data.Text.Lazy as Text
import Data.Text.Lazy.Encoding (encodeUtf8)
import qualified Network.HTTP.Types as HTTP
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp
main :: IO ()
main = do
counter <- MVar.newMVar 0
C.forkIO (background counter)
Warp.run 8080 $ app counter
background :: MVar Int -> IO ()
background counter = do
MVar.modifyMVar_ counter (pure . (+ 1))
C.threadDelay second
background counter
where second = 1000000
app :: MVar Int -> Wai.Application
app counter _request respond = do
value <- MVar.readMVar counter
respond $ Wai.responseLBS HTTP.status200
[("Content-Type", "text/plain")]
("Counter at: " <> show' value)
where show' = encodeUtf8 . Text.pack . show
{ pkgs ? import <nixpkgs> {} }:
with pkgs; stdenv.mkDerivation {
name = "haskell-script";
buildInputs = with pkgs; [
(haskell.packages.ghc822.ghcWithPackages (
hspkgs: with hspkgs; [
http-client
text
wai
warp
]
))
];
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment