62 lines
1.8 KiB
Haskell
62 lines
1.8 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Main where
|
|
|
|
import Control.Monad.IO.Class
|
|
import Control.Monad.Trans.Class
|
|
import Control.Monad.Trans.Reader
|
|
import Data.IORef
|
|
import qualified Data.Map as M
|
|
import Data.Maybe (fromMaybe)
|
|
import Data.Text.Lazy (Text)
|
|
import qualified Data.Text.Lazy as TL
|
|
import System.Environment (getArgs)
|
|
import Web.Scotty.Trans ( ScottyT(..)
|
|
, ActionT(..)
|
|
, scottyT
|
|
, get
|
|
, html
|
|
, param )
|
|
|
|
data Config =
|
|
Config {
|
|
-- that's one, one click!
|
|
-- two...two clicks!
|
|
-- Three BEAUTIFUL clicks! ah ah ahhhh
|
|
counts :: IORef (M.Map Text Integer)
|
|
, prefix :: Text
|
|
}
|
|
|
|
type Scotty = ScottyT Text (ReaderT Config IO)
|
|
|
|
bumpBoomp :: Text
|
|
-> M.Map Text Integer
|
|
-> (M.Map Text Integer, Integer)
|
|
bumpBoomp k m =
|
|
let (maybeCount, newMap) = M.insertLookupWithKey (\_ _ oldCount -> oldCount + 1) k 1 m
|
|
in case maybeCount of
|
|
Nothing -> (newMap, 1)
|
|
Just oldCount -> (newMap, oldCount + 1)
|
|
|
|
app :: Scotty ()
|
|
app =
|
|
get "/:key" $ do
|
|
unprefixed <- param "key"
|
|
prefix <- lift $ asks prefix
|
|
let key' = mappend prefix unprefixed
|
|
counts <- lift $ asks counts
|
|
(newMap, newInteger) <- liftIO $ bumpBoomp key' <$> readIORef counts
|
|
liftIO $ writeIORef counts newMap
|
|
html $ mconcat [ "<h1>Success! Count was: "
|
|
, TL.pack $ show (newInteger :: Integer)
|
|
, "</h1>"
|
|
]
|
|
|
|
main :: IO ()
|
|
main = do
|
|
[prefixArg] <- getArgs
|
|
counter <- newIORef M.empty
|
|
let config = Config {counts = counter, prefix = TL.pack prefixArg}
|
|
runR = flip runReaderT config
|
|
scottyT 3000 runR app
|