persistent 2.6 → 2.6.1
raw patch · 20 files changed
+198/−88 lines, 20 filesdep ~base
Dependency ranges changed: base
Files
- ChangeLog.md +7/−0
- Database/Persist.hs +3/−1
- Database/Persist/Class.hs +3/−1
- Database/Persist/Class/PersistConfig.hs +2/−2
- Database/Persist/Class/PersistEntity.hs +8/−4
- Database/Persist/Class/PersistField.hs +26/−9
- Database/Persist/Class/PersistStore.hs +43/−1
- Database/Persist/Class/PersistUnique.hs +3/−3
- Database/Persist/Quasi.hs +1/−1
- Database/Persist/Sql/Class.hs +21/−9
- Database/Persist/Sql/Internal.hs +2/−2
- Database/Persist/Sql/Migration.hs +19/−1
- Database/Persist/Sql/Orphan/PersistQuery.hs +4/−6
- Database/Persist/Sql/Orphan/PersistStore.hs +25/−15
- Database/Persist/Sql/Orphan/PersistUnique.hs +2/−3
- Database/Persist/Sql/Raw.hs +0/−1
- Database/Persist/Sql/Types.hs +2/−19
- Database/Persist/Sql/Types/Internal.hs +5/−0
- Database/Persist/Types/Base.hs +12/−6
- persistent.cabal +10/−4
ChangeLog.md view
@@ -1,3 +1,10 @@+## 2.6.1++* Fix edge case for `\<-. [Nothing]`+* Introduce `connMaxParams`+* Add 'getJustEntity' and 'insertRecord' convenience function+* Minor Haddock improvment+ ## 2.6 * Add `connUpsertSql` type for providing backend-specific upsert sql support.
Database/Persist.hs view
@@ -53,7 +53,9 @@ import Data.Text.Lazy (toStrict) import Data.Text.Lazy.Builder (toLazyText) import Data.Aeson (toJSON, ToJSON)-#if MIN_VERSION_aeson(0, 7, 0)+#if MIN_VERSION_aeson(1, 0, 0)+import Data.Aeson.Text (encodeToTextBuilder)+#elif MIN_VERSION_aeson(0, 7, 0) import Data.Aeson.Encode (encodeToTextBuilder) #else import Data.Aeson.Encode (fromValue)
Database/Persist/Class.hs view
@@ -8,12 +8,14 @@ , PersistStore , PersistStoreRead (..) , PersistStoreWrite (..)- , BaseBackend(..) , PersistRecordBackend , getJust+ , getJustEntity+ , getEntity , belongsTo , belongsToJust , insertEntity+ , insertRecord -- * PersistUnique , PersistUnique
Database/Persist/Class/PersistConfig.hs view
@@ -9,7 +9,7 @@ import Data.Aeson.Types (Parser) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Trans.Control (MonadBaseControl)-import Control.Applicative ((<$>))+import Control.Applicative as A ((<$>)) import qualified Data.HashMap.Strict as HashMap -- | Represents a value containing all the configuration options for a specific@@ -48,7 +48,7 @@ loadConfig (Object o) = case HashMap.lookup "left" o of- Just v -> Left <$> loadConfig v+ Just v -> Left A.<$> loadConfig v Nothing -> case HashMap.lookup "right" o of Just v -> Right <$> loadConfig v
Database/Persist/Class/PersistEntity.hs view
@@ -32,9 +32,13 @@ import Data.Aeson (ToJSON (..), FromJSON (..), fromJSON, object, (.:), (.=), Value (Object)) import qualified Data.Aeson.Parser as AP import Data.Aeson.Types (Parser,Result(Error,Success))+#if MIN_VERSION_aeson(1,0,0)+import Data.Aeson.Text (encodeToTextBuilder)+#else import Data.Aeson.Encode (encodeToTextBuilder)+#endif import Data.Attoparsec.ByteString (parseOnly)-import Control.Applicative ((<$>), (<*>))+import Control.Applicative as A ((<$>), (<*>)) import Data.Monoid (mappend) import qualified Data.HashMap.Strict as HM import Data.Typeable (Typeable)@@ -218,8 +222,8 @@ keyValueEntityFromJSON :: (PersistEntity record, FromJSON record, FromJSON (Key record)) => Value -> Parser (Entity record) keyValueEntityFromJSON (Object o) = Entity- <$> o .: "key"- <*> o .: "value"+ A.<$> o .: "key"+ A.<*> o .: "value" keyValueEntityFromJSON _ = fail "keyValueEntityFromJSON: not an object" -- | Predefined @toJSON@. The resulting JSON looks like@@ -256,7 +260,7 @@ _ -> error $ T.unpack $ errMsg "expected PersistMap" fromPersistValue (PersistMap alist) = case after of- [] -> Left $ errMsg $ "did not find " `mappend` idField `mappend` " field"+ [] -> Left $ errMsg $ "did not find " `Data.Monoid.mappend` idField `mappend` " field" ("_id", kv):afterRest -> fromPersistValue (PersistMap (before ++ afterRest)) >>= \record -> keyFromValues [kv] >>= \k ->
Database/Persist/Class/PersistField.hs view
@@ -3,9 +3,11 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE OverloadedStrings #-}-#ifndef NO_OVERLAP++#if !MIN_VERSION_base(4,8,0) {-# LANGUAGE OverlappingInstances #-} #endif+ module Database.Persist.Class.PersistField ( PersistField (..) , SomePersistField (..)@@ -14,12 +16,17 @@ import Control.Arrow (second) import Database.Persist.Types.Base-import Data.Time (Day(..), TimeOfDay, UTCTime, parseTime)+import Data.Time (Day(..), TimeOfDay, UTCTime,+#if MIN_VERSION_time(1,5,0)+ parseTimeM)+#else+ parseTime)+#endif #ifdef HIGH_PRECISION_DATE import Data.Time.Clock.POSIX (posixSecondsToUTCTime) #endif import Data.ByteString.Char8 (ByteString, unpack, readInt)-import Control.Applicative+import Control.Applicative as A import Data.Int (Int8, Int16, Int32, Int64) import Data.Word (Word, Word8, Word16, Word32, Word64) import Data.Text (Text)@@ -56,8 +63,6 @@ #if MIN_VERSION_base(4,8,0) import Numeric.Natural (Natural)-#else-import Control.Applicative ((<$>)) #endif -- | A value which can be marshalled to and from a 'PersistValue'.@@ -66,7 +71,11 @@ fromPersistValue :: PersistValue -> Either T.Text a #ifndef NO_OVERLAP-instance PersistField String where+#if MIN_VERSION_base(4,8,0)+instance {-# OVERLAPPING #-} PersistField [Char] where+#else+instance PersistField [Char] where+#endif toPersistValue = PersistText . T.pack fromPersistValue (PersistText s) = Right $ T.unpack s fromPersistValue (PersistByteString bs) =@@ -88,7 +97,7 @@ instance PersistField ByteString where toPersistValue = PersistByteString fromPersistValue (PersistByteString bs) = Right bs- fromPersistValue x = T.encodeUtf8 <$> fromPersistValue x+ fromPersistValue x = T.encodeUtf8 A.<$> fromPersistValue x instance PersistField T.Text where toPersistValue = PersistText@@ -144,7 +153,7 @@ 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+instance PersistField Data.Word.Word where toPersistValue = PersistInt64 . fromIntegral fromPersistValue (PersistInt64 i) = Right $ fromIntegral i fromPersistValue x = Left $ T.pack $ "Expected Word, received: " ++ show x@@ -249,9 +258,13 @@ _ -> case parse8601 $ T.unpack t of Nothing -> Left $ T.pack $ "Expected UTCTime, received " ++ show x- Just x -> Right x+ Just x' -> Right x' where+#if MIN_VERSION_time(1,5,0)+ parse8601 = parseTimeM True defaultTimeLocale "%FT%T%Q"+#else parse8601 = parseTime defaultTimeLocale "%FT%T%Q"+#endif fromPersistValue x@(PersistByteString s) = case reads $ unpack s of (d, _):_ -> Right d@@ -271,7 +284,11 @@ fromPersistValue PersistNull = Right Nothing fromPersistValue x = Just <$> fromPersistValue x +#if MIN_VERSION_base(4,8,0)+instance {-# OVERLAPPABLE #-} PersistField a => PersistField [a] where+#else instance PersistField a => PersistField [a] where+#endif toPersistValue = PersistList . fmap toPersistValue fromPersistValue (PersistList l) = fromPersistList l fromPersistValue (PersistText t) = fromPersistValue (PersistByteString $ TE.encodeUtf8 t)
Database/Persist/Class/PersistStore.hs view
@@ -10,10 +10,13 @@ , PersistCore (..) , PersistStoreRead (..) , PersistStoreWrite (..)+ , getEntity , getJust+ , getJustEntity , belongsTo , belongsToJust , insertEntity+ , insertRecord , ToBackendKey(..) ) where @@ -173,7 +176,7 @@ get key >>= maybe (liftIO $ throwIO $ KeyNotFound $ show key) return --- | Same as get, but for a non-null (not Maybe) foreign key+-- | Same as 'get', but for a non-null (not Maybe) foreign key -- Unsafe unless your database is enforcing that the foreign key is valid. getJust :: ( PersistStoreRead backend , Show (Key record)@@ -184,6 +187,22 @@ (liftIO $ throwIO $ PersistForeignConstraintUnmet $ T.pack $ show key) return +-- | Same as 'getJust', but returns an 'Entity' instead of just the record.+-- @since 2.6.1+getJustEntity+ :: (PersistEntityBackend record ~ BaseBackend backend+ ,MonadIO m+ ,PersistEntity record+ ,PersistStoreRead backend)+ => Key record -> ReaderT backend m (Entity record)+getJustEntity key = do+ record <- getJust key+ return $+ Entity+ { entityKey = key+ , entityVal = record+ }+ -- | Curry this to make a convenience function that loads an associated model. -- -- > foreign = belongsTo foreignId@@ -216,3 +235,26 @@ insertEntity e = do eid <- insert e return $ Entity eid e++-- | Like @get@, but returns the complete @Entity@.+getEntity ::+ ( PersistStoreWrite backend+ , PersistRecordBackend e backend+ , MonadIO m+ ) => Key e -> ReaderT backend m (Maybe (Entity e))+getEntity key = do+ maybeModel <- get key+ return $ fmap (key `Entity`) maybeModel++-- | Like 'insertEntity' but just returns the record instead of 'Entity'.+-- @since 2.6.1+insertRecord+ :: (PersistEntityBackend record ~ BaseBackend backend+ ,PersistEntity record+ ,MonadIO m+ ,PersistStoreWrite backend)+ => record -> ReaderT backend m record+insertRecord record = do+ insert_ record+ return $ record+
Database/Persist/Class/PersistUnique.hs view
@@ -119,9 +119,9 @@ -- | Insert a value, checking for conflicts with any unique constraints. If a -- duplicate exists in the database, it is left untouched. The key of the -- existing or new entry is returned-insertOrGet :: (MonadIO m, PersistUniqueWrite backend, PersistRecordBackend record backend)+_insertOrGet :: (MonadIO m, PersistUniqueWrite backend, PersistRecordBackend record backend) => record -> ReaderT backend m (Key record)-insertOrGet val = do+_insertOrGet val = do res <- getByValue val case res of Nothing -> insert val@@ -157,7 +157,7 @@ requireUniques :: (MonadIO m, PersistEntity record) => record -> [Unique record] -> m [Unique record] requireUniques record [] = liftIO $ throwIO $ userError errorMsg where- errorMsg = "getByValue: " `mappend` unpack (recordName record) `mappend` " does not have any Unique"+ errorMsg = "getByValue: " `Data.Monoid.mappend` unpack (recordName record) `mappend` " does not have any Unique" requireUniques _ xs = return xs -- TODO: expose this to users
Database/Persist/Quasi.hs view
@@ -49,7 +49,7 @@ let (a, b) = T.break (== end) t in case parseApplyFT a of PSSuccess ft t' -> case (T.dropWhile isSpace t', T.uncons b) of- ("", Just (c, t'')) | c == end -> PSSuccess (ftMod ft) (t'' `mappend` t')+ ("", Just (c, t'')) | c == end -> PSSuccess (ftMod ft) (t'' `Data.Monoid.mappend` t') (x, y) -> PSFail $ show (b, x, y) x -> PSFail $ show x
Database/Persist/Sql/Class.hs view
@@ -7,15 +7,18 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-}-#ifndef NO_OVERLAP+{-# LANGUAGE PatternGuards #-}++#if !MIN_VERSION_base(4,8,0) {-# LANGUAGE OverlappingInstances #-} #endif+ module Database.Persist.Sql.Class ( RawSql (..) , PersistFieldSql (..) ) where -import Control.Applicative ((<$>), (<*>))+import Control.Applicative as A ((<$>), (<*>)) import Database.Persist import Data.Monoid ((<>)) import Database.Persist.Sql.Types@@ -33,7 +36,7 @@ import Data.Word import Data.ByteString (ByteString) import Text.Blaze.Html (Html)-import Data.Bits (bitSize)+import Data.Bits (bitSizeMaybe) import qualified Data.Vector as V #if MIN_VERSION_base(4,8,0)@@ -57,7 +60,7 @@ instance PersistField a => RawSql (Single a) where rawSqlCols _ _ = (1, []) rawSqlColCountReason _ = "one column for a 'Single' data type"- rawSqlProcessRow [pv] = Single <$> fromPersistValue pv+ rawSqlProcessRow [pv] = Single A.<$> fromPersistValue pv rawSqlProcessRow _ = Left $ pack "RawSql (Single a): wrong number of columns." instance@@ -72,7 +75,7 @@ instance (PersistEntity record, PersistEntityBackend record ~ backend, IsPersistBackend backend) => RawSql (Entity record) where- rawSqlCols escape ent = (length sqlFields, [intercalate ", " sqlFields])+ rawSqlCols escape _ent = (length sqlFields, [intercalate ", " sqlFields]) where sqlFields = map (((name <> ".") <>) . escape) $ map fieldDB@@ -86,8 +89,8 @@ 1 -> "one column for an 'Entity' data type without fields" n -> show n ++ " columns for an 'Entity' data type" rawSqlProcessRow row = case splitAt nKeyFields row of- (rowKey, rowVal) -> Entity <$> keyFromValues rowKey- <*> fromPersistValues rowVal+ (rowKey, rowVal) -> Entity A.<$> keyFromValues rowKey+ A.<*> fromPersistValues rowVal where nKeyFields = length $ entityKeyFields entDef entDef = entityDef (Nothing :: Maybe record)@@ -212,7 +215,12 @@ sqlType :: Proxy a -> SqlType #ifndef NO_OVERLAP-instance PersistFieldSql String where++#if MIN_VERSION_base(4,8,0)+instance {-# OVERLAPPING #-} PersistFieldSql [Char] where+#else+instance PersistFieldSql [Char] where+#endif sqlType _ = SqlString #endif @@ -226,7 +234,7 @@ sqlType _ = SqlString instance PersistFieldSql Int where sqlType _- | bitSize (0 :: Int) <= 32 = SqlInt32+ | Just x <- bitSizeMaybe (0 :: Int), x <= 32 = SqlInt32 | otherwise = SqlInt64 instance PersistFieldSql Int8 where sqlType _ = SqlInt32@@ -256,7 +264,11 @@ sqlType _ = SqlTime instance PersistFieldSql UTCTime where sqlType _ = SqlDayTime+#if MIN_VERSION_base(4,8,0)+instance {-# OVERLAPPABLE #-} PersistFieldSql a => PersistFieldSql [a] where+#else instance PersistFieldSql a => PersistFieldSql [a] where+#endif sqlType _ = SqlString instance PersistFieldSql a => PersistFieldSql (V.Vector a) where sqlType _ = SqlString
Database/Persist/Sql/Internal.hs view
@@ -68,10 +68,10 @@ refName :: DBName -> DBName -> DBName refName (DBName table) (DBName column) =- DBName $ mconcat [table, "_", column, "_fkey"]+ DBName $ Data.Monoid.mconcat [table, "_", column, "_fkey"] resolveTableName :: [EntityDef] -> HaskellName -> DBName-resolveTableName [] (HaskellName hn) = error $ "Table not found: " `mappend` T.unpack hn+resolveTableName [] (HaskellName hn) = error $ "Table not found: " `Data.Monoid.mappend` T.unpack hn resolveTableName (e:es) hn | entityHaskell e == hn = entityDB e | otherwise = resolveTableName es hn
Database/Persist/Sql/Migration.hs view
@@ -33,6 +33,8 @@ safeSql :: CautiousMigration -> [Sql] safeSql = allSql . filter (not . fst) +-- | Given a 'Migration', this parses it and returns either a list of+-- errors associated with the migration or a list of migrations to do. parseMigration :: MonadIO m => Migration -> ReaderT SqlBackend m (Either [Text] CautiousMigration) parseMigration = liftIOReader . liftM go . runWriterT . execWriterT@@ -42,7 +44,8 @@ liftIOReader (ReaderT m) = ReaderT $ liftIO . m --- like parseMigration, but call error or return the CautiousMigration+-- | Like 'parseMigration', but instead of returning the value in an+-- 'Either' value, it calls 'error' on the error values. parseMigration' :: MonadIO m => Migration -> ReaderT SqlBackend m (CautiousMigration) parseMigration' m = do x <- parseMigration m@@ -50,18 +53,25 @@ Left errs -> error $ unlines $ map unpack errs Right sql -> return sql +-- | Prints a migration. printMigration :: MonadIO m => Migration -> ReaderT SqlBackend m () printMigration m = showMigration m >>= mapM_ (liftIO . Data.Text.IO.putStrLn) +-- | Convert a 'Migration' to a list of 'Text' values corresponding to their+-- 'Sql' statements. showMigration :: MonadIO m => Migration -> ReaderT SqlBackend m [Text] showMigration m = map (flip snoc ';') `liftM` getMigration m +-- | Return all of the 'Sql' values associated with the given migration.+-- Calls 'error' if there's a parse error on any migration. getMigration :: MonadIO m => Migration -> ReaderT SqlBackend m [Sql] getMigration m = do mig <- parseMigration' m return $ allSql mig +-- | Runs a migration. If the migration fails to parse or if any of the+-- migrations are unsafe, then this calls 'error' to halt the program. runMigration :: MonadIO m => Migration -> ReaderT SqlBackend m ()@@ -74,6 +84,9 @@ -> ReaderT SqlBackend m [Text] runMigrationSilent m = liftBaseOp_ (hSilence [stderr]) $ runMigration' m True +-- | Run the given migration against the database. If the migration fails+-- to parse, or there are any unsafe migrations, then this will error at+-- runtime. This returns a list of the migrations that were executed. runMigration' :: MonadIO m => Migration@@ -93,6 +106,8 @@ displayMigration (True, s) = "*** " ++ unpack s ++ ";" displayMigration (False, s) = " " ++ unpack s ++ ";" +-- | Like 'runMigration', but this will perform the unsafe database+-- migrations instead of erroring out. runMigrationUnsafe :: MonadIO m => Migration -> ReaderT SqlBackend m ()@@ -116,6 +131,9 @@ -- choose to have this special sorting applied. isCreate t = pack "CREATe " `isPrefixOf` t +-- | Given a list of old entity definitions and a new 'EntityDef' in+-- @val@, this creates a 'Migration' to update the old list of definitions+-- with the new one. migrate :: [EntityDef] -> EntityDef -> Migration
Database/Persist/Sql/Orphan/PersistQuery.hs view
@@ -183,7 +183,7 @@ , T.intercalate "," $ map (go' conn . go) upds , wher ]- let dat = map updatePersistValue upds `mappend`+ let dat = map updatePersistValue upds `Data.Monoid.mappend` getFiltsValues conn filts rawExecuteCount sql dat where@@ -273,7 +273,7 @@ (True, Just pdef, _) -> error $ "unhandled error for composite/non id primary keys filter=" ++ show pfilter ++ " persistList=" ++ show allVals ++ " pdef=" ++ show pdef - _ -> case (isNull, pfilter, varCount) of+ _ -> case (isNull, pfilter, length notNullVals) of (True, Eq, _) -> (name <> " IS NULL", []) (True, Ne, _) -> (name <> " IS NOT NULL", []) (False, Ne, _) -> (T.concat@@ -298,7 +298,8 @@ , qmarks , ")" ], notNullVals)- (_, NotIn, 0) -> ("1=1", [])+ (False, NotIn, 0) -> ("1=1", [])+ (True, NotIn, 0) -> (name <> " IS NOT NULL", []) (False, NotIn, _) -> (T.concat [ "(" , name@@ -353,9 +354,6 @@ Right x -> let x' = filter (/= PersistNull) $ map toPersistValue x in "(" <> T.intercalate "," (map (const "?") x') <> ")"- varCount = case value of- Left _ -> 1- Right x -> length x showSqlFilter Eq = "=" showSqlFilter Ne = "<>" showSqlFilter Gt = ">"
Database/Persist/Sql/Orphan/PersistStore.hs view
@@ -123,7 +123,7 @@ go'' n Subtract = T.concat [n, "=", n, "-?"] go'' n Multiply = T.concat [n, "=", n, "*?"] go'' n Divide = T.concat [n, "=", n, "/?"]- go'' _ (BackendSpecificUpdate up) = error $ T.unpack $ "BackendSpecificUpdate" `mappend` up `mappend` "not supported"+ go'' _ (BackendSpecificUpdate up) = error $ T.unpack $ "BackendSpecificUpdate" `Data.Monoid.mappend` up `mappend` "not supported" let go' (x, pu) = go'' (connEscapeName conn x) pu let wher = whereStmtForKey conn k let sql = T.concat@@ -212,22 +212,32 @@ valss = map (map toPersistValue . toPersistFields) vals + insertMany_ [] = return ()- insertMany_ vals = do- conn <- ask- let sql = T.concat- [ "INSERT INTO "- , connEscapeName conn (entityDB t)- , "("- , T.intercalate "," $ map (connEscapeName conn . fieldDB) $ entityFields t- , ") VALUES ("- , T.intercalate "),(" $ replicate (length valss) $ T.intercalate "," $ map (const "?") (entityFields t)- , ")"- ]- rawExecute sql (concat valss)+ insertMany_ vals0 = do conn <- ask+ case connMaxParams conn of+ Nothing -> insertMany_' vals0+ Just maxParams -> let chunkSize = maxParams `div` length (entityFields t) in+ mapM_ insertMany_' (chunksOf chunkSize vals0) where- t = entityDef vals- valss = map (map toPersistValue . toPersistFields) vals+ insertMany_' vals = do+ conn <- ask+ let valss = map (map toPersistValue . toPersistFields) vals+ let sql = T.concat+ [ "INSERT INTO "+ , connEscapeName conn (entityDB t)+ , "("+ , T.intercalate "," $ map (connEscapeName conn . fieldDB) $ entityFields t+ , ") VALUES ("+ , T.intercalate "),(" $ replicate (length valss) $ T.intercalate "," $ map (const "?") (entityFields t)+ , ")"+ ]+ rawExecute sql (concat valss)++ t = entityDef vals0+ -- Implement this here to avoid depending on the split package+ chunksOf _ [] = []+ chunksOf size xs = let (chunk, rest) = splitAt size xs in chunk : chunksOf size rest replace k val = do conn <- ask
Database/Persist/Sql/Orphan/PersistUnique.hs view
@@ -16,7 +16,6 @@ import Data.Monoid (mappend, (<>)) import qualified Data.Conduit.List as CL import Control.Monad.Trans.Reader (ask, withReaderT)-import Control.Monad (when, liftM) defaultUpsert :: (MonadIO m, PersistEntity record, PersistUniqueWrite backend , PersistEntityBackend record ~ BaseBackend backend) @@ -33,7 +32,7 @@ case connUpsertSql conn of Just upsertSql -> case updates of [] -> defaultUpsert record updates- xs -> do+ _:_ -> do let upds = T.intercalate "," $ map (go' . go) updates sql = upsertSql t upds vals = (map toPersistValue $ toPersistFields record) ++ (map updatePersistValue updates) ++ (unqs uniqueKey)@@ -43,7 +42,7 @@ go'' n Subtract = T.concat [n, "=", n, "-?"] go'' n Multiply = T.concat [n, "=", n, "*?"] go'' n Divide = T.concat [n, "=", n, "/?"]- go'' _ (BackendSpecificUpdate up) = error $ T.unpack $ "BackendSpecificUpdate" `mappend` up `mappend` "not supported"+ go'' _ (BackendSpecificUpdate up) = error $ T.unpack $ "BackendSpecificUpdate" `Data.Monoid.mappend` up `mappend` "not supported" go' (x, pu) = go'' (connEscapeName conn x) pu go x = (fieldDB $ updateFieldDef x, updateUpdate x)
Database/Persist/Sql/Raw.hs view
@@ -11,7 +11,6 @@ import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Reader (ReaderT, ask, MonadReader) import Data.Acquire (allocateAcquire, Acquire, mkAcquire, with)-import Data.Functor ((<$>)) import Data.IORef (writeIORef, readIORef, newIORef) import Control.Exception (throwIO) import Control.Monad (when, liftM)
Database/Persist/Sql/Types.hs view
@@ -19,22 +19,13 @@ import Control.Exception (Exception) import Control.Monad.Trans.Resource (ResourceT)-import Data.Acquire (Acquire) import Control.Monad.Logger (NoLoggingT)-import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Reader (ReaderT (..)) import Control.Monad.Trans.Writer (WriterT) import Data.Typeable (Typeable) import Database.Persist.Types import Database.Persist.Sql.Types.Internal-import Data.IORef (IORef)-import Data.Map (Map)-import Data.Int (Int64)-import Data.Conduit (Source) import Data.Pool (Pool)-import Language.Haskell.TH.Syntax (Loc)-import Control.Monad.Logger (LogSource, LogLevel)-import System.Log.FastLogger (LogStr) import Data.Text (Text) -- | Deprecated synonym for @SqlBackend@.@@ -80,16 +71,8 @@ -- some complex @JOIN@ query, or a database-specific command -- needs to be issued. ----- To issue raw SQL queries you could use 'R.withStmt', which--- allows you to do anything you need. However, its API is--- /low-level/ and you need to parse each row yourself. However,--- most of your complex queries will have simple results -- some--- of your entities and maybe a couple of derived columns.------ This is where 'rawSql' comes in. Like 'R.withStmt', you may--- issue /any/ SQL query. However, it does all the hard work for--- you and automatically parses the rows of the result. It may--- return:+-- To issue raw SQL queries, use 'rawSql'. It does all the hard work of+-- automatically parsing the rows of the result. It may return: -- -- * An 'Entity', that which 'selectList' returns. -- All of your entity's fields are
Database/Persist/Sql/Types/Internal.hs view
@@ -81,6 +81,11 @@ , connRDBMS :: Text , connLimitOffset :: (Int,Int) -> Bool -> Text -> Text , connLogFunc :: LogFunc+ , connMaxParams :: Maybe Int+ -- ^ Some databases (probably only Sqlite) have a limit on how+ -- many question-mark parameters may be used in a statement+ --+ -- @since 2.6.1 } deriving Typeable instance HasPersistBackend SqlBackend where
Database/Persist/Types/Base.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-deprecations #-} -- usage of Error typeclass module Database.Persist.Types.Base where import qualified Data.Aeson as A@@ -16,10 +17,9 @@ import qualified Data.ByteString.Base64 as B64 import qualified Data.Vector as V import Control.Arrow (second)-import Control.Applicative ((<$>))+import Control.Applicative as A ((<$>)) import Data.Time (Day, TimeOfDay, UTCTime) import Data.Int (Int64)-import qualified Data.Text.Read import Data.ByteString (ByteString, foldl') import Data.Bits (shiftL, shiftR) import qualified Data.ByteString as BS@@ -90,8 +90,14 @@ instance FromHttpApiData Checkmark where parseUrlPiece = parseBoundedTextData -instance PathPiece Checkmark+instance PathPiece Checkmark where+ toPathPiece Active = "active"+ toPathPiece Inactive = "inactive" + fromPathPiece "active" = Just Active+ fromPathPiece "inactive" = Just Inactive+ fromPathPiece _ = Nothing+ data IsNullable = Nullable !WhyNullable | NotNullable deriving (Eq, Show)@@ -324,9 +330,9 @@ instance FromHttpApiData PersistValue where parseUrlPiece input =- PersistInt64 <$> parseUrlPiece input- <!> PersistList <$> readTextData input- <!> PersistText <$> return input+ PersistInt64 A.<$> parseUrlPiece input+ <!> PersistList A.<$> readTextData input+ <!> PersistText A.<$> return input where infixl 3 <!> Left _ <!> y = y
persistent.cabal view
@@ -1,5 +1,5 @@ name: persistent-version: 2.6+version: 2.6.1 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.6 && < 5+ build-depends: base >= 4.7 && < 5 , bytestring >= 0.9 , transformers >= 0.2.1 , time >= 1.1.4@@ -36,7 +36,7 @@ , lifted-base >= 0.1 , resource-pool >= 0.2.2.0 , path-pieces >= 0.1- , http-api-data >= 0.2 && < 0.3+ , http-api-data >= 0.2 && < 0.4 , aeson >= 0.5 , monad-logger >= 0.3 , transformers-base@@ -100,7 +100,7 @@ , attoparsec , transformers , path-pieces- , http-api-data >= 0.2 && < 0.3+ , http-api-data >= 0.2 && < 0.4 , aeson , resourcet , monad-logger@@ -116,6 +116,12 @@ , resource-pool cpp-options: -DTEST++ other-modules: Database.Persist.Class.PersistEntity+ Database.Persist.Class.PersistField+ Database.Persist.Quasi+ Database.Persist.Types+ Database.Persist.Types.Base source-repository head type: git