haskellpersistent

Haskell Persistent Library - How do I get data from my database to my frontend?

Hi and thanks for your time. I'm trying to create a website that features a button that increments a counter. I want the current counter to be persistent and if somebody goes to my page, the current counter should be displayed. A request should be send every time I click the button to increment the counter. The request does not contain any information about the counter value. The server - in my case a warp web server - should update the counter value in the database, read the value after the update and then send it to the frontend if successful, of an error message if not.

So far, only the updating works, since I did not manage to figure out how to get the data from the database to the frontend. Here is the code from my Repository module that should do the updating:

{-# 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

This compiles and actually persists the counter and updates the value every time its called. But as you can tell from the types, after update it only prints the counter value to the console. I seem to have problems understanding how to use the data that is returned from the getBy function. The docs say:

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

Is the 'backend m' basically a nested monad? Assuming I simply want to send the value of the counter if it is Just Int and I want to return -1 if it is Nothing. I assume I can not modify the increaseCounter function so that its type is Maybe Int. But how do I pass functions into the monad / access the value inside to send a response to the frontend?

If this question is to superficial and/or I lack too much knowledge to proceed at this point, can you recommend good sources for information? Something like a good tutorial or youtube channel or something?

Thanks!

Solution

  • You can ignore all the monadic parts of getBy's type signature. Provided you get your code to type check, counterEntity has type Maybe (Entity Counter), and that's all that's important here.

    The counterEntity is Nothing if the query fails (i.e., no record in the table for that counter). Otherwise, it's Just an Entity Counter containing the retrieved record:

    case counterEntity of
  Just e -> ...

    This e :: Entity Counter can be turned into a Counter via entityVal. The desired field of that Counter can be extracted with counterCounterCount. The result will be a Maybe Int because you've tagged that field as Maybe, so you'll have another layer of Maybe to unpack:

    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

    You'll want to return this value from increaseCounter, so the final version will look like this:

    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

    Wherever you previously successfully used increaseCounter to increase the counter, you'll now want to write:

    updatedCounterValue <- increaseCounter

    and you can pass the plain old updatedCounterValue :: Int to the front end.

    You might find it more sensible to use upsertBy, which can insert the counter record if it's missing and update it otherwise. It also returns the inserted/updated entity, saving you a separate getBy call. I also don't understand why you've tagged counterCount with Maybe. Why would you insert a counter into your table with no value? Wouldn't "0" be a better starting value if you wanted to indicate "no count"?

    So, I'd rewrite the schema as:

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

    and the increaseCounter function as:

    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)

    To either insert a 1-count or increase an existing count.

    Finally, as a general design approach, it's probably better to move the database migration and connection setup into the main function, and maybe use a pool of connections, something like:

    #!/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")