Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
A simple key-value store.
#!/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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment