persistent: Maybe instance for RawSql.

persistent-test/PersistentTest.hs

@@ -619,6 +619,10 @@ specs = describe "persistent" $ do
       ret <- rawSql "SELECT ?-?" [PersistInt64 5, PersistInt64 3]
       liftIO $ ret @?= [Single (2::Int)]
 
+  it "rawSql/NULL" $ db $ do
+      ret <- rawSql "SELECT NULL" []
+      liftIO $ ret @?= [Nothing :: Maybe (Single Int)]
+
   it "rawSql/entity" $ db $ do
       let insert' :: (PersistStore backend m, PersistEntity val) => val -> backend m (Key backend val, val)
           insert' v = insert v >>= \k -> return (k, v)
@@ -643,6 +647,14 @@ specs = describe "persistent" $ do
       liftIO $ ret @?= [ (Entity p1k p1, Entity a1k a1)
                        , (Entity p1k p1, Entity a2k a2)
                        , (Entity p2k p2, Entity a3k a3) ]
+      ret2 <- rawSql query [PersistInt64 20]
+      liftIO $ ret2 @?= [ (Just (Entity p1k p1), Just (Entity a1k a1))
+                        , (Just (Entity p1k p1), Just (Entity a2k a2))
+                        , (Just (Entity p2k p2), Just (Entity a3k a3)) ]
+      ret3 <- rawSql query [PersistInt64 20]
+      liftIO $ ret3 @?= [ Just (Entity p1k p1, Entity a1k a1)
+                        , Just (Entity p1k p1, Entity a2k a2)
+                        , Just (Entity p2k p2, Entity a3k a3) ]
 
   it "rawSql/order-proof" $ db $ do
       let p1 = Person "Zacarias" 93 Nothing
@@ -656,6 +668,27 @@ specs = describe "persistent" $ do
       liftIO $ ret1 @?= [Entity p1k p1]
       liftIO $ ret2 @?= [Entity (Key $ unKey p1k) (RFO p1)]
 
+  it "rawSql/OUTER JOIN" $ db $ do
+      let insert' :: (PersistStore backend m, PersistEntity val) => val -> backend m (Key backend val, val)
+          insert' v = insert v >>= \k -> return (k, v)
+      (p1k, p1) <- insert' $ Person "Mathias"   23 Nothing
+      (p2k, p2) <- insert' $ Person "Norbert"   44 Nothing
+      (a1k, a1) <- insert' $ Pet p1k "Rodolfo" Cat
+      (a2k, a2) <- insert' $ Pet p1k "Zeno"    Cat
+      escape <- ((. DBName) . escapeName) `fmap` SqlPersist ask
+      let query = T.concat [ "SELECT ??, ?? "
+                           , "FROM ", person
+                           , "LEFT OUTER JOIN ", pet
+                           , " ON ", person, ".", escape "id"
+                           , " = ", pet, ".", escape "ownerId"
+                           , " ORDER BY ", person, ".", escape "name"]
+          person = escape "Person"
+          pet    = escape "Pet"
+      ret <- rawSql query []
+      liftIO $ ret @?= [ (Entity p1k p1, Just (Entity a1k a1))
+                       , (Entity p1k p1, Just (Entity a2k a2))
+                       , (Entity p2k p2, Nothing) ]
+
   it "commit/rollback" (caseCommitRollback >> runConn cleanDB)
 
   it "afterException" caseAfterException

persistent/Database/Persist/GenericSql.hs

@@ -58,6 +58,7 @@ import Data.Text (Text, pack, unpack, concat)
 import qualified Data.Text as T
 import Web.PathPieces (PathPiece (..))
 import qualified Data.Text.Read
+import Data.Maybe (fromMaybe)
 import Data.Monoid (Monoid, mappend)
 import Database.Persist.EntityDef
 import qualified Data.Conduit as C
@@ -553,6 +554,27 @@ instance PersistEntity a => RawSql (Entity a) where
                                           <*> fromPersistValues ent
     rawSqlProcessRow _ = Left "RawSql (Entity a): wrong number of columns."
 
+-- | Since 1.0.1.
+instance RawSql a => RawSql (Maybe a) where
+    rawSqlCols e = rawSqlCols e . extractMaybe
+    rawSqlColCountReason = rawSqlColCountReason . extractMaybe
+    rawSqlProcessRow cols
+      | all isNull cols = return Nothing
+      | otherwise       =
+        case rawSqlProcessRow cols of
+          Right v  -> Right (Just v)
+          Left msg -> Left $ "RawSql (Maybe a): not all columns were Null " ++
+                             "but the inner parser has failed.  Its message " ++
+                             "was \"" ++ msg ++ "\".  Did you apply Maybe " ++
+                             "to a tuple, perhaps?  The main use case for " ++
+                             "Maybe is to allow OUTER JOINs to be written, " ++
+                             "in which case 'Maybe (Entity v)' is used."
+      where isNull PersistNull = True
+            isNull _           = False
+
+extractMaybe :: Maybe a -> a
+extractMaybe = fromMaybe (error "Database.Persist.GenericSql.extractMaybe")
+
 instance (RawSql a, RawSql b) => RawSql (a, b) where
     rawSqlCols e x = rawSqlCols e (fst x) # rawSqlCols e (snd x)
         where (cnta, lsta) # (cntb, lstb) = (cnta + cntb, lsta P.++ lstb)