Add selectOne (#265)

* Add `selectSingle`

* Clean up and add to test execution :/

* Import library's `selectFirst` rather than re-export it from `persistent`

* Add haddock and update test name

* Add missing comments for haddock :)

* Rename to `selectOne` and add @since

* Bump version number

* Add missing refs for `table` function

* Update to experimental syntax

changelog.md

@@ -1,3 +1,9 @@
+3.5.1.0
+=======
+- @ibarrae
+  - [#265](https://github.com/bitemyapp/esqueleto/pull/265)
+        - Added `selectOne`
+
 3.5.0.0
 =======
 - @belevy

esqueleto.cabal

@@ -1,7 +1,7 @@
 cabal-version: 1.12
 
 name:           esqueleto
-version:        3.5.0.0
+version:        3.5.1.0
 synopsis:       Type-safe EDSL for SQL queries on persistent backends.
 description:    @esqueleto@ is a bare bones, type-safe EDSL for SQL queries that works with unmodified @persistent@ SQL backends.  Its language closely resembles SQL, so you don't have to learn new concepts, just new syntax, and it's fairly easy to predict the generated SQL and optimize it for your backend. Most kinds of errors committed when writing SQL are caught as compile-time errors---although it is possible to write type-checked @esqueleto@ queries that fail at runtime.
                 .
@@ -102,7 +102,7 @@ test-suite specs
       , attoparsec
       , blaze-html
       , bytestring
-      , conduit 
+      , conduit
       , containers
       , esqueleto
       , exceptions
@@ -118,11 +118,11 @@ test-suite specs
       , persistent-sqlite
       , postgresql-simple
       , QuickCheck
-      , resourcet 
-      , tagged 
-      , text 
+      , resourcet
+      , tagged
+      , text
       , time
-      , transformers 
+      , transformers
       , unliftio
-      , unordered-containers 
+      , unordered-containers
     default-language: Haskell2010

src/Database/Esqueleto.hs

@@ -97,6 +97,7 @@ module Database.Esqueleto {-# WARNING "This module will switch over to the Exper
   , SqlExpr
   , SqlEntity
   , select
+  , selectOne
   , selectSource
   , delete
   , deleteCount

src/Database/Esqueleto/Experimental.hs

@@ -190,6 +190,7 @@ module Database.Esqueleto.Experimental
     , SqlExpr
     , SqlEntity
     , select
+    , selectOne
     , selectSource
     , delete
     , deleteCount

src/Database/Esqueleto/Internal/Internal.hs

@@ -2539,6 +2539,35 @@ select query = do
     conn <- R.ask
     liftIO $ with res $ flip R.runReaderT conn . runSource
 
+-- | Execute an @esqueleto@ @SELECT@ query inside @persistent@'s
+-- 'SqlPersistT' monad and return the first entry wrapped in a @Maybe@.
+-- @since 3.5.1.0
+--
+-- === __Example usage__
+--
+-- @
+-- firstPerson :: MonadIO m => SqlPersistT m (Maybe (Entity Person))
+-- firstPerson =
+--  'selectOne' $ do
+--      person <- 'from' $ 'table' @Person
+--      return person
+-- @
+--
+-- The above query is equivalent to a 'select' combined with 'limit' but you
+-- would still have to transform the results from a list:
+--
+-- @
+-- firstPerson :: MonadIO m => SqlPersistT m [Entity Person]
+-- firstPerson =
+--  'select' $ do
+--      person <- 'from' $ 'table' @Person
+--      'limit' 1
+--      return person
+-- @
+
+selectOne :: (SqlSelect a r, MonadIO m) => SqlQuery a -> SqlReadT m (Maybe r)
+selectOne query = fmap Maybe.listToMaybe $ select $ limit 1 >> query
+
 -- | (Internal) Run a 'C.Source' of rows.
 runSource
     :: Monad m

src/Database/Esqueleto/Legacy.hs

@@ -98,6 +98,7 @@ module Database.Esqueleto.Legacy
   , SqlExpr
   , SqlEntity
   , select
+  , selectOne
   , selectSource
   , delete
   , deleteCount

test/Common/Test.hs

@@ -297,6 +297,27 @@ testSubSelect = do
                 Right xs ->
                     xs `shouldBe` []
 
+testSelectOne :: SpecDb
+testSelectOne =
+    describe "selectOne" $ do
+        let personQuery =
+                selectOne $ do
+                    person <- Experimental.from $ Experimental.table @Person
+                    where_ $ person ^. PersonFavNum >=. val 1
+                    orderBy [asc (person ^. PersonId)]
+                    return $ person ^. PersonId
+        itDb "returns Just" $ do
+            person <- insert' p1
+            _ <- insert' p2
+            res <- personQuery
+            asserting $
+                res `shouldBe` Just (Value $ entityKey person)
+
+        itDb "returns Nothing" $ do
+            res <- personQuery
+            asserting $
+                res `shouldBe` (Nothing :: Maybe (Value PersonId))
+
 testSelectSource :: SpecDb
 testSelectSource = do
     describe "selectSource" $ do
@@ -2271,10 +2292,11 @@ listsEqualOn :: (HasCallStack, Show a1, Eq a1) => [a2] -> [a2] -> (a2 -> a1) ->
 listsEqualOn a b f = map f a `shouldBe` map f b
 
 tests :: SpecDb
-tests = do
+tests =
     describe "Esqueleto" $ do
         testSelect
         testSubSelect
+        testSelectOne
         testSelectSource
         testSelectFrom
         testSelectJoin
@@ -2389,4 +2411,3 @@ shouldBeOnClauseWithoutMatchingJoinException ea =
             pure ()
         _ ->
             expectationFailure $ "Expected OnClauseWithMatchingJoinException, got: " <> show ea
-