
Hi, everyone! I am happy to announce a new persistence library, Groundhog. http://hackage.haskell.org/package/groundhog http://hackage.haskell.org/package/groundhog-sqlite Groundhog does mapping between datatypes and database like Persistent in Haskell or Hibernate in Java and makes dealing with database very easy. The API is inspired by Persistent, a great framework by Michael Snoyman, from which I used some ideas and code. At first I wanted to enhance Persistent, but many useful ideas don't fit into its design. Groundhog offers features I wanted to see in a modern Haskell database library. My intent was to create a package which you can plug into your existing project and it would just work. So it does not require defining datatypes using its own mechanisms (quasiquotation, XML, etc). You can use your own types defined anywhere. The restrictions on type structure are very mild. Groundhog uses data families and GADTs and they did not play nicely together until GHC 7, so GHC 6.12.x and earlier is not supported. Currently there is support only for Sqlite but I hope to add more backends soon. Sqlite backend is based on direct-sqlite package by Dan Knapp. I modified it to improve performance and provide better error messages. Now it is bundled with groundhog-sqlite but I hope to merge it with direct-sqlite. On simple datatypes performance is ~2.5 times higher compared to Persistent. Some of this gain is achieved because of Sqlite specific optimisations, but I expect to see high performance on other backends as well. In fact, it could be even faster. I sacrificed ~30% of backend-independent performance for flexibility when I chose DbPersist to be a monad transformer instead of sticking with IO and replaced direct mentions of DbPersist with Monad m in PersistBackend. Features: * Persists datatypes defined in an ordinary way * Supports fields of user-defined types * Supports polymorphic datatypes and datatypes with several constructors * Basic support for lists and tuples * Type safety * Migration from an empty schema * Powerful expression DSL for use in queries * Execution of arbitrary queries * High performance Plans (in priority order): * Add more backends, particularly PostgreSQL * Allow migration when data definition changes * Add Persistent-like quasiquotation syntax Here is an example from the documentation: {-# LANGUAGE GADTs, TypeFamilies, TemplateHaskell #-} import Control.Monad.IO.Class(liftIO) import Database.Groundhog.TH import Database.Groundhog.Sqlite data Customer a = Customer {customerName :: String, details :: a} deriving Show data Item = ProductItem {productName :: String, quantity :: Int, customer :: Customer String} | ServiceItem {serviceName :: String, deliveryAddress :: String, servicePrice :: Int} deriving Show deriveEntity ''Customer $ Just $ do setConstructor 'Customer $ do setConstraints [("NameConstraint", ["customerName"])] deriveEntity ''Item Nothing main = withSqliteConn ":memory:" $ runSqliteConn $ do -- Customer is also migrated because Item contains it runMigration silentMigrationLogger $ migrate (undefined :: Item) let john = Customer "John Doe" "Phone: 01234567" johnKey <- insert john -- John is inserted only once because of the name constraint insert $ ProductItem "Apples" 5 john insert $ ProductItem "Melon" 2 john insert $ ServiceItem "Taxi" "Elm Street" 50 insert $ ProductItem "Melon" 6 (Customer "Jack Smith" "Don't let him pay by check") -- bonus melon for all large melon orders update [QuantityField =. toArith QuantityField + 1] (ProductNameField ==. "Melon" &&. QuantityField >. (5 :: Int)) productsForJohn <- select (CustomerField ==. johnKey) [] 0 0 liftIO $ putStrLn $ "Products for John: " ++ show productsForJohn -- check bonus melon <- select (ProductNameField ==. "Melon") [Desc QuantityField] 0 0 liftIO $ putStrLn $ "Melon orders: " ++ show melon Currently Hackage cannot build it due to technical issues (as Dons assumed several packages it depends on are not exposed), but you can install it with cabal. It is still very early beta and it may have some bugs. I am very interested to hear your feedback. Thanks, Boris Lykah