{-# 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