persistent 2.1.1.6 → 2.1.1.7
raw patch · 3 files changed
+78/−43 lines, 3 filesdep ~base
Dependency ranges changed: base
Files
- Database/Persist/Sql/Orphan/PersistQuery.hs +7/−40
- Database/Persist/Sql/Util.hs +67/−0
- persistent.cabal +4/−3
Database/Persist/Sql/Orphan/PersistQuery.hs view
@@ -9,6 +9,8 @@ ) where import Database.Persist hiding (updateField)+import Database.Persist.Sql.Util (+ entityColumnNames, parseEntityValues, isIdField) import Database.Persist.Sql.Types import Database.Persist.Sql.Raw import Database.Persist.Sql.Orphan.PersistStore (withRawQuery)@@ -55,43 +57,12 @@ srcRes <- rawQueryRes (sql conn) (getFiltsValues conn filts) return $ fmap ($= CL.mapM parse) srcRes where- composite = isJust $ entityPrimary t (limit, offset, orders) = limitOffsetOrder opts - parse vals =- case entityPrimary t of- Just pdef -> - let pks = map fieldHaskell $ compositeFields pdef- keyvals = map snd $ filter (\(a, _) -> let ret=isJust (find (== a) pks) in ret) $ zip (map fieldHaskell $ entityFields t) vals- in case fromPersistValuesComposite' keyvals vals of- Left s -> liftIO $ throwIO $ PersistMarshalError s- Right row -> return row- Nothing -> - case fromPersistValues' vals of- Left s -> liftIO $ throwIO $ PersistMarshalError s- Right row -> return row-+ parse vals = case parseEntityValues t vals of+ Left s -> liftIO $ throwIO $ PersistMarshalError s+ Right row -> return row t = entityDef $ dummyFromFilts filts-- fromPersistValues' (kpv:xs) = -- oracle returns Double - case fromPersistValues xs of- Left e -> Left e- Right xs' ->- case keyFromValues [kpv] of- Left _ -> error $ "fromPersistValues': keyFromValues failed on " ++ show kpv- Right k -> Right (Entity k xs')--- fromPersistValues' xs = Left $ T.pack ("error in fromPersistValues' xs=" ++ show xs)-- fromPersistValuesComposite' keyvals xs =- case fromPersistValues xs of- Left e -> Left e- Right xs' -> case keyFromValues keyvals of- Left _ -> error "fromPersistValuesComposite': keyFromValues failed"- Right key -> Right (Entity key xs')-- wher conn = if null filts then "" else filterClause False conn filts@@ -99,9 +70,7 @@ case map (orderClause False conn) orders of [] -> "" ords -> " ORDER BY " <> T.intercalate "," ords- cols conn = T.intercalate ","- $ (if composite then [] else [connEscapeName conn $ fieldDB (entityId t)])- <> map (connEscapeName conn . fieldDB) (entityFields t)+ cols = T.intercalate ", " . entityColumnNames t sql conn = connLimitOffset conn (limit,offset) (not (null orders)) $ mconcat [ "SELECT " , cols conn@@ -121,6 +90,7 @@ Just pdef -> T.intercalate "," $ map (connEscapeName conn . fieldDB) $ compositeFields pdef Nothing -> connEscapeName conn $ fieldDB (entityId t) + wher conn = if null filts then "" else filterClause False conn filts@@ -223,9 +193,6 @@ fieldName :: forall record typ. (PersistEntity record, PersistEntityBackend record ~ SqlBackend) => EntityField record typ -> DBName fieldName f = fieldDB $ persistFieldDef f--isIdField :: forall record typ. (PersistEntity record) => EntityField record typ -> Bool-isIdField f = fieldHaskell (persistFieldDef f) == HaskellName "Id" dummyFromFilts :: [Filter v] -> Maybe v dummyFromFilts _ = Nothing
+ Database/Persist/Sql/Util.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE OverloadedStrings #-}+module Database.Persist.Sql.Util (+ parseEntityValues+ , entityColumnNames+ , entityColumnCount+ , isIdField+ , hasCompositeKey+) where++import Data.Maybe (isJust)+import Data.Monoid ((<>))+import Data.Text (Text, pack)+import Database.Persist (+ Entity(Entity), EntityDef, EntityField, HaskellName(HaskellName)+ , PersistEntity, PersistValue, PersistException(PersistMarshalError)+ , keyFromValues, fromPersistValues, fieldDB, entityId, entityPrimary+ , entityFields, fieldHaskell, compositeFields, persistFieldDef)+import Database.Persist.Sql.Types (Sql, SqlBackend, connEscapeName)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Control.Exception (throwIO)++entityColumnNames :: EntityDef -> SqlBackend -> [Sql]+entityColumnNames ent conn =+ (if hasCompositeKey ent+ then [] else [connEscapeName conn $ fieldDB (entityId ent)])+ <> map (connEscapeName conn . fieldDB) (entityFields ent)++entityColumnCount :: EntityDef -> Int+entityColumnCount e = length (entityFields e)+ + if hasCompositeKey e then 0 else 1++hasCompositeKey :: EntityDef -> Bool+hasCompositeKey = isJust . entityPrimary++parseEntityValues :: PersistEntity record+ => EntityDef -> [PersistValue] -> Either Text (Entity record)+parseEntityValues t vals = + case entityPrimary t of+ Just pdef -> + let pks = map fieldHaskell $ compositeFields pdef+ keyvals = map snd . filter ((`elem` pks) . fst)+ $ zip (map fieldHaskell $ entityFields t) vals+ in fromPersistValuesComposite' keyvals vals+ Nothing -> fromPersistValues' vals+ where+ fromPersistValues' (kpv:xs) = -- oracle returns Double + case fromPersistValues xs of+ Left e -> Left e+ Right xs' ->+ case keyFromValues [kpv] of+ Left _ -> error $ "fromPersistValues': keyFromValues failed on " ++ show kpv+ Right k -> Right (Entity k xs')+++ fromPersistValues' xs = Left $ pack ("error in fromPersistValues' xs=" ++ show xs)++ fromPersistValuesComposite' keyvals xs =+ case fromPersistValues xs of+ Left e -> Left e+ Right xs' -> case keyFromValues keyvals of+ Left _ -> error "fromPersistValuesComposite': keyFromValues failed"+ Right key -> Right (Entity key xs')+++isIdField :: PersistEntity record => EntityField record typ -> Bool+isIdField f = fieldHaskell (persistFieldDef f) == HaskellName "Id"+
persistent.cabal view
@@ -1,5 +1,5 @@ name: persistent-version: 2.1.1.6+version: 2.1.1.7 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -22,7 +22,7 @@ if flag(nooverlap) cpp-options: -DNO_OVERLAP - build-depends: base >= 4 && < 5+ build-depends: base >= 4.6 && < 5 , bytestring >= 0.9 , transformers >= 0.2.1 , time >= 1.1.4@@ -59,6 +59,7 @@ Database.Persist.Types Database.Persist.Class Database.Persist.Sql+ Database.Persist.Sql.Util other-modules: Database.Persist.Types.Base Database.Persist.Class.DeleteCascade@@ -85,7 +86,7 @@ type: exitcode-stdio-1.0 main-is: test/main.hs - build-depends: base >= 4 && < 5+ build-depends: base >= 4.6 && < 5 , hspec >= 1.3 , containers , text