persistent 2.0.1.1 → 2.0.2
raw patch · 5 files changed
+37/−22 lines, 5 filesdep ~base
Dependency ranges changed: base
Files
- Database/Persist/Class/PersistStore.hs +4/−3
- Database/Persist/Quasi.hs +11/−11
- Database/Persist/Sql/Class.hs +8/−0
- Database/Persist/Sql/Orphan/PersistStore.hs +12/−6
- persistent.cabal +2/−2
Database/Persist/Class/PersistStore.hs view
@@ -49,9 +49,6 @@ ) => PersistStore backend where data BackendKey backend - backendKeyToValues :: BackendKey backend -> [PersistValue]- backendKeyFromValues :: [PersistValue] -> Either T.Text (BackendKey backend)- -- | Get a record by identifier, if available. get :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity val) => Key val -> ReaderT backend m (Maybe val)@@ -67,6 +64,9 @@ insert_ val = insert val >> return () -- | Create multiple records in the database.+ --+ -- If you don't need the inserted @Key@s, use 'insertMany_'+ -- -- SQL backends currently use the slow default implementation of -- @mapM insert@ insertMany :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity val)@@ -74,6 +74,7 @@ insertMany = mapM insert -- | Same as 'insertMany', but doesn't return any @Key@s.+ -- -- SQL backends currently use an efficient implementation for this -- unlike 'insertMany'. insertMany_ :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity val)
Database/Persist/Quasi.hs view
@@ -23,7 +23,7 @@ import qualified Data.Text as T import Control.Arrow ((&&&)) import qualified Data.Map as M-import Data.List (foldl',find)+import Data.List (foldl') import Data.Monoid (mappend) data ParseState a = PSDone | PSFail | PSSuccess a Text@@ -219,7 +219,7 @@ Just pdef -> if length foreignFieldTexts /= length (primaryFields pdef) then lengthError pdef- else let fds_ffs = zipWith (toForeignFields ent pent)+ else let fds_ffs = zipWith (toForeignFields pent) foreignFieldTexts (primaryFields pdef) in fdef { foreignFields = map snd fds_ffs@@ -241,7 +241,7 @@ ++ show (map (unHaskellName . fieldHaskell) (fd:fds)) isNull = (NotNullable /=) . nullable . fieldAttrs - toForeignFields ent pent fieldText pfd =+ toForeignFields pent fieldText pfd = case chktypes fd haskellField (entityFields pent) pfh of Just err -> error err Nothing -> (fd, ((haskellField, fieldDB fd), (pfh, pfdb)))@@ -252,7 +252,7 @@ (pfh, pfdb) = (fieldHaskell pfd, fieldDB pfd) chktypes :: FieldDef -> HaskellName -> [FieldDef] -> HaskellName -> Maybe String- chktypes ffld fkey pflds pkey =+ chktypes ffld _fkey pflds pkey = if fieldType ffld == fieldType pfld then Nothing else Just $ "fieldType mismatch: " ++ show (fieldType ffld) ++ ", " ++ show (fieldType pfld) where@@ -261,15 +261,15 @@ entName = entityHaskell ent getFd [] t = error $ "foreign key constraint for: " ++ show (unHaskellName entName) ++ " unknown column: " ++ show t- getFd (fd:fds) t- | fieldHaskell fd == t = fd- | otherwise = getFd fds t+ getFd (f:fs) t+ | fieldHaskell f == t = f+ | otherwise = getFd fs t lengthError pdef = error $ "found " ++ show (length foreignFieldTexts) ++ " fkeys and " ++ show (length (primaryFields pdef)) ++ " pkeys: fdef=" ++ show fdef ++ " pdef=" ++ show pdef data UnboundEntityDef = UnboundEntityDef- { unboundForeignDefs :: [UnboundForeignDef]+ { _unboundForeignDefs :: [UnboundForeignDef] , unboundEntityDef :: EntityDef } @@ -398,8 +398,8 @@ takeUniq _ tableName _ xs = error $ "invalid unique constraint on table[" ++ show tableName ++ "] expecting an uppercase constraint name xs=" ++ show xs data UnboundForeignDef = UnboundForeignDef- { unboundFields :: [Text] -- ^ fields in other entity- , unboundForeignDef :: ForeignDef+ { _unboundFields :: [Text] -- ^ fields in other entity+ , _unboundForeignDef :: ForeignDef } takeForeign :: PersistSettings@@ -407,7 +407,7 @@ -> [FieldDef] -> [Text] -> UnboundForeignDef-takeForeign ps tableName defs (refTableName:n:rest)+takeForeign ps tableName _defs (refTableName:n:rest) | not (T.null n) && isLower (T.head n) = UnboundForeignDef fields $ ForeignDef (HaskellName refTableName)
Database/Persist/Sql/Class.hs view
@@ -10,6 +10,7 @@ module Database.Persist.Sql.Class ( RawSql (..) , PersistFieldSql (..)+ , IsSqlKey (..) ) where import Control.Applicative ((<$>), (<*>))@@ -268,3 +269,10 @@ -- An embedded Entity instance (PersistField record, PersistEntity record) => PersistFieldSql (Entity record) where sqlType _ = SqlString++-- | A class for all numeric SQL keys, for easy conversion to/from Int64 values.+--+-- Since 2.0.2+class IsSqlKey a where+ toSqlKey :: Int64 -> a+ fromSqlKey :: a -> Int64
Database/Persist/Sql/Orphan/PersistStore.hs view
@@ -1,12 +1,14 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Database.Persist.Sql.Orphan.PersistStore (withRawQuery, BackendKey(..)) where import Database.Persist import Database.Persist.Sql.Types import Database.Persist.Sql.Raw+import Database.Persist.Sql.Class (IsSqlKey (..)) import qualified Data.Conduit as C import qualified Data.Conduit.List as CL import qualified Data.Text as T@@ -32,15 +34,14 @@ srcRes <- rawQueryRes sql vals liftIO $ with srcRes (C.$$ sink) +instance IsSqlKey (BackendKey SqlBackend) where+ toSqlKey = SqlBackendKey+ fromSqlKey = unSqlBackendKey+ instance PersistStore Connection where newtype BackendKey SqlBackend = SqlBackendKey { unSqlBackendKey :: Int64 } deriving (Show, Read, Eq, Ord, Num, Integral, PersistField, PersistFieldSql, PathPiece, Real, Enum, Bounded, A.ToJSON, A.FromJSON) - backendKeyToValues (SqlBackendKey i) = [PersistInt64 i]- backendKeyFromValues [PersistInt64 i] = Right $ SqlBackendKey i- backendKeyFromValues [PersistDouble i] = Right $ SqlBackendKey $ truncate i- backendKeyFromValues s = Left $ pack $ show s- update _ [] = return () update k upds = do conn <- ask@@ -114,6 +115,7 @@ t = entityDef $ Just val vals = map toPersistValue $ toPersistFields val + insertMany_ [] = return () insertMany_ vals = do conn <- ask let sql = T.concat@@ -125,7 +127,11 @@ , T.intercalate "),(" $ replicate (length valss) $ T.intercalate "," $ map (const "?") (entityFields t) , ")" ]- rawExecute sql (concat valss)++ -- SQLite support is only in later versions+ if connRDBMS conn == "sqlite"+ then mapM_ insert vals+ else rawExecute sql (concat valss) where t = entityDef vals valss = map (map toPersistValue . toPersistFields) vals
persistent.cabal view
@@ -1,9 +1,9 @@ name: persistent-version: 2.0.1.1+version: 2.0.2 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>-maintainer: Michael Snoyman <michael@snoyman.com>+maintainer: Michael Snoyman <michael@snoyman.com>, Greg Weber <greg@gregweber.info> synopsis: Type-safe, multi-backend data serialization. description: Type-safe, data serialization. You must use a specific backend in order to make this useful. category: Database, Yesod