Skip to content

Instantly share code, notes, and snippets.

@damienklinnert
Created November 12, 2015 11:55
Show Gist options
  • Save damienklinnert/5a957b095b1a3cc0ac9b to your computer and use it in GitHub Desktop.
Save damienklinnert/5a957b095b1a3cc0ac9b to your computer and use it in GitHub Desktop.
a quick example of a haskell web service
{-# LANGUAGE OverloadedStrings #-}
module HaskellTodo where
import Network.Wai
import Network.HTTP.Types.Status
import Network.Wai.Handler.Warp (run)
import System.IO
import qualified Data.ByteString.Lazy as B
import Data.ByteString.Lazy.Char8 (pack)
import Debug.Trace (trace)
class VisitorCountRepository a where
addOne :: a -> IO ()
getCount :: a -> IO (Int)
todoApp :: (VisitorCountRepository r) => r -> Application
todoApp store request respond = trace (show r) $ case r of
("POST", ["add"]) -> do
addOne store
respond $ responseLBS status200 [("Content-Type", "text/plain")] "Added One"
("GET", []) -> do
counter <- getCount store
let msg = "Hello Visitor Number " `B.append` (pack . show $ counter)
respond $ responseLBS status200 [("Content-Type", "text/plain")] msg
_ -> respond $ responseLBS status404 [("Content-Type", "text/plain")] "Not Found"
where r = (requestMethod request, pathInfo request)
main :: IO ()
main = do
putStrLn "Listening on port 8020"
run 8020 (todoApp (FileVisitorCountRepository "counts.log"))
data FileVisitorCountRepository = FileVisitorCountRepository String
countOneVisitor :: FileVisitorCountRepository -> IO ()
countOneVisitor (FileVisitorCountRepository path) = withFile path AppendMode (`hPutChar` 'x')
getVisitorCount :: FileVisitorCountRepository -> IO (Int)
getVisitorCount (FileVisitorCountRepository path) = withFile path ReadWriteMode hGetLine >>= (return . length)
instance VisitorCountRepository FileVisitorCountRepository where
addOne = countOneVisitor
getCount = getVisitorCount
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment