yesod-persistent-1.4.0.3/0000755000000000000000000000000012537254130013366 5ustar0000000000000000yesod-persistent-1.4.0.3/ChangeLog.md0000644000000000000000000000002612537254130015535 0ustar0000000000000000No changes logged yet yesod-persistent-1.4.0.3/yesod-persistent.cabal0000644000000000000000000000322412537254130017674 0ustar0000000000000000name: yesod-persistent version: 1.4.0.3 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 cabal-version: >= 1.8 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 build-depends: base >= 4 && < 5 , yesod-core >= 1.4.0 && < 1.5 , persistent >= 2.1 && < 2.3 , persistent-template >= 2.1 && < 2.2 , 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 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 , yesod-persistent , conduit , blaze-builder , persistent , text source-repository head type: git location: https://github.com/yesodweb/yesod yesod-persistent-1.4.0.3/LICENSE0000644000000000000000000000207512537254130014377 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.4.0.3/README.md0000644000000000000000000000010312537254130014637 0ustar0000000000000000## yesod-persistent Some helpers for using Persistent from Yesod. yesod-persistent-1.4.0.3/Setup.lhs0000644000000000000000000000016212537254130015175 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain yesod-persistent-1.4.0.3/test/0000755000000000000000000000000012537254130014345 5ustar0000000000000000yesod-persistent-1.4.0.3/test/Spec.hs0000644000000000000000000000005412537254130015572 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} yesod-persistent-1.4.0.3/test/Yesod/0000755000000000000000000000000012537254130015430 5ustar0000000000000000yesod-persistent-1.4.0.3/test/Yesod/PersistSpec.hs0000644000000000000000000000335312537254130020234 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, TypeFamilies #-} {-# LANGUAGE EmptyDataDecls, FlexibleContexts, GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE CPP #-} 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 |] data App = App { appConfig :: SqliteConf , appPool :: ConnectionPool } mkYesod "App" [parseRoutes| / HomeR 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 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 = test "streaming" $ do sres <- request defaultRequest assertBody "Alice\nBob\nCharlie\n" sres assertStatus 200 sres yesod-persistent-1.4.0.3/Yesod/0000755000000000000000000000000012537254130014451 5ustar0000000000000000yesod-persistent-1.4.0.3/Yesod/Persist.hs0000644000000000000000000000021512537254130016434 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.4.0.3/Yesod/Persist/0000755000000000000000000000000012537254130016102 5ustar0000000000000000yesod-persistent-1.4.0.3/Yesod/Persist/Core.hs0000644000000000000000000001165112537254130017332 0ustar0000000000000000{-# 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 ) where import Database.Persist import Control.Monad.Trans.Reader (ReaderT, runReaderT) 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 unSqlPersistT :: a -> a unSqlPersistT = id type YesodDB site = ReaderT (YesodPersistBackend site) (HandlerT site IO) class Monad (YesodDB site) => YesodPersist site where type YesodPersistBackend site runDB :: YesodDB site a -> HandlerT site IO a -- | Helper for creating 'runDB'. -- -- Since 1.2.0 defaultRunDB :: PersistConfig c => (site -> c) -> (site -> PersistConfigPool c) -> PersistConfigBackend c (HandlerT site IO) a -> HandlerT site IO 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 :: HandlerT site IO (DBRunner site, HandlerT site IO ()) newtype DBRunner site = DBRunner { runDBRunner :: forall a. YesodDB site a -> HandlerT site IO a } -- | Helper for implementing 'getDBRunner'. -- -- Since 1.2.0 defaultGetDBRunner :: YesodPersistBackend site ~ SQL.SqlBackend => (site -> Pool SQL.Connection) -> HandlerT site IO (DBRunner site, HandlerT site IO ()) defaultGetDBRunner getPool = do pool <- fmap getPool getYesod let withPrep conn f = f conn (SQL.connPrepare conn) (relKey, (conn, local)) <- allocate (do (conn, local) <- takeResource pool withPrep conn SQL.connBegin 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 => Source (YesodDB site) a -> Source (HandlerT site IO) a 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 -> Source (YesodDB site) (Flush Builder) -> HandlerT site IO TypedContent respondSourceDB ctype = respondSource ctype . runDBSource -- | Get the given entity by ID, or return a 404 not found if it doesn't exist. get404 :: (MonadIO m, PersistStore (PersistEntityBackend val), PersistEntity val) => Key val -> ReaderT (PersistEntityBackend val) m val 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. getBy404 :: (PersistUnique (PersistEntityBackend val), PersistEntity val, MonadIO m) => Unique val -> ReaderT (PersistEntityBackend val) m (Entity val) getBy404 key = do mres <- getBy key case mres of Nothing -> notFound' Just res -> return res -- | 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