1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
{-# 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
|
