haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge remote-tracking branch 'origin/master' into persistent2-simpler-dispatch

Browse Source
This commit is contained in:
Michael Snoyman 2014-03-20 20:38:14 +02:00
commit 827b1d4bd2
8 changed files with 56 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
yesod-bin/HsFile.hs
View File

@ -2,17 +2,31 @@
module HsFile (mkHsFile) where
import Text.ProjectTemplate (createTemplate)
import Data.Conduit
( ($$), (=$), runResourceT, ResourceT, ConduitM, awaitForever, yield )
( ($$), (=$), runResourceT, ResourceT, ConduitM, awaitForever, yield, Source )
import qualified Data.Conduit.List as CL
import Data.Conduit.Filesystem (traverse, sourceFile)
import Prelude hiding (FilePath)
import Filesystem.Path ( FilePath )
import Filesystem.Path.CurrentOS ( encodeString )
import qualified Filesystem as F
import qualified Data.ByteString as BS
import Control.Monad.IO.Class (liftIO)
traverse :: FilePath -> Source (ResourceT IO) FilePath
traverse dir = do
liftIO (F.listDirectory dir) >>= mapM_ go
where
go fp = do
isFile' <- liftIO $ F.isFile fp
if isFile'
then yield fp
else do
isDir <- liftIO $ F.isDirectory fp
if isDir
then traverse fp
else return ()
mkHsFile :: IO ()
mkHsFile = runResourceT $ traverse False "."
mkHsFile = runResourceT $ traverse "."
$$ readIt
=$ createTemplate
=$ awaitForever (liftIO . BS.putStr)

3
yesod-bin/yesod-bin.cabal
View File

@ -1,5 +1,5 @@
name: yesod-bin
version: 1.2.7.2
version: 1.2.7.3
license: MIT
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>
@ -90,7 +90,6 @@ executable yesod
, warp >= 1.3.7.5
, wai >= 1.4
, data-default-class
, filesystem-conduit >= 1.0 && < 2.0
ghc-options: -Wall -threaded
main-is: main.hs

15
yesod-core/Yesod/Core/Handler.hs
View File

@ -9,6 +9,7 @@
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveDataTypeable #-}
---------------------------------------------------------
--
-- Module : Yesod.Handler
@ -74,6 +75,7 @@ module Yesod.Core.Handler
, redirect
, redirectWith
, redirectToPost
, Fragment(..)
-- ** Errors
, notFound
, badMethod
@ -188,6 +190,7 @@ import Data.Dynamic (fromDynamic, toDyn)
import qualified Data.IORef.Lifted as I
import Data.Maybe (listToMaybe, mapMaybe)
import Data.Typeable (Typeable, typeOf)
import Web.PathPieces (PathPiece(..))
import Yesod.Core.Class.Handler
import Yesod.Core.Types
import Yesod.Routes.Class (Route)
@ -758,6 +761,18 @@ instance (key ~ Text, val ~ Text) => RedirectUrl master (Route master, [(key, va
instance (key ~ Text, val ~ Text) => RedirectUrl master (Route master, Map.Map key val) where
toTextUrl (url, params) = toTextUrl (url, Map.toList params)
-- | Add a fragment identifier to a route to be used when
-- redirecting. For example:
--
-- > redirect (NewsfeedR :#: storyId)
--
-- Since 1.2.9.
data Fragment a b = a :#: b deriving (Show, Typeable)
instance (RedirectUrl master a, PathPiece b) => RedirectUrl master (Fragment a b) where
toTextUrl (a :#: b) = (\ua -> T.concat [ua, "#", toPathPiece b]) <$> toTextUrl a
-- | Lookup for session data.
lookupSession :: MonadHandler m => Text -> m (Maybe Text)
lookupSession = (liftM . fmap) (decodeUtf8With lenientDecode) . lookupSessionBS

2
yesod-core/yesod-core.cabal
View File

@ -1,5 +1,5 @@
name: yesod-core
version: 1.2.8
version: 1.2.9
license: MIT
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>

3
yesod-form/hello-forms.hs
View File

@ -23,7 +23,8 @@ mkYesod "HelloForms" [parseRoutes|
/file FileR GET POST
|]
myForm = fixType $ runFormGet $ renderDivs $ pure (,,,,,,,,,)
myForm = fixType $ runFormGet $ renderDivs $ pure (,,,,,,,,,,)
<*> pure "pure works!"
<*> areq boolField "Bool field" Nothing
<*> aopt boolField "Opt bool field" Nothing
<*> areq textField "Text field" Nothing

34
yesod-persistent/Yesod/Persist/Core.hs
View File

@ -28,8 +28,7 @@ import Control.Monad.Trans.Reader (ReaderT, runReaderT)
import Yesod.Core
import Data.Conduit
import Blaze.ByteString.Builder (Builder)
import Data.IORef.Lifted
import Data.Conduit.Pool
import Data.Pool
import Control.Monad.Trans.Resource
import Control.Exception (throwIO)
import Yesod.Core.Types (HandlerContents (HCError))
@ -103,24 +102,23 @@ defaultGetDBRunner :: YesodPersistBackend site ~ SqlPersistT
=> (site -> Pool SQL.Connection)
-> HandlerT site IO (DBRunner site, HandlerT site IO ())
defaultGetDBRunner getPool = do
ididSucceed <- newIORef False
pool <- fmap getPool getYesod
managedConn <- takeResource pool
let conn = mrValue managedConn
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 withPrep f = f conn (SQL.connPrepare conn)
(finishTransaction, ()) <- allocate (withPrep SQL.connBegin) $ \() -> do
didSucceed <- readIORef ididSucceed
withPrep $ if didSucceed
then SQL.connCommit
else SQL.connRollback
let cleanup = do
writeIORef ididSucceed True
release finishTransaction
mrReuse managedConn True
mrRelease managedConn
let cleanup = liftIO $ do
withPrep conn SQL.connCommit
putResource local conn
_ <- unprotect relKey
return ()
return (DBRunner $ \x -> runReaderT (unSqlPersistT x) conn, cleanup)

7
yesod-persistent/yesod-persistent.cabal
View File

@ -1,5 +1,5 @@
name: yesod-persistent
version: 1.2.2.1
version: 1.2.2.2
license: MIT
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>
@ -20,9 +20,8 @@ library
, transformers >= 0.2.2 && < 0.4
, blaze-builder
, conduit
, lifted-base
, pool-conduit
, resourcet
, resourcet >= 0.4.5
, resource-pool
exposed-modules: Yesod.Persist
Yesod.Persist.Core
ghc-options: -Wall

2
yesod-test/yesod-test.cabal
View File

@ -1,5 +1,5 @@
name: yesod-test
version: 1.2.1
version: 1.2.1.1
license: MIT
license-file: LICENSE
author: Nubis <nubis@woobiz.com.ar>