From ddf64c1481346039e93fa217c169f563b0c03340 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Wed, 19 Mar 2014 19:52:17 -0300 Subject: [PATCH 1/6] Helper data type for redirecting with fragment identifiers. --- yesod-core/Yesod/Core/Handler.hs | 15 +++++++++++++++ 1 file changed, 15 insertions(+) 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 From 7e4ef60ae1af4bd2ba755e88c96f82eea67f4d03 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Thu, 20 Mar 2014 12:08:43 +0200 Subject: [PATCH 2/6] Drop filesystem-conduit dependency --- yesod-bin/HsFile.hs | 20 +++++++++++++++++--- yesod-bin/yesod-bin.cabal | 1 - 2 files changed, 17 insertions(+), 4 deletions(-) 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..41c24f7d 100644 --- a/yesod-bin/yesod-bin.cabal +++ b/yesod-bin/yesod-bin.cabal @@ -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 From 0774864877c4a8e87b375cf436f1e19787bea1ed Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Thu, 20 Mar 2014 12:08:52 +0200 Subject: [PATCH 3/6] Use pure in an example --- yesod-form/hello-forms.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) 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 From 971da29bad5b40b4de671f3533b9ce20e55d0ee5 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Thu, 20 Mar 2014 12:26:40 +0200 Subject: [PATCH 4/6] Version bumps --- yesod-bin/yesod-bin.cabal | 2 +- yesod-core/yesod-core.cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/yesod-bin/yesod-bin.cabal b/yesod-bin/yesod-bin.cabal index 41c24f7d..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 diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index 34070413..a31f3fcc 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 From aef99b44d83ea5246f60674bbe7acd74a7605fc8 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Thu, 20 Mar 2014 19:22:43 +0200 Subject: [PATCH 5/6] Remove unneeded dep --- yesod-test/yesod-test.cabal | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/yesod-test/yesod-test.cabal b/yesod-test/yesod-test.cabal index bd36697c..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 @@ -33,7 +33,6 @@ library , html-conduit >= 0.1 , blaze-html >= 0.5 , blaze-markup >= 0.5.1 - , pool-conduit , monad-control , time , blaze-builder From 6ef507e54fe46c27959d7cb363911a9799aab0fa Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Thu, 20 Mar 2014 20:37:39 +0200 Subject: [PATCH 6/6] Better implementation of defaultGetDBRunner --- yesod-persistent/Yesod/Persist/Core.hs | 34 ++++++++++++------------- yesod-persistent/yesod-persistent.cabal | 7 +++-- 2 files changed, 19 insertions(+), 22 deletions(-) diff --git a/yesod-persistent/Yesod/Persist/Core.hs b/yesod-persistent/Yesod/Persist/Core.hs index 1463fada..60b80cd0 100644 --- a/yesod-persistent/Yesod/Persist/Core.hs +++ b/yesod-persistent/Yesod/Persist/Core.hs @@ -25,8 +25,7 @@ import Control.Monad.Trans.Reader (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)) @@ -82,24 +81,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 e01786d2..d8c391b8 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