From d8b53d55288cb18cafddec8ea5c7224e32593067 Mon Sep 17 00:00:00 2001
From: "(cdep)illabout" <cdep.illabout@gmail.com>
Date: Tue, 11 Oct 2016 15:20:04 +0900
Subject: [PATCH] Add getEntity helper method.

This method is similar to `insertEntity`.

Closes #616.
---
 persistent-test/src/PersistentTest.hs             |  6 ++++++
 persistent/Database/Persist/Class.hs              |  1 +
 persistent/Database/Persist/Class/PersistStore.hs | 11 +++++++++++
 3 files changed, 18 insertions(+)

diff --git a/persistent-test/src/PersistentTest.hs b/persistent-test/src/PersistentTest.hs
index 9b1d3cc0e..2849cfbbd 100644
--- a/persistent-test/src/PersistentTest.hs
+++ b/persistent-test/src/PersistentTest.hs
@@ -688,6 +688,12 @@ specs = describe "persistent" $ do
       Just p2 <- get k
       p2 @== p
 
+  it "getEntity" $ db $ do
+      Entity k p <- insertEntity $ Person "name" 1 Nothing
+      Just (Entity k2 p2) <- getEntity k
+      p @== p2
+      k @== k2
+
   it "repsert" $ db $ do
       k <- liftIO (PersonKey `fmap` generateKey)
       Nothing <- selectFirst [PersonName ==. "Repsert"] []
diff --git a/persistent/Database/Persist/Class.hs b/persistent/Database/Persist/Class.hs
index 9d685f5d6..55550a375 100644
--- a/persistent/Database/Persist/Class.hs
+++ b/persistent/Database/Persist/Class.hs
@@ -11,6 +11,7 @@ module Database.Persist.Class
     , BaseBackend(..)
     , PersistRecordBackend
     , getJust
+    , getEntity
     , belongsTo
     , belongsToJust
     , insertEntity
diff --git a/persistent/Database/Persist/Class/PersistStore.hs b/persistent/Database/Persist/Class/PersistStore.hs
index acb01a00d..f2828a4d1 100644
--- a/persistent/Database/Persist/Class/PersistStore.hs
+++ b/persistent/Database/Persist/Class/PersistStore.hs
@@ -10,6 +10,7 @@ module Database.Persist.Class.PersistStore
     , PersistCore (..)
     , PersistStoreRead (..)
     , PersistStoreWrite (..)
+    , getEntity
     , getJust
     , belongsTo
     , belongsToJust
@@ -216,3 +217,13 @@ insertEntity ::
 insertEntity e = do
     eid <- insert e
     return $ Entity eid e
+
+-- | Like @get@, but returns the complete @Entity@.
+getEntity ::
+    ( PersistStoreWrite backend
+    , PersistRecordBackend e backend
+    , MonadIO m
+    ) => Key e -> ReaderT backend m (Maybe (Entity e))
+getEntity key = do
+    maybeModel <- get key
+    return $ fmap (key `Entity`) maybeModel