Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #!/usr/bin/env stack
- {- stack --resolver lts-7 --install-ghc runghc
- --package aeson
- --package servant-server
- --package text
- --package transformers
- --package unordered-containers
- --package warp
- -}
- {-# LANGUAGE DataKinds #-}
- {-# LANGUAGE TypeOperators #-}
- module Main where
- import Control.Monad.IO.Class (liftIO)
- import Data.Aeson (Value)
- import Data.IORef (IORef, newIORef, readIORef, atomicModifyIORef')
- import Data.HashMap.Strict (HashMap, lookup, insert, empty)
- import Data.Text (Text)
- import Network.Wai.Handler.Warp (run)
- import System.Environment (getArgs)
- import Prelude hiding (lookup)
- import Servant
- type API
- = "get" :> Capture "key" Text :> Get '[JSON] (Maybe Value)
- :<|> "put" :> Capture "key" Text
- :> ReqBody '[JSON] Value :> Put '[JSON] Text
- type Store = IORef (HashMap Text Value)
- server :: Store -> Server API
- server store = getValue store :<|> putValue store
- getValue :: Store -> Text -> Handler (Maybe Value)
- getValue store key = liftIO $ lookup key <$> readIORef store
- putValue :: Store -> Text -> Value -> Handler Text
- putValue store key value = liftIO $ atomicModifyIORef' store modify
- where modify kv = (insert key value kv, key)
- kvAPI :: Proxy API
- kvAPI = Proxy
- main :: IO ()
- main = do
- port <- read . head <$> getArgs :: IO Int
- run port . serve kvAPI . server =<< newIORef empty
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement