[web-devel] Esqueleto type trickery question

Erik de Castro Lopo mle+hs at mega-nerd.com
Sat Nov 24 12:07:31 CET 2012


Hi all,

Below my .sig is a little Persist/Esqueleto program that works correctly.

The getUserCount function does thr right thing and returns the number of
rows in the User table. However, what I'd like is a generic function
that returns the row count of any table, something vaguely like this:


    queryRowCount :: tableType -> SqlPersist IO Int64
    queryRowCount tableName = do
        [Value x] <- select . from $ \(_ :: SqlExpr (Entity tableName)) ->
                        return countRows
        return x


Is there any way to do this? Its probably possible in Agda, but can it
be made to work with GHC?

Cheers,
Erik
-- 
----------------------------------------------------------------------
Erik de Castro Lopo
http://www.mega-nerd.com/




{-# LANGUAGE FlexibleContexts, GADTs, GeneralizedNewtypeDeriving, OverloadedStrings,
            QuasiQuotes, ScopedTypeVariables, TypeFamilies, TemplateHaskell #-}
import Control.Monad (void)
import Control.Monad.IO.Class (liftIO)
import Database.Esqueleto
import Database.Persist.Sqlite
import Database.Persist.TH
import GHC.Int (Int64)

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persist|
    User
        firstName String
        lastName String
        emailAddress String
        UserName firstName lastName
        deriving Show
    Project
        name String
        description String
        deriving Show
    |]

-- This works, but only for the User table.
queryUserCount :: SqlPersist IO Int64
queryUserCount = do
    [Value x] <- select . from $ \(_ :: SqlExpr (Entity User)) ->
                    return countRows
    return x

main :: IO ()
main = withSqliteConn ":memory:" $ runSqlConn $ do
    void $ runMigrationSilent migrateAll
    void $ insert $ User "Fred" "Smith" "<fred.p.smith1972 at gmail.com>"
    void $ insert $ User "Johne" "Jones" "<john.jones at gmail.com>"
    void $ insert $ User "Paul" "Peters" "<paul.p.peters at gmail.com>"
    queryUserCount >>= \c -> liftIO $ putStrLn $ "queryUserCount => " ++ show c




More information about the web-devel mailing list