yesod-persistent-1.6.0.8/Yesod/0000755000000000000000000000000014035333675014467 5ustar0000000000000000yesod-persistent-1.6.0.8/Yesod/Persist/0000755000000000000000000000000014226324661016115 5ustar0000000000000000yesod-persistent-1.6.0.8/test/0000755000000000000000000000000014035333675014363 5ustar0000000000000000yesod-persistent-1.6.0.8/test/Yesod/0000755000000000000000000000000014035334553015442 5ustar0000000000000000yesod-persistent-1.6.0.8/Yesod/Persist.hs0000644000000000000000000000021514035333675016452 0ustar0000000000000000module Yesod.Persist ( module X ) where import Database.Persist as X import Database.Persist.TH as X import Yesod.Persist.Core as X yesod-persistent-1.6.0.8/Yesod/Persist/Core.hs0000644000000000000000000002062314226324661017344 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | Defines the core functionality of this package. This package is -- distinguished from Yesod.Persist in that the latter additionally exports the -- persistent modules themselves. module Yesod.Persist.Core ( YesodPersist (..) , defaultRunDB , YesodPersistRunner (..) , defaultGetDBRunner , DBRunner (..) , runDBSource , respondSourceDB , YesodDB , get404 , getBy404 , insert400 , insert400_ ) where import Database.Persist import Control.Monad.Trans.Reader (ReaderT, runReaderT) import Data.Foldable (toList) import Yesod.Core import Data.Conduit import Blaze.ByteString.Builder (Builder) import Data.Pool import Control.Monad.Trans.Resource import Control.Exception (throwIO) import Yesod.Core.Types (HandlerContents (HCError)) import qualified Database.Persist.Sql as SQL #if MIN_VERSION_persistent(2,13,0) import qualified Database.Persist.SqlBackend.Internal as SQL #endif #if MIN_VERSION_persistent(2,14,0) import Database.Persist.Class.PersistEntity #endif unSqlPersistT :: a -> a unSqlPersistT = id type YesodDB site = ReaderT (YesodPersistBackend site) (HandlerFor site) class Monad (YesodDB site) => YesodPersist site where type YesodPersistBackend site -- | Allows you to execute database actions within Yesod Handlers. For databases that support it, code inside the action will run as an atomic transaction. -- -- -- ==== __Example Usage__ -- -- > userId <- runDB $ do -- > userId <- insert $ User "username" "email@example.com" -- > insert_ $ UserPreferences userId True -- > pure userId runDB :: YesodDB site a -> HandlerFor site a -- | Helper for creating 'runDB'. -- -- Since 1.2.0 defaultRunDB :: PersistConfig c => (site -> c) -> (site -> PersistConfigPool c) -> PersistConfigBackend c (HandlerFor site) a -> HandlerFor site a defaultRunDB getConfig getPool f = do master <- getYesod Database.Persist.runPool (getConfig master) f (getPool master) -- | -- -- Since 1.2.0 class YesodPersist site => YesodPersistRunner site where -- | This function differs from 'runDB' in that it returns a database -- runner function, as opposed to simply running a single action. This will -- usually mean that a connection is taken from a pool and then reused for -- each invocation. This can be useful for creating streaming responses; -- see 'runDBSource'. -- -- It additionally returns a cleanup function to free the connection. If -- your code finishes successfully, you /must/ call this cleanup to -- indicate changes should be committed. Otherwise, for SQL backends at -- least, a rollback will be used instead. -- -- Since 1.2.0 getDBRunner :: HandlerFor site (DBRunner site, HandlerFor site ()) newtype DBRunner site = DBRunner { runDBRunner :: forall a. YesodDB site a -> HandlerFor site a } -- | Helper for implementing 'getDBRunner'. -- -- Since 1.2.0 #if MIN_VERSION_persistent(2,5,0) defaultGetDBRunner :: (SQL.IsSqlBackend backend, YesodPersistBackend site ~ backend) => (site -> Pool backend) -> HandlerFor site (DBRunner site, HandlerFor site ()) #else defaultGetDBRunner :: YesodPersistBackend site ~ SQL.SqlBackend => (site -> Pool SQL.SqlBackend) -> HandlerFor site (DBRunner site, HandlerFor site ()) #endif defaultGetDBRunner getPool = do pool <- fmap getPool getYesod let withPrep conn f = f (persistBackend conn) (SQL.getStmtConn $ persistBackend conn) (relKey, (conn, local)) <- allocate (do (conn, local) <- takeResource pool #if MIN_VERSION_persistent(2,9,0) withPrep conn (\c f -> SQL.connBegin c f Nothing) #else withPrep conn SQL.connBegin #endif return (conn, local) ) (\(conn, local) -> do withPrep conn SQL.connRollback destroyResource pool local conn) let cleanup = liftIO $ do withPrep conn SQL.connCommit putResource local conn _ <- unprotect relKey return () return (DBRunner $ \x -> runReaderT (unSqlPersistT x) conn, cleanup) -- | Like 'runDB', but transforms a @Source@. See 'respondSourceDB' for an -- example, practical use case. -- -- Since 1.2.0 runDBSource :: YesodPersistRunner site => ConduitT () a (YesodDB site) () -> ConduitT () a (HandlerFor site) () runDBSource src = do (dbrunner, cleanup) <- lift getDBRunner transPipe (runDBRunner dbrunner) src lift cleanup -- | Extends 'respondSource' to create a streaming database response body. respondSourceDB :: YesodPersistRunner site => ContentType -> ConduitT () (Flush Builder) (YesodDB site) () -> HandlerFor site TypedContent respondSourceDB ctype = respondSource ctype . runDBSource -- | Get the given entity by ID, or return a 404 not found if it doesn't exist. #if MIN_VERSION_persistent(2,5,0) get404 :: (MonadIO m, PersistStoreRead backend, PersistRecordBackend val backend) => Key val -> ReaderT backend m val #else get404 :: (MonadIO m, PersistStore (PersistEntityBackend val), PersistEntity val) => Key val -> ReaderT (PersistEntityBackend val) m val #endif get404 key = do mres <- get key case mres of Nothing -> notFound' Just res -> return res -- | Get the given entity by unique key, or return a 404 not found if it doesn't -- exist. #if MIN_VERSION_persistent(2,5,0) getBy404 :: (PersistUniqueRead backend, PersistRecordBackend val backend, MonadIO m) => Unique val -> ReaderT backend m (Entity val) #else getBy404 :: (PersistUnique (PersistEntityBackend val), PersistEntity val, MonadIO m) => Unique val -> ReaderT (PersistEntityBackend val) m (Entity val) #endif getBy404 key = do mres <- getBy key case mres of Nothing -> notFound' Just res -> return res -- | Create a new record in the database, returning an automatically -- created key, or raise a 400 bad request if a uniqueness constraint -- is violated. -- -- @since 1.4.1 #if MIN_VERSION_persistent(2,14,0) insert400 :: (MonadIO m, PersistUniqueWrite backend, PersistRecordBackend val backend, SafeToInsert val) => val -> ReaderT backend m (Key val) #elif MIN_VERSION_persistent(2,5,0) insert400 :: (MonadIO m, PersistUniqueWrite backend, PersistRecordBackend val backend) => val -> ReaderT backend m (Key val) #else insert400 :: (MonadIO m, PersistUnique (PersistEntityBackend val), PersistEntity val) => val -> ReaderT (PersistEntityBackend val) m (Key val) #endif insert400 datum = do conflict <- checkUnique datum case conflict of Just unique -> #if MIN_VERSION_persistent(2, 12, 0) -- toList is called here because persistent-2.13 changed this -- to a nonempty list. for versions of persistent prior to 2.13, toList -- will be a no-op. for persistent-2.13, it'll convert the NonEmptyList to -- a List. badRequest' $ map (unFieldNameHS . fst) $ toList $ persistUniqueToFieldNames unique #else badRequest' $ map (unHaskellName . fst) $ persistUniqueToFieldNames unique #endif Nothing -> insert datum -- | Same as 'insert400', but doesn’t return a key. -- -- @since 1.4.1 #if MIN_VERSION_persistent(2,14,0) insert400_ :: (MonadIO m, PersistUniqueWrite backend, PersistRecordBackend val backend, SafeToInsert val) => val -> ReaderT backend m () #elif MIN_VERSION_persistent(2,5,0) insert400_ :: (MonadIO m, PersistUniqueWrite backend, PersistRecordBackend val backend) => val -> ReaderT backend m () #else insert400_ :: (MonadIO m, PersistUnique (PersistEntityBackend val), PersistEntity val) => val -> ReaderT (PersistEntityBackend val) m () #endif insert400_ datum = insert400 datum >> return () -- | Should be equivalent to @lift . notFound@, but there's an apparent bug in -- GHC 7.4.2 that leads to segfaults. This is a workaround. notFound' :: MonadIO m => m a notFound' = liftIO $ throwIO $ HCError NotFound -- | Constructed like 'notFound'', and for the same reasons. badRequest' :: MonadIO m => Texts -> m a badRequest' = liftIO . throwIO . HCError . InvalidArgs yesod-persistent-1.6.0.8/test/Spec.hs0000644000000000000000000000005414035333675015610 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} yesod-persistent-1.6.0.8/test/Yesod/PersistSpec.hs0000644000000000000000000000432514035334553020246 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, TypeFamilies #-} {-# LANGUAGE EmptyDataDecls, FlexibleContexts, GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE CPP #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE StandaloneDeriving #-} module Yesod.PersistSpec where import Test.Hspec import Database.Persist.Sqlite import Network.Wai.Test import Yesod.Core import Data.Conduit import Blaze.ByteString.Builder.Char.Utf8 (fromText) import Yesod.Persist import Data.Text (Text) share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| Person name Text UniquePerson name |] data App = App { appConfig :: SqliteConf , appPool :: ConnectionPool } mkYesod "App" [parseRoutes| / HomeR GET /ins InsertR GET |] instance Yesod App instance YesodPersist App where type YesodPersistBackend App = SqlBackend runDB = defaultRunDB appConfig appPool instance YesodPersistRunner App where getDBRunner = defaultGetDBRunner appPool getHomeR :: Handler TypedContent getHomeR = do runDB $ do runMigration migrateAll deleteWhere ([] :: [Filter Person]) insert_ $ Person "Charlie" insert_ $ Person "Alice" insert_ $ Person "Bob" respondSourceDB typePlain $ selectSource [] [Asc PersonName] .| awaitForever toBuilder where toBuilder (Entity _ (Person name)) = do yield $ Chunk $ fromText name yield $ Chunk $ fromText "\n" yield Flush getInsertR :: Handler () getInsertR = runDB $ insert400_ $ Person "Alice" test :: String -> Session () -> Spec test name session = it name $ do let config = SqliteConf ":memory:" 1 pool <- createPoolConfig config app <- toWaiApp $ App config pool runSession session app spec :: Spec spec = do test "streaming" $ do sres <- request defaultRequest assertBody "Alice\nBob\nCharlie\n" sres assertStatus 200 sres test "insert400" $ do sres <- request defaultRequest assertStatus 200 sres sres' <- request $ defaultRequest `setPath` "/ins" assertStatus 400 sres' yesod-persistent-1.6.0.8/LICENSE0000644000000000000000000000207514035333675014415 0ustar0000000000000000Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/ Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. yesod-persistent-1.6.0.8/Setup.lhs0000755000000000000000000000016214035333675015216 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain yesod-persistent-1.6.0.8/yesod-persistent.cabal0000644000000000000000000000330414226324661017706 0ustar0000000000000000cabal-version: >= 1.10 name: yesod-persistent version: 1.6.0.8 license: MIT license-file: LICENSE author: Michael Snoyman maintainer: Michael Snoyman synopsis: Some helpers for using Persistent from Yesod. category: Web, Yesod, Database stability: Stable build-type: Simple homepage: http://www.yesodweb.com/ description: API docs and the README are available at extra-source-files: README.md ChangeLog.md library default-language: Haskell2010 build-depends: base >= 4.10 && < 5 , yesod-core >= 1.6 && < 1.7 , persistent >= 2.8 , persistent-template >= 2.1 , transformers >= 0.2.2 , blaze-builder , conduit , resourcet >= 0.4.5 , resource-pool exposed-modules: Yesod.Persist Yesod.Persist.Core ghc-options: -Wall test-suite test default-language: Haskell2010 type: exitcode-stdio-1.0 main-is: Spec.hs hs-source-dirs: test other-modules: Yesod.PersistSpec build-depends: base , hspec , wai-extra , yesod-core , persistent-sqlite >= 2.8 , yesod-persistent , conduit , blaze-builder , persistent , text source-repository head type: git location: https://github.com/yesodweb/yesod yesod-persistent-1.6.0.8/README.md0000644000000000000000000000010314035333675014655 0ustar0000000000000000## yesod-persistent Some helpers for using Persistent from Yesod. yesod-persistent-1.6.0.8/ChangeLog.md0000644000000000000000000000232114226324661015550 0ustar0000000000000000# ChangeLog for yesod-persistent ## 1.6.0.8 * Add support for `persistent-2.14` [#1706](https://github.com/yesodweb/yesod/pull/1760) ## 1.6.0.7 * Add support for persistent 2.13. [#1723](https://github.com/yesodweb/yesod/pull/1723) ## 1.6.0.6 * Add support for persistent 2.12 ## 1.6.0.5 * Add support for Persistent 2.11 [#1701](https://github.com/yesodweb/yesod/pull/1701) ## 1.6.0.4 * Fix test suite to be compatible with latest `persistent-template` * See https://github.com/yesodweb/persistent/pull/1002 * [#1649](https://github.com/yesodweb/yesod/pull/1649/files) ## 1.6.0.3 * Replace call to `connPrepare` with `getStmtConn`. [#1635](https://github.com/yesodweb/yesod/issues/1635) ## 1.6.0.2 * Add support for persistent 2.10 ## 1.6.0.1 * Add support for persistent 2.9 [#1516](https://github.com/yesodweb/yesod/pull/1516), [#1561](https://github.com/yesodweb/yesod/pull/1561) ## 1.6.0 * Upgrade to yesod-core 1.6.0 ## 1.4.3 * Fix overly powerful constraints on get404 and getBy404. ## 1.4.2 * Fix warnings ## 1.4.1.1 * Fix build failure with older persistent versions [#1324](https://github.com/yesodweb/yesod/issues/1324) ## 1.4.1.0 * add `insert400` and `insert400_` ## 1.4.0.6 * persistent-2.6