59 lines
1.7 KiB
Haskell
59 lines
1.7 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
|
|
module Soostone.Handlers where
|
|
|
|
import Soostone.Types
|
|
( AppState(AppState, sqliteFile, stmMap), AppM, Count(..), Key )
|
|
|
|
import Data.Functor ( ($>) )
|
|
import Database.SQLite.Simple
|
|
( open,
|
|
Connection,
|
|
close,
|
|
executeNamed,
|
|
queryNamed,
|
|
withImmediateTransaction,
|
|
NamedParam((:=)) )
|
|
import Control.Monad.Catch ( finally )
|
|
import Control.Monad.Reader ( ask )
|
|
import Control.Monad.IO.Class ( liftIO )
|
|
import qualified StmContainers.Map as SM
|
|
import GHC.Conc (atomically)
|
|
|
|
|
|
submitKeyHandler :: Key -> AppM ()
|
|
submitKeyHandler key = do
|
|
AppState{..} <- ask
|
|
liftIO $ atomically $ do
|
|
SM.lookup key stmMap >>= \case
|
|
Just v -> SM.insert (v + 1) key stmMap
|
|
Nothing -> SM.insert 1 key stmMap
|
|
|
|
{--
|
|
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 = do
|
|
AppState{..} <- ask
|
|
liftIO $ atomically $ do
|
|
SM.lookup key stmMap >>= \case
|
|
Just v -> return v
|
|
Nothing -> return (Count 0)
|
|
|
|
withSQLiteCon :: (Connection -> AppM a) -> AppM a
|
|
withSQLiteCon action = do
|
|
AppState{..} <- ask
|
|
conn <- liftIO $ open sqliteFile
|
|
action conn `finally` liftIO (close conn)
|