persistent 2.2.2 → 2.2.2.1

raw patch · 6 files changed

+90/−6 lines, 6 files

Files

• ChangeLog.md +0/−4
• Database/Persist/Class/PersistField.hs +12/−0
• Database/Persist/Sql/Class.hs +0/−1
• Database/Persist/Sql/Raw.hs +74/−0
• Database/Persist/Sql/Run.hs +3/−0
• persistent.cabal +1/−1

@@ -1,7 +1,3 @@-## 2.2.2--* support http-api-data for url serialization- ## 2.2.1  * Migration failure message with context

@@ -107,24 +107,36 @@     toPersistValue = PersistInt64 . fromIntegral     fromPersistValue (PersistInt64 i)  = Right $ fromIntegral i     fromPersistValue (PersistDouble i) = Right (truncate i :: Int8) -- oracle+    fromPersistValue (PersistByteString bs) = case readInt bs of  -- oracle+                                               Just (i,"") -> Right $ fromIntegral i+                                               xs -> error $ "PersistField Int8 failed parsing PersistByteString xs["++show xs++"] i["++show bs++"]"     fromPersistValue x = Left $ T.pack $ "int8 Expected Integer, received: " ++ show x  instance PersistField Int16 where     toPersistValue = PersistInt64 . fromIntegral     fromPersistValue (PersistInt64 i)  = Right $ fromIntegral i     fromPersistValue (PersistDouble i) = Right (truncate i :: Int16) -- oracle+    fromPersistValue (PersistByteString bs) = case readInt bs of  -- oracle+                                               Just (i,"") -> Right $ fromIntegral i+                                               xs -> error $ "PersistField Int16 failed parsing PersistByteString xs["++show xs++"] i["++show bs++"]"     fromPersistValue x = Left $ T.pack $ "int16 Expected Integer, received: " ++ show x  instance PersistField Int32 where     toPersistValue = PersistInt64 . fromIntegral     fromPersistValue (PersistInt64 i)  = Right $ fromIntegral i     fromPersistValue (PersistDouble i) = Right (truncate i :: Int32) -- oracle+    fromPersistValue (PersistByteString bs) = case readInt bs of  -- oracle+                                               Just (i,"") -> Right $ fromIntegral i+                                               xs -> error $ "PersistField Int32 failed parsing PersistByteString xs["++show xs++"] i["++show bs++"]"     fromPersistValue x = Left $ T.pack $ "int32 Expected Integer, received: " ++ show x  instance PersistField Int64 where     toPersistValue = PersistInt64 . fromIntegral     fromPersistValue (PersistInt64 i)  = Right $ fromIntegral i     fromPersistValue (PersistDouble i) = Right (truncate i :: Int64) -- oracle+    fromPersistValue (PersistByteString bs) = case readInt bs of  -- oracle+                                               Just (i,"") -> Right $ fromIntegral i+                                               xs -> error $ "PersistField Int64 failed parsing PersistByteString xs["++show xs++"] i["++show bs++"]"     fromPersistValue x = Left $ T.pack $ "int64 Expected Integer, received: " ++ show x  instance PersistField Word where

@@ -17,7 +17,6 @@ import Database.Persist import Data.Monoid ((<>)) import Database.Persist.Sql.Types-import Control.Arrow ((&&&)) import Data.Text (Text, intercalate, pack) import Data.Maybe (fromMaybe) import Data.Fixed

@@ -126,6 +126,80 @@ -- However, most common problems are mitigated by using the -- entity selection placeholder @??@, and you shouldn't see any -- error at all if you're not using 'Single'.+--+-- Some example of 'rawSql' based on this schema:+--+-- @+-- share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|+-- Person+--     name String+--     age Int Maybe+--     deriving Show+-- BlogPost+--     title String+--     authorId PersonId+--     deriving Show+-- |]+-- @+-- +-- Examples based on the above schema:+-- +-- @ +-- getPerson :: MonadIO m => ReaderT SqlBackend m [Entity Person]+-- getPerson = rawSql "select ?? from person where name=?" [PersistText "john"]+-- +-- getAge :: MonadIO m => ReaderT SqlBackend m [Single Int]+-- getAge = rawSql "select person.age from person where name=?" [PersistText "john"]+-- +-- getAgeName :: MonadIO m => ReaderT SqlBackend m [(Single Int, Single Text)]+-- getAgeName = rawSql "select person.age, person.name from person where name=?" [PersistText "john"]+-- +-- getPersonBlog :: MonadIO m => ReaderT SqlBackend m [(Entity Person, Entity BlogPost)]+-- getPersonBlog = rawSql "select ??,?? from person,blog_post where person.id = blog_post.author_id" []+-- @+--+-- Minimal working program for PostgreSQL backend based on the above concepts:+--+-- > {-# LANGUAGE EmptyDataDecls             #-}+-- > {-# LANGUAGE FlexibleContexts           #-}+-- > {-# LANGUAGE GADTs                      #-}+-- > {-# LANGUAGE GeneralizedNewtypeDeriving #-}+-- > {-# LANGUAGE MultiParamTypeClasses      #-}+-- > {-# LANGUAGE OverloadedStrings          #-}+-- > {-# LANGUAGE QuasiQuotes                #-}+-- > {-# LANGUAGE TemplateHaskell            #-}+-- > {-# LANGUAGE TypeFamilies               #-}+-- > +-- > import           Control.Monad.IO.Class  (liftIO)+-- > import           Control.Monad.Logger    (runStderrLoggingT)+-- > import           Database.Persist+-- > import           Control.Monad.Reader+-- > import           Data.Text+-- > import           Database.Persist.Sql+-- > import           Database.Persist.Postgresql+-- > import           Database.Persist.TH+-- > +-- > share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|+-- > Person+-- >     name String+-- >     age Int Maybe+-- >     deriving Show+-- > |]+-- > +-- > conn = "host=localhost dbname=new_db user=postgres password=postgres port=5432"+-- > +-- > getPerson :: MonadIO m => ReaderT SqlBackend m [Entity Person]+-- > getPerson = rawSql "select ?? from person where name=?" [PersistText "sibi"]+-- > +-- > liftSqlPersistMPool y x = liftIO (runSqlPersistMPool y x)+-- > +-- > main :: IO ()+-- > main = runStderrLoggingT $ withPostgresqlPool conn 10 $ liftSqlPersistMPool $ do+-- >          runMigration migrateAll+-- >          xs <- getPerson+-- >          liftIO (print xs)+-- > + rawSql :: (RawSql a, MonadIO m)        => Text             -- ^ SQL statement, possibly with placeholders.        -> [PersistValue]   -- ^ Values to fill the placeholders.

@@ -65,6 +65,9 @@ runSqlPersistMPool :: SqlPersistM a -> Pool SqlBackend -> IO a runSqlPersistMPool x pool = runResourceT $ runNoLoggingT $ runSqlPool x pool +liftSqlPersistMPool :: MonadIO m => SqlPersistM a -> Pool SqlBackend -> m a+liftSqlPersistMPool x pool = liftIO (runSqlPersistMPool x pool)+ withSqlPool :: (MonadIO m, MonadLogger m, MonadBaseControl IO m)             => (LogFunc -> IO SqlBackend) -- ^ create a new connection             -> Int -- ^ connection count

@@ -1,5 +1,5 @@ name:            persistent-version:         2.2.2+version:         2.2.2.1 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>