39 lines
1.3 KiB
Haskell
39 lines
1.3 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
|
|
module Soostone.Handlers where
|
|
|
|
import Soostone.Types
|
|
|
|
import Data.Functor
|
|
import Database.SQLite.Simple
|
|
import Control.Monad.Catch
|
|
import Control.Monad.Reader ( ask )
|
|
import Control.Monad.IO.Class ( liftIO )
|
|
|
|
|
|
submitKeyHandler :: Key -> AppM ()
|
|
submitKeyHandler key = withSQLiteCon $ \con -> do
|
|
r <- liftIO $ withImmediateTransaction con $ do
|
|
queryNamed @Count con "SELECT count FROM keys WHERE key=:key" [":key" := key] >>= \case
|
|
[] -> executeNamed con "INSERT INTO keys (key, count) VALUES (:key, :count)" [":key" := key, ":count" := Count 1] $> Right ()
|
|
[c] -> executeNamed con "UPDATE keys SET count = :count WHERE key = :key" [":count" := c + 1, ":key" := key] $> Right ()
|
|
_ -> pure $ Left "Oops"
|
|
case r of
|
|
Right _ -> pure ()
|
|
Left e -> fail e -- internal error
|
|
|
|
|
|
countKeyHandler :: Key -> AppM Count
|
|
countKeyHandler key = withSQLiteCon $ \con -> do
|
|
liftIO (queryNamed @Count con "SELECT count FROM keys WHERE key=:key" [":key" := key]) >>= \case
|
|
[] -> return (Count 0)
|
|
[c] -> pure c
|
|
_ -> fail "Oops" -- internal error
|
|
|
|
withSQLiteCon :: (Connection -> AppM a) -> AppM a
|
|
withSQLiteCon action = do
|
|
AppState{..} <- ask
|
|
conn <- liftIO $ open sqliteFile
|
|
action conn `finally` liftIO (close conn)
|