Advertisement
Guest User

Untitled

a guest
Jan 23rd, 2017
83
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.40 KB | None | 0 0
  1. #!/usr/bin/env stack
  2. {- stack --resolver lts-7 --install-ghc runghc
  3. --package aeson
  4. --package servant-server
  5. --package text
  6. --package transformers
  7. --package unordered-containers
  8. --package warp
  9. -}
  10.  
  11. {-# LANGUAGE DataKinds #-}
  12. {-# LANGUAGE TypeOperators #-}
  13.  
  14. module Main where
  15.  
  16. import Control.Monad.IO.Class (liftIO)
  17. import Data.Aeson (Value)
  18. import Data.IORef (IORef, newIORef, readIORef, atomicModifyIORef')
  19. import Data.HashMap.Strict (HashMap, lookup, insert, empty)
  20. import Data.Text (Text)
  21. import Network.Wai.Handler.Warp (run)
  22. import System.Environment (getArgs)
  23. import Prelude hiding (lookup)
  24. import Servant
  25.  
  26. type API
  27. = "get" :> Capture "key" Text :> Get '[JSON] (Maybe Value)
  28. :<|> "put" :> Capture "key" Text
  29. :> ReqBody '[JSON] Value :> Put '[JSON] Text
  30.  
  31. type Store = IORef (HashMap Text Value)
  32.  
  33. server :: Store -> Server API
  34. server store = getValue store :<|> putValue store
  35.  
  36. getValue :: Store -> Text -> Handler (Maybe Value)
  37. getValue store key = liftIO $ lookup key <$> readIORef store
  38.  
  39. putValue :: Store -> Text -> Value -> Handler Text
  40. putValue store key value = liftIO $ atomicModifyIORef' store modify
  41. where modify kv = (insert key value kv, key)
  42.  
  43. kvAPI :: Proxy API
  44. kvAPI = Proxy
  45.  
  46. main :: IO ()
  47. main = do
  48. port <- read . head <$> getArgs :: IO Int
  49. run port . serve kvAPI . server =<< newIORef empty
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement