diff --git a/yesod-bin/HsFile.hs b/yesod-bin/HsFile.hs index 29095d85..3d9b64cb 100644 --- a/yesod-bin/HsFile.hs +++ b/yesod-bin/HsFile.hs @@ -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) diff --git a/yesod-bin/yesod-bin.cabal b/yesod-bin/yesod-bin.cabal index 2f553a06..3059c298 100644 --- a/yesod-bin/yesod-bin.cabal +++ b/yesod-bin/yesod-bin.cabal @@ -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 @@ -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 diff --git a/yesod-core/Yesod/Core/Handler.hs b/yesod-core/Yesod/Core/Handler.hs index 54b13650..e4413ab2 100644 --- a/yesod-core/Yesod/Core/Handler.hs +++ b/yesod-core/Yesod/Core/Handler.hs @@ -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 diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index 634c8cdf..6a423009 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.2.8 +version: 1.2.9 license: MIT license-file: LICENSE author: Michael Snoyman diff --git a/yesod-form/hello-forms.hs b/yesod-form/hello-forms.hs index eb766abc..f5838217 100644 --- a/yesod-form/hello-forms.hs +++ b/yesod-form/hello-forms.hs @@ -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 diff --git a/yesod-persistent/Yesod/Persist/Core.hs b/yesod-persistent/Yesod/Persist/Core.hs index d290107b..7f9b6b05 100644 --- a/yesod-persistent/Yesod/Persist/Core.hs +++ b/yesod-persistent/Yesod/Persist/Core.hs @@ -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) diff --git a/yesod-persistent/yesod-persistent.cabal b/yesod-persistent/yesod-persistent.cabal index 2e085849..3ad6cb9a 100644 --- a/yesod-persistent/yesod-persistent.cabal +++ b/yesod-persistent/yesod-persistent.cabal @@ -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 @@ -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 diff --git a/yesod-test/yesod-test.cabal b/yesod-test/yesod-test.cabal index dcc9a38c..76ab3a0b 100644 --- a/yesod-test/yesod-test.cabal +++ b/yesod-test/yesod-test.cabal @@ -1,5 +1,5 @@ name: yesod-test -version: 1.2.1 +version: 1.2.1.1 license: MIT license-file: LICENSE author: Nubis