Skip to content

Instantly share code, notes, and snippets.

@vaibhavsagar
Created January 24, 2017 03:01
Show Gist options
  • Save vaibhavsagar/694e0a823c5a4a5b52ddb4277b55ba1d to your computer and use it in GitHub Desktop.
Save vaibhavsagar/694e0a823c5a4a5b52ddb4277b55ba1d to your computer and use it in GitHub Desktop.
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