Постоянная библиотека Haskell — Как я могу получить данные из своей базы данных на свой интерфейс?

#haskell #persistent

Вопрос:

Привет и спасибо, что уделили мне время. Я пытаюсь создать веб-сайт, на котором есть кнопка, увеличивающая счетчик. Я хочу, чтобы текущий счетчик был постоянным, и если кто-то зайдет на мою страницу, должен отображаться текущий счетчик. Запрос должен отправляться каждый раз, когда я нажимаю кнопку, чтобы увеличить счетчик. Запрос не содержит никакой информации о значении счетчика. Сервер — в моем случае веб — сервер warp-должен обновить значение счетчика в базе данных, прочитать значение после обновления, а затем в случае успеха отправить его на интерфейс, а в противном случае-сообщение об ошибке.

Пока работает только обновление, так как мне не удалось выяснить, как перенести данные из базы данных на интерфейс. Вот код из моего модуля репозитория, который должен выполнить обновление:

 {-# LANGUAGE EmptyDataDecls, FlexibleContexts, GADTs, GeneralizedNewtypeDeriving#-}
{-# LANGUAGE MultiParamTypeClasses, OverloadedStrings, QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell, TypeFamilies, DataKinds, FlexibleInstances#-}
{-# LANGUAGE DerivingStrategies, StandaloneDeriving, UndecidableInstances #-}

module Repository (increaseCounter) where

import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runStderrLoggingT)
import Database.Persist
import Database.Persist.Sqlite
import Database.Persist.TH
import Control.Monad.Reader
import Data.Text
import Data.Maybe

-- setting up the Counter entity with a unique key so I can use the getBy function
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
      Counter
        counterName String
        counterCount Int Maybe
        UniqueCounterName counterName
        deriving Show
    |]
    
increaseCounter :: IO ()
increaseCounter = 
    runStderrLoggingT $ withSqliteConn "//absolute/path/database.db" $ runSqlConn $ do
    runMigration migrateAll -- only for developing

    updateWhere [CounterCounterName ==. "unique name"] [CounterCounterCount  =. Just 1]
    counterEntity <- getBy $ UniqueCounterName name
    liftIO $ print counterEntity

 

Это компилирует и фактически сохраняет счетчик и обновляет значение при каждом его вызове. Но, как вы можете судить по типам, после обновления он выводит на консоль только значение счетчика.
Кажется, у меня проблемы с пониманием того, как использовать данные, возвращаемые функцией GetBy.
В документах говорится:

 getBy :: (PersistUniqueRead backend, MonadIO m, PersistRecordBackend record backend) => 
Unique record -> ReaderT backend m (Maybe (Entity record))
 

Является ли «серверная часть m» в основном вложенной монадой?
Предполагая, что я просто хочу отправить значение счетчика, если оно есть Just Int , и я хочу вернуть -1, если это так Nothing .
Я предполагаю, что не могу изменить функцию счетчика увеличения так, чтобы ее тип был Maybe Int . Но как мне передать функции в монаду / получить доступ к значению внутри, чтобы отправить ответ на интерфейс?

Если этот вопрос является поверхностным и/или мне не хватает слишком много знаний, чтобы продолжить на этом этапе, можете ли вы порекомендовать хорошие источники информации? Что-то вроде хорошего учебника или канала на YouTube или что-то в этом роде?

Спасибо!

Комментарии:

1. Если вы используете Warp, то приложение , которое вы предоставляете для запуска Warp, обрабатывает запрос и возвращает ответ, но вы не делитесь этим кодом. Я немного смущен тем, что у вас есть и что работает.

Ответ №1:

Вы можете игнорировать все монадические части getBy подписи типа s. При условии, что вы получите код для проверки типа , counterEntity у него есть тип Maybe (Entity Counter) , и это все, что здесь важно.

Это counterEntity происходит Nothing , если запрос завершается неудачно (т. Е. в таблице нет записи для этого счетчика). В противном случае это Just Entity Counter файл, содержащий полученную запись:

 case counterEntity of
  Just e -> ...
 

Это e :: Entity Counter можно превратить в Counter via entityVal . Желаемое поле этого Counter можно извлечь с counterCounterCount помощью . Результатом будет a Maybe Int , потому что вы пометили это поле как Maybe , так что у вас будет еще один слой Maybe для распаковки:

 case counterEntity of
   Nothing -> -1    -- no record for this counter
   Just e -> case counterCounterCount (entityVal e) of
     Nothing -> -1  -- record, but counter value missing
     Just v -> v
 

Вы захотите вернуть это значение из increaseCounter , поэтому окончательная версия будет выглядеть следующим образом:

 increaseCounter :: IO Int
increaseCounter =
    runStderrLoggingT $ withSqliteConn "//absolute/path/database.db" $ runSqlConn $ do
    runMigration migrateAll -- only for developing
    updateWhere [CounterCounterName ==. "unique name"] [CounterCounterCount  =. Just 1]
    counterEntity <- getBy $ UniqueCounterName "unique name"
    return $ case counterEntity of
      Nothing -> -1
      Just e -> case counterCounterCount . entityVal $ e of
        Nothing -> -1
        Just v -> v
 

Везде, где вы ранее успешно использовали increaseCounter для увеличения счетчика, теперь вы захотите написать:

 updatedCounterValue <- increaseCounter
 

и вы можете передать обычное старое updatedCounterValue :: Int на передний план.

Возможно , вам покажется более разумным использовать upsertBy его, который может вставить запись счетчика, если она отсутствует, и обновить ее в противном случае. Он также возвращает вставленную/обновленную сущность, экономя вам отдельный getBy вызов. Я также не понимаю, почему вы отметили counterCount Maybe . Зачем вам вставлять счетчик в свою таблицу без значения? Разве «0» не было бы лучшим начальным значением, если бы вы хотели указать «нет счета»?

Итак, я бы переписал схему следующим образом:

   Counter
    counterName String
    counterCount Int    -- no Maybe
    UniqueCounterName counterName
    deriving Show
 

и increaseCounter функция как:

 increaseCounter :: IO Int
increaseCounter =
    runStderrLoggingT $ withSqliteConn "//absolute/path/database.db" $ runSqlConn $ do
    runMigration migrateAll -- only for developing
    let name = "unique name"
    counterEntity <- upsertBy (UniqueCounterName name)
                              (Counter name 1)
                              [CounterCounterCount  =. 1]
    return $ counterCounterCount (entityVal counterEntity)
 

Чтобы либо вставить 1-счетчик, либо увеличить существующий счетчик.

Наконец, в качестве общего подхода к проектированию, вероятно, лучше перенести миграцию базы данных и настройку соединений в main функцию и, возможно, использовать пул соединений, что-то вроде:

 #!/usr/bin/env stack
-- stack --resolver lts-18.0 script
--   --package warp
--   --package persistent
--   --package persisent-sqlite

{-# LANGUAGE EmptyDataDecls, FlexibleContexts, GADTs, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses, OverloadedStrings, QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell, TypeFamilies, DataKinds, FlexibleInstances#-}
{-# LANGUAGE DerivingStrategies, StandaloneDeriving, UndecidableInstances #-}

import Control.Monad.Logger (runStderrLoggingT)
import Database.Persist
import Database.Persist.TH
import Database.Persist.Sqlite
import Control.Monad.Reader
import Network.HTTP.Types
import Network.Wai
import Network.Wai.Handler.Warp
import qualified Data.ByteString.Lazy.Char8 as C8

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
      Counter
        counterName String
        counterCount Int
        UniqueCounterName counterName
        deriving Show
    |]

increaseCounter :: ReaderT SqlBackend IO Int
increaseCounter = do
    let name = "unique name"
    counterEntity <- upsertBy (UniqueCounterName name)
                              (Counter name 1)
                              [CounterCounterCount  =. 1]
    return $ counterCounterCount (entityVal counterEntity)

main :: IO ()
main = runStderrLoggingT $ withSqlitePool "some_database.db" 5 $ pool -> do
  runSqlPool (runMigration migrateAll) pool
  let runDB act = runSqlPool act pool
  liftIO $ run 3000 $ req res -> do
    count <- runDB $ increaseCounter
    res $ responseLBS
      status200
      [("Content-Type", "text/plain")]
      (C8.pack $ show count    "n")
 

Комментарии:

1. Большое вам спасибо! Это очень помогло. Это не только напрямую решило мою проблему, но и дало мне несколько очень полезных советов об общей обработке запросов.