From 9cd6573ea7d03aa77826d32efc0d5bd7185d562a Mon Sep 17 00:00:00 2001 From: Anthony Burzillo Date: Sun, 11 Aug 2013 13:55:44 -0400 Subject: [PATCH 01/25] Remove uneeded whitespace from files created on init --- yesod-bin/hsfiles/mongo.hsfiles | 4 ++-- yesod-bin/hsfiles/mysql.hsfiles | 4 ++-- yesod-bin/hsfiles/postgres-fay.hsfiles | 4 ++-- yesod-bin/hsfiles/postgres.hsfiles | 4 ++-- yesod-bin/hsfiles/simple.hsfiles | 4 ++-- yesod-bin/hsfiles/sqlite.hsfiles | 4 ++-- 6 files changed, 12 insertions(+), 12 deletions(-) diff --git a/yesod-bin/hsfiles/mongo.hsfiles b/yesod-bin/hsfiles/mongo.hsfiles index d523d061..7586fdf6 100644 --- a/yesod-bin/hsfiles/mongo.hsfiles +++ b/yesod-bin/hsfiles/mongo.hsfiles @@ -5729,10 +5729,10 @@ $maybe msg <- mmsg
  • A Widget's Html, Css and Javascript are separated in three files with the # - \.hamlet, .lucius and .julius extensions. + \.hamlet, .lucius and .julius extensions.
  • If you had javascript enabled then you wouldn't be seeing this. - +
  • This is an example trivial Form. Read the # \Forms chapter # diff --git a/yesod-bin/hsfiles/mysql.hsfiles b/yesod-bin/hsfiles/mysql.hsfiles index f71ba69a..d8009cfe 100644 --- a/yesod-bin/hsfiles/mysql.hsfiles +++ b/yesod-bin/hsfiles/mysql.hsfiles @@ -5759,10 +5759,10 @@ $maybe msg <- mmsg
  • A Widget's Html, Css and Javascript are separated in three files with the # - \.hamlet, .lucius and .julius extensions. + \.hamlet, .lucius and .julius extensions.
  • If you had javascript enabled then you wouldn't be seeing this. - +
  • This is an example trivial Form. Read the # \Forms chapter # diff --git a/yesod-bin/hsfiles/postgres-fay.hsfiles b/yesod-bin/hsfiles/postgres-fay.hsfiles index 15dea3bf..a732e3ab 100644 --- a/yesod-bin/hsfiles/postgres-fay.hsfiles +++ b/yesod-bin/hsfiles/postgres-fay.hsfiles @@ -5840,10 +5840,10 @@ $maybe msg <- mmsg
  • A Widget's Html, Css and Javascript are separated in three files with the # - \.hamlet, .lucius and .julius extensions. + \.hamlet, .lucius and .julius extensions.
  • If you had javascript enabled then you wouldn't be seeing this. - +
  • This is an example trivial Form. Read the # \Forms chapter # diff --git a/yesod-bin/hsfiles/postgres.hsfiles b/yesod-bin/hsfiles/postgres.hsfiles index 81355918..c1f773d7 100644 --- a/yesod-bin/hsfiles/postgres.hsfiles +++ b/yesod-bin/hsfiles/postgres.hsfiles @@ -5733,10 +5733,10 @@ $maybe msg <- mmsg
  • A Widget's Html, Css and Javascript are separated in three files with the # - \.hamlet, .lucius and .julius extensions. + \.hamlet, .lucius and .julius extensions.
  • If you had javascript enabled then you wouldn't be seeing this. - +
  • This is an example trivial Form. Read the # \Forms chapter # diff --git a/yesod-bin/hsfiles/simple.hsfiles b/yesod-bin/hsfiles/simple.hsfiles index 1c452855..6ae4d11c 100644 --- a/yesod-bin/hsfiles/simple.hsfiles +++ b/yesod-bin/hsfiles/simple.hsfiles @@ -5610,10 +5610,10 @@ $maybe msg <- mmsg
  • A Widget's Html, Css and Javascript are separated in three files with the # - \.hamlet, .lucius and .julius extensions. + \.hamlet, .lucius and .julius extensions.
  • If you had javascript enabled then you wouldn't be seeing this. - +
  • This is an example trivial Form. Read the # \Forms chapter # diff --git a/yesod-bin/hsfiles/sqlite.hsfiles b/yesod-bin/hsfiles/sqlite.hsfiles index 961133fc..5889d322 100644 --- a/yesod-bin/hsfiles/sqlite.hsfiles +++ b/yesod-bin/hsfiles/sqlite.hsfiles @@ -5729,10 +5729,10 @@ $maybe msg <- mmsg
  • A Widget's Html, Css and Javascript are separated in three files with the # - \.hamlet, .lucius and .julius extensions. + \.hamlet, .lucius and .julius extensions.
  • If you had javascript enabled then you wouldn't be seeing this. - +
  • This is an example trivial Form. Read the # \Forms chapter # From fc8b126e9e0a400d68f51a35c1e0ffc77fcbb082 Mon Sep 17 00:00:00 2001 From: Alexander Date: Sun, 8 Jun 2014 15:20:27 +1200 Subject: [PATCH 02/25] Typo fix --- yesod-websockets/Yesod/WebSockets.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/yesod-websockets/Yesod/WebSockets.hs b/yesod-websockets/Yesod/WebSockets.hs index eebe9202..c42c3251 100644 --- a/yesod-websockets/Yesod/WebSockets.hs +++ b/yesod-websockets/Yesod/WebSockets.hs @@ -61,13 +61,13 @@ webSockets inner = do receiveData :: (MonadIO m, WS.WebSocketsData a) => WebSocketsT m a receiveData = ReaderT $ liftIO . WS.receiveData --- | Send a textual messsage to the client. +-- | Send a textual message to the client. -- -- Since 0.1.0 sendTextData :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m () sendTextData x = ReaderT $ liftIO . flip WS.sendTextData x --- | Send a binary messsage to the client. +-- | Send a binary message to the client. -- -- Since 0.1.0 sendBinaryData :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m () From bfe0b2867a8e7b437ef8aabdbe5f88e10cd67411 Mon Sep 17 00:00:00 2001 From: Axel Angel Date: Thu, 12 Jun 2014 17:10:04 +0200 Subject: [PATCH 03/25] Adapt generateFormGet to follow the post variant (deprecate non-prime) To stay backward compatible, we fix this in generateFormGet' From discussion: https://groups.google.com/forum/#!topic/yesodweb/lWKFzJDOnnY --- yesod-form/Yesod/Form/Functions.hs | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/yesod-form/Yesod/Form/Functions.hs b/yesod-form/Yesod/Form/Functions.hs index d84633ea..4bac7efc 100644 --- a/yesod-form/Yesod/Form/Functions.hs +++ b/yesod-form/Yesod/Form/Functions.hs @@ -23,6 +23,7 @@ module Yesod.Form.Functions , runFormGet -- * Generate a blank form , generateFormPost + , generateFormGet' , generateFormGet -- * More than one form on a handler , identifyForm @@ -269,6 +270,14 @@ runFormGet form = do Just _ -> Just (Map.unionsWith (++) $ map (\(x, y) -> Map.singleton x [y]) gets, Map.empty) getHelper form env +{- FIXME: generateFormGet' "Will be renamed to generateFormGet in next verison of Yesod" -} +generateFormGet' + :: (RenderMessage (HandlerSite m) FormMessage, MonadHandler m) + => (Html -> MForm m (FormResult a, xml)) + -> m (xml, Enctype) +generateFormGet' form = first snd `liftM` getHelper form Nothing + +{-# DEPRECATED generateFormGet "Will require RenderMessage in next verison of Yesod" #-} generateFormGet :: MonadHandler m => (Html -> MForm m a) -> m (a, Enctype) From a4137461e32c2963f41c20e242420bc04d9b205e Mon Sep 17 00:00:00 2001 From: Alexander Date: Mon, 16 Jun 2014 15:43:17 +1200 Subject: [PATCH 04/25] Update README --- yesod-core/README | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/yesod-core/README b/yesod-core/README index 987fd1b3..fd05b7a5 100644 --- a/yesod-core/README +++ b/yesod-core/README @@ -1 +1 @@ -Learn more at http://docs.yesodweb.com/ +Learn more at http://www.yesodweb.com/ From 28c366a3b31c0533938554b5ee6f1b8d884280da Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Mon, 16 Jun 2014 09:00:27 +0300 Subject: [PATCH 05/25] Add back conduit 1.0 support #757 --- yesod-auth/Yesod/Auth/GoogleEmail2.hs | 16 +++++++++++----- yesod-auth/yesod-auth.cabal | 2 +- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/yesod-auth/Yesod/Auth/GoogleEmail2.hs b/yesod-auth/Yesod/Auth/GoogleEmail2.hs index 1f53dfa1..bfe3d897 100644 --- a/yesod-auth/Yesod/Auth/GoogleEmail2.hs +++ b/yesod-auth/Yesod/Auth/GoogleEmail2.hs @@ -53,9 +53,10 @@ import qualified Yesod.Auth.Message as Msg import Yesod.Core (HandlerSite, MonadHandler, getRouteToParent, getUrlRender, getYesod, invalidArgs, lift, - liftBase, lookupGetParam, + lookupGetParam, lookupSession, notFound, redirect, - setSession, whamlet, (.:)) + setSession, whamlet, (.:), + TypedContent, HandlerT, liftIO) pid :: Text pid = "googleemail2" @@ -75,7 +76,7 @@ getCreateCsrfToken = do case mtoken of Just token -> return token Nothing -> do - stdgen <- liftBase newStdGen + stdgen <- liftIO newStdGen let token = T.pack $ fst $ randomString 10 stdgen setSession csrfKey token return token @@ -111,6 +112,11 @@ authGoogleEmail clientID clientSecret = login tm = do url <- getDest tm [whamlet|_{Msg.LoginGoogle}|] + + dispatch :: YesodAuth site + => Text + -> [Text] + -> HandlerT Auth (HandlerT site IO) TypedContent dispatch "GET" ["forward"] = do tm <- getRouteToParent lift (getDest tm) >>= redirect @@ -130,7 +136,7 @@ authGoogleEmail clientID clientSecret = render <- getUrlRender - req' <- parseUrl "https://accounts.google.com/o/oauth2/token" -- FIXME don't hardcode, use: https://accounts.google.com/.well-known/openid-configuration + req' <- liftIO $ parseUrl "https://accounts.google.com/o/oauth2/token" -- FIXME don't hardcode, use: https://accounts.google.com/.well-known/openid-configuration let req = urlEncodedBody [ ("code", encodeUtf8 code) @@ -152,7 +158,7 @@ authGoogleEmail clientID clientSecret = unless (tokenType == "Bearer") $ error $ "Unknown token type: " ++ show tokenType - req2' <- parseUrl "https://www.googleapis.com/plus/v1/people/me" + req2' <- liftIO $ parseUrl "https://www.googleapis.com/plus/v1/people/me" let req2 = req2' { requestHeaders = [ ("Authorization", encodeUtf8 $ "Bearer " `mappend` accessToken) diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal index 906c08bb..cc39b15c 100644 --- a/yesod-auth/yesod-auth.cabal +++ b/yesod-auth/yesod-auth.cabal @@ -1,5 +1,5 @@ name: yesod-auth -version: 1.3.1 +version: 1.3.1.1 license: MIT license-file: LICENSE author: Michael Snoyman, Patrick Brisbin From 382a5402c829e2397c3dfaeac21b87f20efff986 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Tue, 17 Jun 2014 08:04:28 +0300 Subject: [PATCH 06/25] yesod-auth 1.3, authenticate-oauth 1.5 --- yesod-auth-oauth/Yesod/Auth/OAuth.hs | 4 +++- yesod-auth-oauth/yesod-auth-oauth.cabal | 10 +++++----- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/yesod-auth-oauth/Yesod/Auth/OAuth.hs b/yesod-auth-oauth/Yesod/Auth/OAuth.hs index fa7f1c76..4839a356 100644 --- a/yesod-auth-oauth/Yesod/Auth/OAuth.hs +++ b/yesod-auth-oauth/Yesod/Auth/OAuth.hs @@ -43,6 +43,7 @@ authOAuth oauth mkCreds = AuthPlugin name dispatch login url = PluginR name [] lookupTokenSecret = bsToText . fromMaybe "" . lookup "oauth_token_secret" . unCredential oauthSessionName = "__oauth_token_secret" + dispatch "GET" ["forward"] = do render <- lift getUrlRender tm <- getRouteToParent @@ -72,8 +73,9 @@ authOAuth oauth mkCreds = AuthPlugin name dispatch login master <- getYesod accTok <- getAccessToken oauth reqTok (authHttpManager master) creds <- liftIO $ mkCreds accTok - setCreds True creds + setCredsRedirect creds dispatch _ _ = notFound + login tm = do render <- getUrlRender let oaUrl = render $ tm $ oauthUrl name diff --git a/yesod-auth-oauth/yesod-auth-oauth.cabal b/yesod-auth-oauth/yesod-auth-oauth.cabal index a3e89f30..dff15167 100644 --- a/yesod-auth-oauth/yesod-auth-oauth.cabal +++ b/yesod-auth-oauth/yesod-auth-oauth.cabal @@ -1,5 +1,5 @@ name: yesod-auth-oauth -version: 1.2.0 +version: 1.3.0 license: BSD3 license-file: LICENSE author: Hiromi Ishii @@ -20,13 +20,13 @@ library cpp-options: -DGHC7 else build-depends: base >= 4 && < 4.3 - build-depends: authenticate-oauth >= 1.4 && < 1.5 + build-depends: authenticate-oauth >= 1.5 && < 1.6 , bytestring >= 0.9.1.4 , yesod-core >= 1.2 && < 1.3 - , yesod-auth >= 1.2 && < 1.3 - , text >= 0.7 && < 1.1 + , yesod-auth >= 1.3 && < 1.4 + , text >= 0.7 , yesod-form >= 1.3 && < 1.4 - , transformers >= 0.2.2 && < 0.4 + , transformers >= 0.2.2 && < 0.5 , lifted-base >= 0.2 && < 0.3 exposed-modules: Yesod.Auth.OAuth ghc-options: -Wall From ef25c90e9b7d9d432e43cd2e55533a7092155176 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Tue, 17 Jun 2014 08:22:34 +0300 Subject: [PATCH 07/25] Handle labels containing inputs #759 --- yesod-test/Yesod/Test.hs | 11 +++++++---- yesod-test/test/main.hs | 11 +++++++++++ yesod-test/yesod-test.cabal | 2 +- 3 files changed, 19 insertions(+), 5 deletions(-) diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index c51f6894..1301797d 100644 --- a/yesod-test/Yesod/Test.hs +++ b/yesod-test/Yesod/Test.hs @@ -421,10 +421,10 @@ nameFromLabel label = do Just res -> return res let body = simpleBody res - mfor = parseHTML body + mlabel = parseHTML body $// C.element "label" >=> contentContains label - >=> attribute "for" + mfor = mlabel >>= attribute "for" contentContains x c | x `T.isInfixOf` T.concat (c $// content) = [c] @@ -444,8 +444,11 @@ nameFromLabel label = do , " which was not found. " ] name:_ -> return name - _ -> failure $ "More than one input with id " <> for - [] -> failure $ "No label contained: " <> label + [] -> failure $ "No input with id " <> for + [] -> + case filter (/= "") $ mlabel >>= (child >=> C.element "input" >=> attribute "name") of + [] -> failure $ "No label contained: " <> label + name:_ -> return name _ -> failure $ "More than one label contained " <> label (<>) :: T.Text -> T.Text -> T.Text diff --git a/yesod-test/test/main.hs b/yesod-test/test/main.hs index 5e509c09..f53583dc 100644 --- a/yesod-test/test/main.hs +++ b/yesod-test/test/main.hs @@ -132,6 +132,14 @@ main = hspec $ do get ("/dynamic2/שלום" :: Text) statusIs 200 bodyEquals "שלום" + + ydescribe "labels" $ do + yit "can click checkbox" $ do + get ("/labels" :: Text) + request $ do + setMethod "POST" + setUrl ("/labels" :: Text) + byLabel "Foo Bar" "yes" describe "cookies" $ yesodSpec cookieApp $ do yit "should send the cookie #730" $ do get ("/" :: Text) @@ -174,6 +182,9 @@ app = liteApp $ do onStatic "html" $ dispatchTo $ return ("Hello

    Hello World

    Hello Moon

    " :: Text) + onStatic "labels" $ dispatchTo $ + return ("" :: Text) + cookieApp :: LiteApp cookieApp = liteApp $ do diff --git a/yesod-test/yesod-test.cabal b/yesod-test/yesod-test.cabal index acf1426e..db8d469c 100644 --- a/yesod-test/yesod-test.cabal +++ b/yesod-test/yesod-test.cabal @@ -1,5 +1,5 @@ name: yesod-test -version: 1.2.3 +version: 1.2.3.1 license: MIT license-file: LICENSE author: Nubis From 9a583e5af3b56a8dadcb31b7d0e18ce9c18063f2 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Wed, 18 Jun 2014 06:59:23 +0300 Subject: [PATCH 08/25] Version bumps --- yesod-bin/yesod-bin.cabal | 2 +- yesod-form/Yesod/Form/Functions.hs | 3 +++ yesod-form/yesod-form.cabal | 2 +- yesod-websockets/yesod-websockets.cabal | 2 +- 4 files changed, 6 insertions(+), 3 deletions(-) diff --git a/yesod-bin/yesod-bin.cabal b/yesod-bin/yesod-bin.cabal index 7b9408a9..c9fc372b 100644 --- a/yesod-bin/yesod-bin.cabal +++ b/yesod-bin/yesod-bin.cabal @@ -1,5 +1,5 @@ name: yesod-bin -version: 1.2.10.2 +version: 1.2.10.3 license: MIT license-file: LICENSE author: Michael Snoyman diff --git a/yesod-form/Yesod/Form/Functions.hs b/yesod-form/Yesod/Form/Functions.hs index 4bac7efc..bdf16c66 100644 --- a/yesod-form/Yesod/Form/Functions.hs +++ b/yesod-form/Yesod/Form/Functions.hs @@ -271,6 +271,9 @@ runFormGet form = do getHelper form env {- FIXME: generateFormGet' "Will be renamed to generateFormGet in next verison of Yesod" -} +-- | +-- +-- Since 1.3.11 generateFormGet' :: (RenderMessage (HandlerSite m) FormMessage, MonadHandler m) => (Html -> MForm m (FormResult a, xml)) diff --git a/yesod-form/yesod-form.cabal b/yesod-form/yesod-form.cabal index 5cd59647..b7fff339 100644 --- a/yesod-form/yesod-form.cabal +++ b/yesod-form/yesod-form.cabal @@ -1,5 +1,5 @@ name: yesod-form -version: 1.3.10 +version: 1.3.11 license: MIT license-file: LICENSE author: Michael Snoyman diff --git a/yesod-websockets/yesod-websockets.cabal b/yesod-websockets/yesod-websockets.cabal index 8708bba2..9e1d0acb 100644 --- a/yesod-websockets/yesod-websockets.cabal +++ b/yesod-websockets/yesod-websockets.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: yesod-websockets -version: 0.1.1.1 +version: 0.1.1.2 synopsis: WebSockets support for Yesod description: WebSockets support for Yesod homepage: https://github.com/yesodweb/yesod From ecd5d7618108faa9e3ec0bc390567ed624dcbbfd Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Wed, 18 Jun 2014 07:56:15 +0300 Subject: [PATCH 09/25] Scaffolding update --- yesod-bin/hsfiles/mongo.hsfiles | 68 ++++++++++++++++++++++++++ yesod-bin/hsfiles/mysql.hsfiles | 68 ++++++++++++++++++++++++++ yesod-bin/hsfiles/postgres-fay.hsfiles | 68 ++++++++++++++++++++++++++ yesod-bin/hsfiles/postgres.hsfiles | 68 ++++++++++++++++++++++++++ yesod-bin/hsfiles/simple.hsfiles | 68 ++++++++++++++++++++++++++ yesod-bin/hsfiles/sqlite.hsfiles | 68 ++++++++++++++++++++++++++ 6 files changed, 408 insertions(+) diff --git a/yesod-bin/hsfiles/mongo.hsfiles b/yesod-bin/hsfiles/mongo.hsfiles index fd63bda9..455c4171 100644 --- a/yesod-bin/hsfiles/mongo.hsfiles +++ b/yesod-bin/hsfiles/mongo.hsfiles @@ -1,5 +1,12 @@ +{-# START_FILE .dir-locals.el #-} +((haskell-mode . ((haskell-indent-spaces . 4) + (haskell-process-use-ghci . t))) + (hamlet-mode . ((hamlet/basic-offset . 4) + (haskell-process-use-ghci . t)))) + {-# START_FILE .ghci #-} :set -i.:config:dist/build/autogen +:set -DDEVELOPMENT :set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable {-# START_FILE .gitignore #-} @@ -594,6 +601,67 @@ combineStylesheets = combineStylesheets' development combineSettings combineScripts :: Name -> [Route Static] -> Q Exp combineScripts = combineScripts' development combineSettings +{-# START_FILE app/DevelMain.hs #-} +-- | Development version to be run inside GHCi. +-- +-- start this up with: +-- +-- cabal repl --ghc-options="-O0 -fobject-code" +-- +-- You will need to add these packages to your .cabal file +-- * foreign-store (very light-weight) +-- * warp (you already depend on this, it just isn't in your .cabal file) +-- +-- If you don't use cabal repl, you will need +-- to run the following in GHCi or to add it to +-- your .ghci file. +-- +-- :set -DDEVELOPMENT +-- +-- There is more information about this approach, +-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci + +module DevelMain where + +import Application (getApplicationDev) + +import Control.Exception (finally) +import Control.Concurrent +import Data.IORef +import Foreign.Store +import Network.Wai.Handler.Warp + +-- | Start or restart the server. +update :: IO () +update = do + mtidStore <- lookupStore tid_1 + case mtidStore of + Nothing -> do + done <- newEmptyMVar + _done_0 <- newStore done + tid <- start done + tidRef <- newIORef tid + _tid_1 <- newStore tidRef + return () + Just tidStore -> do + tidRef <- readStore tidStore + tid <- readIORef tidRef + done <- readStore (Store done_0) + killThread tid + takeMVar done + newTid <- start done + writeIORef tidRef newTid + where tid_1 = 1 + done_0 = 0 + +-- | Start the server in a separate thread. +start :: MVar () -- ^ Written to when the thread is killed. + -> IO ThreadId +start done = do + (port,app) <- getApplicationDev + forkIO (finally (runSettings (setPort port defaultSettings) app) + (putMVar done ())) + {-# START_FILE app/main.hs #-} import Prelude (IO) import Yesod.Default.Config (fromArgs) diff --git a/yesod-bin/hsfiles/mysql.hsfiles b/yesod-bin/hsfiles/mysql.hsfiles index 613142ec..30eafe13 100644 --- a/yesod-bin/hsfiles/mysql.hsfiles +++ b/yesod-bin/hsfiles/mysql.hsfiles @@ -1,5 +1,12 @@ +{-# START_FILE .dir-locals.el #-} +((haskell-mode . ((haskell-indent-spaces . 4) + (haskell-process-use-ghci . t))) + (hamlet-mode . ((hamlet/basic-offset . 4) + (haskell-process-use-ghci . t)))) + {-# START_FILE .ghci #-} :set -i.:config:dist/build/autogen +:set -DDEVELOPMENT :set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable {-# START_FILE .gitignore #-} @@ -598,6 +605,67 @@ combineStylesheets = combineStylesheets' development combineSettings combineScripts :: Name -> [Route Static] -> Q Exp combineScripts = combineScripts' development combineSettings +{-# START_FILE app/DevelMain.hs #-} +-- | Development version to be run inside GHCi. +-- +-- start this up with: +-- +-- cabal repl --ghc-options="-O0 -fobject-code" +-- +-- You will need to add these packages to your .cabal file +-- * foreign-store (very light-weight) +-- * warp (you already depend on this, it just isn't in your .cabal file) +-- +-- If you don't use cabal repl, you will need +-- to run the following in GHCi or to add it to +-- your .ghci file. +-- +-- :set -DDEVELOPMENT +-- +-- There is more information about this approach, +-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci + +module DevelMain where + +import Application (getApplicationDev) + +import Control.Exception (finally) +import Control.Concurrent +import Data.IORef +import Foreign.Store +import Network.Wai.Handler.Warp + +-- | Start or restart the server. +update :: IO () +update = do + mtidStore <- lookupStore tid_1 + case mtidStore of + Nothing -> do + done <- newEmptyMVar + _done_0 <- newStore done + tid <- start done + tidRef <- newIORef tid + _tid_1 <- newStore tidRef + return () + Just tidStore -> do + tidRef <- readStore tidStore + tid <- readIORef tidRef + done <- readStore (Store done_0) + killThread tid + takeMVar done + newTid <- start done + writeIORef tidRef newTid + where tid_1 = 1 + done_0 = 0 + +-- | Start the server in a separate thread. +start :: MVar () -- ^ Written to when the thread is killed. + -> IO ThreadId +start done = do + (port,app) <- getApplicationDev + forkIO (finally (runSettings (setPort port defaultSettings) app) + (putMVar done ())) + {-# START_FILE app/main.hs #-} import Prelude (IO) import Yesod.Default.Config (fromArgs) diff --git a/yesod-bin/hsfiles/postgres-fay.hsfiles b/yesod-bin/hsfiles/postgres-fay.hsfiles index 6ae1cf2d..287a4212 100644 --- a/yesod-bin/hsfiles/postgres-fay.hsfiles +++ b/yesod-bin/hsfiles/postgres-fay.hsfiles @@ -1,5 +1,12 @@ +{-# START_FILE .dir-locals.el #-} +((haskell-mode . ((haskell-indent-spaces . 4) + (haskell-process-use-ghci . t))) + (hamlet-mode . ((hamlet/basic-offset . 4) + (haskell-process-use-ghci . t)))) + {-# START_FILE .ghci #-} :set -i.:config:dist/build/autogen +:set -DDEVELOPMENT :set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable {-# START_FILE .gitignore #-} @@ -647,6 +654,67 @@ combineStylesheets = combineStylesheets' development combineSettings combineScripts :: Name -> [Route Static] -> Q Exp combineScripts = combineScripts' development combineSettings +{-# START_FILE app/DevelMain.hs #-} +-- | Development version to be run inside GHCi. +-- +-- start this up with: +-- +-- cabal repl --ghc-options="-O0 -fobject-code" +-- +-- You will need to add these packages to your .cabal file +-- * foreign-store (very light-weight) +-- * warp (you already depend on this, it just isn't in your .cabal file) +-- +-- If you don't use cabal repl, you will need +-- to run the following in GHCi or to add it to +-- your .ghci file. +-- +-- :set -DDEVELOPMENT +-- +-- There is more information about this approach, +-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci + +module DevelMain where + +import Application (getApplicationDev) + +import Control.Exception (finally) +import Control.Concurrent +import Data.IORef +import Foreign.Store +import Network.Wai.Handler.Warp + +-- | Start or restart the server. +update :: IO () +update = do + mtidStore <- lookupStore tid_1 + case mtidStore of + Nothing -> do + done <- newEmptyMVar + _done_0 <- newStore done + tid <- start done + tidRef <- newIORef tid + _tid_1 <- newStore tidRef + return () + Just tidStore -> do + tidRef <- readStore tidStore + tid <- readIORef tidRef + done <- readStore (Store done_0) + killThread tid + takeMVar done + newTid <- start done + writeIORef tidRef newTid + where tid_1 = 1 + done_0 = 0 + +-- | Start the server in a separate thread. +start :: MVar () -- ^ Written to when the thread is killed. + -> IO ThreadId +start done = do + (port,app) <- getApplicationDev + forkIO (finally (runSettings (setPort port defaultSettings) app) + (putMVar done ())) + {-# START_FILE app/main.hs #-} import Prelude (IO) import Yesod.Default.Config (fromArgs) diff --git a/yesod-bin/hsfiles/postgres.hsfiles b/yesod-bin/hsfiles/postgres.hsfiles index 47214641..e6482c6f 100644 --- a/yesod-bin/hsfiles/postgres.hsfiles +++ b/yesod-bin/hsfiles/postgres.hsfiles @@ -1,5 +1,12 @@ +{-# START_FILE .dir-locals.el #-} +((haskell-mode . ((haskell-indent-spaces . 4) + (haskell-process-use-ghci . t))) + (hamlet-mode . ((hamlet/basic-offset . 4) + (haskell-process-use-ghci . t)))) + {-# START_FILE .ghci #-} :set -i.:config:dist/build/autogen +:set -DDEVELOPMENT :set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable {-# START_FILE .gitignore #-} @@ -598,6 +605,67 @@ combineStylesheets = combineStylesheets' development combineSettings combineScripts :: Name -> [Route Static] -> Q Exp combineScripts = combineScripts' development combineSettings +{-# START_FILE app/DevelMain.hs #-} +-- | Development version to be run inside GHCi. +-- +-- start this up with: +-- +-- cabal repl --ghc-options="-O0 -fobject-code" +-- +-- You will need to add these packages to your .cabal file +-- * foreign-store (very light-weight) +-- * warp (you already depend on this, it just isn't in your .cabal file) +-- +-- If you don't use cabal repl, you will need +-- to run the following in GHCi or to add it to +-- your .ghci file. +-- +-- :set -DDEVELOPMENT +-- +-- There is more information about this approach, +-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci + +module DevelMain where + +import Application (getApplicationDev) + +import Control.Exception (finally) +import Control.Concurrent +import Data.IORef +import Foreign.Store +import Network.Wai.Handler.Warp + +-- | Start or restart the server. +update :: IO () +update = do + mtidStore <- lookupStore tid_1 + case mtidStore of + Nothing -> do + done <- newEmptyMVar + _done_0 <- newStore done + tid <- start done + tidRef <- newIORef tid + _tid_1 <- newStore tidRef + return () + Just tidStore -> do + tidRef <- readStore tidStore + tid <- readIORef tidRef + done <- readStore (Store done_0) + killThread tid + takeMVar done + newTid <- start done + writeIORef tidRef newTid + where tid_1 = 1 + done_0 = 0 + +-- | Start the server in a separate thread. +start :: MVar () -- ^ Written to when the thread is killed. + -> IO ThreadId +start done = do + (port,app) <- getApplicationDev + forkIO (finally (runSettings (setPort port defaultSettings) app) + (putMVar done ())) + {-# START_FILE app/main.hs #-} import Prelude (IO) import Yesod.Default.Config (fromArgs) diff --git a/yesod-bin/hsfiles/simple.hsfiles b/yesod-bin/hsfiles/simple.hsfiles index 65150af4..d49118b5 100644 --- a/yesod-bin/hsfiles/simple.hsfiles +++ b/yesod-bin/hsfiles/simple.hsfiles @@ -1,5 +1,12 @@ +{-# START_FILE .dir-locals.el #-} +((haskell-mode . ((haskell-indent-spaces . 4) + (haskell-process-use-ghci . t))) + (hamlet-mode . ((hamlet/basic-offset . 4) + (haskell-process-use-ghci . t)))) + {-# START_FILE .ghci #-} :set -i.:config:dist/build/autogen +:set -DDEVELOPMENT :set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable {-# START_FILE .gitignore #-} @@ -517,6 +524,67 @@ combineStylesheets = combineStylesheets' development combineSettings combineScripts :: Name -> [Route Static] -> Q Exp combineScripts = combineScripts' development combineSettings +{-# START_FILE app/DevelMain.hs #-} +-- | Development version to be run inside GHCi. +-- +-- start this up with: +-- +-- cabal repl --ghc-options="-O0 -fobject-code" +-- +-- You will need to add these packages to your .cabal file +-- * foreign-store (very light-weight) +-- * warp (you already depend on this, it just isn't in your .cabal file) +-- +-- If you don't use cabal repl, you will need +-- to run the following in GHCi or to add it to +-- your .ghci file. +-- +-- :set -DDEVELOPMENT +-- +-- There is more information about this approach, +-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci + +module DevelMain where + +import Application (getApplicationDev) + +import Control.Exception (finally) +import Control.Concurrent +import Data.IORef +import Foreign.Store +import Network.Wai.Handler.Warp + +-- | Start or restart the server. +update :: IO () +update = do + mtidStore <- lookupStore tid_1 + case mtidStore of + Nothing -> do + done <- newEmptyMVar + _done_0 <- newStore done + tid <- start done + tidRef <- newIORef tid + _tid_1 <- newStore tidRef + return () + Just tidStore -> do + tidRef <- readStore tidStore + tid <- readIORef tidRef + done <- readStore (Store done_0) + killThread tid + takeMVar done + newTid <- start done + writeIORef tidRef newTid + where tid_1 = 1 + done_0 = 0 + +-- | Start the server in a separate thread. +start :: MVar () -- ^ Written to when the thread is killed. + -> IO ThreadId +start done = do + (port,app) <- getApplicationDev + forkIO (finally (runSettings (setPort port defaultSettings) app) + (putMVar done ())) + {-# START_FILE app/main.hs #-} import Prelude (IO) import Yesod.Default.Config (fromArgs) diff --git a/yesod-bin/hsfiles/sqlite.hsfiles b/yesod-bin/hsfiles/sqlite.hsfiles index 9c57415e..d314c06a 100644 --- a/yesod-bin/hsfiles/sqlite.hsfiles +++ b/yesod-bin/hsfiles/sqlite.hsfiles @@ -1,5 +1,12 @@ +{-# START_FILE .dir-locals.el #-} +((haskell-mode . ((haskell-indent-spaces . 4) + (haskell-process-use-ghci . t))) + (hamlet-mode . ((hamlet/basic-offset . 4) + (haskell-process-use-ghci . t)))) + {-# START_FILE .ghci #-} :set -i.:config:dist/build/autogen +:set -DDEVELOPMENT :set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable {-# START_FILE .gitignore #-} @@ -598,6 +605,67 @@ combineStylesheets = combineStylesheets' development combineSettings combineScripts :: Name -> [Route Static] -> Q Exp combineScripts = combineScripts' development combineSettings +{-# START_FILE app/DevelMain.hs #-} +-- | Development version to be run inside GHCi. +-- +-- start this up with: +-- +-- cabal repl --ghc-options="-O0 -fobject-code" +-- +-- You will need to add these packages to your .cabal file +-- * foreign-store (very light-weight) +-- * warp (you already depend on this, it just isn't in your .cabal file) +-- +-- If you don't use cabal repl, you will need +-- to run the following in GHCi or to add it to +-- your .ghci file. +-- +-- :set -DDEVELOPMENT +-- +-- There is more information about this approach, +-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci + +module DevelMain where + +import Application (getApplicationDev) + +import Control.Exception (finally) +import Control.Concurrent +import Data.IORef +import Foreign.Store +import Network.Wai.Handler.Warp + +-- | Start or restart the server. +update :: IO () +update = do + mtidStore <- lookupStore tid_1 + case mtidStore of + Nothing -> do + done <- newEmptyMVar + _done_0 <- newStore done + tid <- start done + tidRef <- newIORef tid + _tid_1 <- newStore tidRef + return () + Just tidStore -> do + tidRef <- readStore tidStore + tid <- readIORef tidRef + done <- readStore (Store done_0) + killThread tid + takeMVar done + newTid <- start done + writeIORef tidRef newTid + where tid_1 = 1 + done_0 = 0 + +-- | Start the server in a separate thread. +start :: MVar () -- ^ Written to when the thread is killed. + -> IO ThreadId +start done = do + (port,app) <- getApplicationDev + forkIO (finally (runSettings (setPort port defaultSettings) app) + (putMVar done ())) + {-# START_FILE app/main.hs #-} import Prelude (IO) import Yesod.Default.Config (fromArgs) From 27b3cb58bb0ceb6661b58ea75fdad570dd373855 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Wed, 18 Jun 2014 08:01:45 +0300 Subject: [PATCH 10/25] Upstream yesod-scaffold changes for #761 --- yesod-bin/hsfiles/mongo.hsfiles | 1 + 1 file changed, 1 insertion(+) diff --git a/yesod-bin/hsfiles/mongo.hsfiles b/yesod-bin/hsfiles/mongo.hsfiles index 455c4171..a802792a 100644 --- a/yesod-bin/hsfiles/mongo.hsfiles +++ b/yesod-bin/hsfiles/mongo.hsfiles @@ -358,6 +358,7 @@ import Database.Persist.Quasi import Database.Persist.MongoDB hiding (master) import Language.Haskell.TH.Syntax import Data.Typeable (Typeable) +import Prelude -- You can define all of your database entities in the entities file. -- You can find more information on persistent and how to declare entities From 268c68a544501089f8da3d94c2b81ac4869ce6c9 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Wed, 18 Jun 2014 08:02:36 +0300 Subject: [PATCH 11/25] Version bump --- yesod-bin/yesod-bin.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/yesod-bin/yesod-bin.cabal b/yesod-bin/yesod-bin.cabal index c9fc372b..2a346157 100644 --- a/yesod-bin/yesod-bin.cabal +++ b/yesod-bin/yesod-bin.cabal @@ -1,5 +1,5 @@ name: yesod-bin -version: 1.2.10.3 +version: 1.2.11 license: MIT license-file: LICENSE author: Michael Snoyman From 4858f0837bf0bbe8ea71fb1da19a94122493bddf Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Wed, 18 Jun 2014 19:51:27 +0300 Subject: [PATCH 12/25] Attributes can be set on parent routes #762 --- yesod-routes/Yesod/Routes/Parse.hs | 30 ++++++++++++++++++++++++++++-- yesod-routes/test/Hierarchy.hs | 9 +++++++-- yesod-routes/yesod-routes.cabal | 2 +- 3 files changed, 36 insertions(+), 5 deletions(-) diff --git a/yesod-routes/Yesod/Routes/Parse.hs b/yesod-routes/Yesod/Routes/Parse.hs index 361ec8a5..f230e7ff 100644 --- a/yesod-routes/Yesod/Routes/Parse.hs +++ b/yesod-routes/Yesod/Routes/Parse.hs @@ -1,5 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE PatternGuards #-} {-# OPTIONS_GHC -fno-warn-missing-fields #-} -- QuasiQuoter module Yesod.Routes.Parse ( parseRoutes @@ -67,14 +68,30 @@ resourcesFromString = | length spaces < indent = ([], thisLine : otherLines) | otherwise = (this others, remainder) where + parseAttr ('!':x) = Just x + parseAttr _ = Nothing + + stripColonLast = + go id + where + go _ [] = Nothing + go front [x] + | null x = Nothing + | last x == ':' = Just $ front [init x] + | otherwise = Nothing + go front (x:xs) = go (front . (x:)) xs + spaces = takeWhile (== ' ') thisLine (others, remainder) = parse indent otherLines' (this, otherLines') = case takeWhile (/= "--") $ words thisLine of - [pattern, constr] | last constr == ':' -> + (pattern:rest0) + | Just (constr:rest) <- stripColonLast rest0 + , Just attrs <- mapM parseAttr rest -> let (children, otherLines'') = parse (length spaces + 1) otherLines + children' = addAttrs attrs children (pieces, Nothing) = piecesFromString $ drop1Slash pattern - in ((ResourceParent (init constr) pieces children :), otherLines'') + in ((ResourceParent constr pieces children' :), otherLines'') (pattern:constr:rest) -> let (pieces, mmulti) = piecesFromString $ drop1Slash pattern (attrs, rest') = takeAttrs rest @@ -83,6 +100,15 @@ resourcesFromString = [] -> (id, otherLines) _ -> error $ "Invalid resource line: " ++ thisLine +addAttrs :: [String] -> [ResourceTree String] -> [ResourceTree String] +addAttrs attrs = + map goTree + where + goTree (ResourceLeaf res) = ResourceLeaf (goRes res) + goTree (ResourceParent x y z) = ResourceParent x y (map goTree z) + + goRes res = res { resourceAttrs = attrs ++ resourceAttrs res } + -- | Take attributes out of the list and put them in the first slot in the -- result tuple. takeAttrs :: [String] -> ([String], [String]) diff --git a/yesod-routes/test/Hierarchy.hs b/yesod-routes/test/Hierarchy.hs index c3c786c8..9bcd796a 100644 --- a/yesod-routes/test/Hierarchy.hs +++ b/yesod-routes/test/Hierarchy.hs @@ -27,6 +27,7 @@ import qualified Yesod.Routes.Class as YRC import Data.Text (Text, pack, unpack, append) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as S8 +import qualified Data.Set as Set class ToText a where toText :: a -> Text @@ -84,9 +85,9 @@ do /login LoginR GET POST /table/#Text TableR GET -/nest/ NestR: +/nest/ NestR !NestingAttr: - /spaces SpacedR GET + /spaces SpacedR GET !NonNested /nest2 Nest2: / GetPostR GET POST @@ -107,6 +108,7 @@ do |] rrinst <- mkRenderRouteInstance (ConT ''Hierarchy) $ map (fmap parseType) resources + rainst <- mkRouteAttrsInstance (ConT ''Hierarchy) $ map (fmap parseType) resources prinst <- mkParseRouteInstance (ConT ''Hierarchy) $ map (fmap parseType) resources dispatch <- mkDispatchClause MkDispatchSettings { mdsRunHandler = [|runHandler|] @@ -126,6 +128,7 @@ do `AppT` ConT ''Hierarchy) [FunD (mkName "dispatcher") [dispatch]] : prinst + : rainst : rrinst getSpacedR :: Handler site String @@ -199,3 +202,5 @@ hierarchy = describe "hierarchy" $ do parseRoute ([], [("foo", "bar")]) @?= Just HomeR parseRoute (["admin", "5"], []) @?= Just (AdminR 5 AdminRootR) parseRoute (["admin!", "5"], []) @?= (Nothing :: Maybe (Route Hierarchy)) + it "inherited attributes" $ do + routeAttrs (NestR SpacedR) @?= Set.fromList ["NestingAttr", "NonNested"] diff --git a/yesod-routes/yesod-routes.cabal b/yesod-routes/yesod-routes.cabal index 65b1511a..878a4f11 100644 --- a/yesod-routes/yesod-routes.cabal +++ b/yesod-routes/yesod-routes.cabal @@ -1,5 +1,5 @@ name: yesod-routes -version: 1.2.0.6 +version: 1.2.0.7 license: MIT license-file: LICENSE author: Michael Snoyman From 4c31714a251ad4f656bb58fb4a2f0b6612747e74 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Tue, 24 Jun 2014 08:46:08 +0300 Subject: [PATCH 13/25] Special support for key-value pairs in route attributes #762 --- yesod-routes/Yesod/Routes/Parse.hs | 18 +++++++++++++++++- yesod-routes/test/Hierarchy.hs | 6 ++++-- 2 files changed, 21 insertions(+), 3 deletions(-) diff --git a/yesod-routes/Yesod/Routes/Parse.hs b/yesod-routes/Yesod/Routes/Parse.hs index f230e7ff..d71afef1 100644 --- a/yesod-routes/Yesod/Routes/Parse.hs +++ b/yesod-routes/Yesod/Routes/Parse.hs @@ -19,6 +19,8 @@ import qualified System.IO as SIO import Yesod.Routes.TH import Yesod.Routes.Overlap (findOverlapNames) import Data.List (foldl') +import Data.Maybe (mapMaybe) +import qualified Data.Set as Set -- | A quasi-quoter to parse a string into a list of 'Resource's. Checks for -- overlapping routes, failing if present; use 'parseRoutesNoCheck' to skip the @@ -107,7 +109,21 @@ addAttrs attrs = goTree (ResourceLeaf res) = ResourceLeaf (goRes res) goTree (ResourceParent x y z) = ResourceParent x y (map goTree z) - goRes res = res { resourceAttrs = attrs ++ resourceAttrs res } + goRes res = + res { resourceAttrs = noDupes ++ resourceAttrs res } + where + usedKeys = Set.fromList $ map fst $ mapMaybe toPair $ resourceAttrs res + used attr = + case toPair attr of + Nothing -> False + Just (key, _) -> key `Set.member` usedKeys + noDupes = filter (not . used) attrs + + toPair s = + case break (== '=') s of + (x, '=':y) -> Just (x, y) + _ -> Nothing + -- | Take attributes out of the list and put them in the first slot in the -- result tuple. diff --git a/yesod-routes/test/Hierarchy.hs b/yesod-routes/test/Hierarchy.hs index 9bcd796a..dfd2d871 100644 --- a/yesod-routes/test/Hierarchy.hs +++ b/yesod-routes/test/Hierarchy.hs @@ -99,8 +99,8 @@ do /post Post3 POST -- /#Int Delete3 DELETE -/afterwards AfterR: - / After GET +/afterwards AfterR !parent !key=value1: + / After GET !child !key=value2 -- /trailing-nest TrailingNestR: -- /foo TrailingFooR GET @@ -204,3 +204,5 @@ hierarchy = describe "hierarchy" $ do parseRoute (["admin!", "5"], []) @?= (Nothing :: Maybe (Route Hierarchy)) it "inherited attributes" $ do routeAttrs (NestR SpacedR) @?= Set.fromList ["NestingAttr", "NonNested"] + it "pair attributes" $ + routeAttrs (AfterR After) @?= Set.fromList ["parent", "child", "key=value2"] From bc8d01511078be45e99b154c1e4f13b740e1f22b Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Sat, 28 Jun 2014 08:56:11 -0400 Subject: [PATCH 14/25] Add feed functions to generate feeds with external links Rather than requiring a Route, these functions can accept Text URLs and just use id to render them. --- yesod-newsfeed/Yesod/AtomFeed.hs | 6 ++++++ yesod-newsfeed/Yesod/Feed.hs | 8 ++++++++ yesod-newsfeed/Yesod/RssFeed.hs | 6 ++++++ 3 files changed, 20 insertions(+) diff --git a/yesod-newsfeed/Yesod/AtomFeed.hs b/yesod-newsfeed/Yesod/AtomFeed.hs index 95c03c92..26b500cf 100644 --- a/yesod-newsfeed/Yesod/AtomFeed.hs +++ b/yesod-newsfeed/Yesod/AtomFeed.hs @@ -20,6 +20,7 @@ -- | Generation of Atom newsfeeds. module Yesod.AtomFeed ( atomFeed + , atomFeedText , atomLink , RepAtom (..) , module Yesod.FeedTypes @@ -47,6 +48,11 @@ atomFeed feed = do render <- getUrlRender return $ RepAtom $ toContent $ renderLBS def $ template feed render +-- | Same as @'atomFeed'@ but for @'Feed Text'@. Useful for cases where you are +-- generating a feed of external links. +atomFeedText :: MonadHandler m => Feed Text -> m RepAtom +atomFeedText feed = return $ RepAtom $ toContent $ renderLBS def $ template feed id + template :: Feed url -> (url -> Text) -> Document template Feed {..} render = Document (Prologue [] Nothing []) (addNS root) [] diff --git a/yesod-newsfeed/Yesod/Feed.hs b/yesod-newsfeed/Yesod/Feed.hs index 0dcd2b09..3af91575 100644 --- a/yesod-newsfeed/Yesod/Feed.hs +++ b/yesod-newsfeed/Yesod/Feed.hs @@ -17,6 +17,7 @@ ------------------------------------------------------------------------------- module Yesod.Feed ( newsFeed + , newsFeedText , module Yesod.FeedTypes ) where @@ -29,3 +30,10 @@ newsFeed :: MonadHandler m => Feed (Route (HandlerSite m)) -> m TypedContent newsFeed f = selectRep $ do provideRep $ atomFeed f provideRep $ rssFeed f + +-- | Same as @'newsFeed'@ but for @'Feed Text'@. Useful for cases where you are +-- generating a feed of external links. +newsFeedText :: MonadHandler m => Feed Text -> m TypedContent +newsFeedText f = selectRep $ do + provideRep $ atomFeedText f + provideRep $ rssFeedText f diff --git a/yesod-newsfeed/Yesod/RssFeed.hs b/yesod-newsfeed/Yesod/RssFeed.hs index 8243b4a1..05155fca 100644 --- a/yesod-newsfeed/Yesod/RssFeed.hs +++ b/yesod-newsfeed/Yesod/RssFeed.hs @@ -16,6 +16,7 @@ ------------------------------------------------------------------------------- module Yesod.RssFeed ( rssFeed + , rssFeedText , rssLink , RepRss (..) , module Yesod.FeedTypes @@ -44,6 +45,11 @@ rssFeed feed = do render <- getUrlRender return $ RepRss $ toContent $ renderLBS def $ template feed render +-- | Same as @'rssFeed'@ but for @'Feed Text'@. Useful for cases where you are +-- generating a feed of external links. +rssFeedText :: MonadHandler m => Feed Text -> m RepRss +rssFeedText feed = return $ RepRss $ toContent $ renderLBS def $ template feed id + template :: Feed url -> (url -> Text) -> Document template Feed {..} render = Document (Prologue [] Nothing []) root [] From 3e100451d4712e6e8c9f665e5e187aa70702cf87 Mon Sep 17 00:00:00 2001 From: Anthony Burzillo Date: Sun, 6 Jul 2014 23:21:46 -0400 Subject: [PATCH 15/25] Fix import error --- yesod-newsfeed/Yesod/Feed.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/yesod-newsfeed/Yesod/Feed.hs b/yesod-newsfeed/Yesod/Feed.hs index 3af91575..1601cff4 100644 --- a/yesod-newsfeed/Yesod/Feed.hs +++ b/yesod-newsfeed/Yesod/Feed.hs @@ -26,6 +26,8 @@ import Yesod.AtomFeed import Yesod.RssFeed import Yesod.Core +import Data.Text + newsFeed :: MonadHandler m => Feed (Route (HandlerSite m)) -> m TypedContent newsFeed f = selectRep $ do provideRep $ atomFeed f From 54a4417f54157f63443f1dddce1d9bb14c2d193e Mon Sep 17 00:00:00 2001 From: Anthony Burzillo Date: Sun, 6 Jul 2014 23:25:17 -0400 Subject: [PATCH 16/25] Add color to "Build failure" warning --- yesod-bin/Devel.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/yesod-bin/Devel.hs b/yesod-bin/Devel.hs index ccd4c358..77f34286 100644 --- a/yesod-bin/Devel.hs +++ b/yesod-bin/Devel.hs @@ -266,7 +266,7 @@ devel opts passThroughArgs = withSocketsDo $ withManager $ \manager -> do unless (anyTouched || haskellFileChanged) $ loop list1 if not success then liftIO $ do - putStrLn "Build failure, pausing..." + putStrLn "\x1b[1;31mBuild failure, pausing...\x1b[0m" runBuildHook $ failHook opts else do liftIO $ runBuildHook $ successHook opts From f6d06ef3909763a33713a82501dc05062ab2a285 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Thu, 10 Jul 2014 08:46:16 +0300 Subject: [PATCH 17/25] HostPreference conflict #769 --- yesod/Yesod/Default/Config.hs | 2 +- yesod/yesod.cabal | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/yesod/Yesod/Default/Config.hs b/yesod/Yesod/Default/Config.hs index b256cc2a..dba3889d 100644 --- a/yesod/Yesod/Default/Config.hs +++ b/yesod/Yesod/Default/Config.hs @@ -23,7 +23,7 @@ import Data.Maybe (fromMaybe) import qualified Data.HashMap.Strict as M import System.Environment (getArgs, getProgName, getEnvironment) import System.Exit (exitFailure) -import Data.Conduit.Network (HostPreference) +import Data.Streaming.Network (HostPreference) import Data.String (fromString) -- | A yesod-provided @'AppEnv'@, allows for Development, Testing, and diff --git a/yesod/yesod.cabal b/yesod/yesod.cabal index d2282c2e..54a5bf7d 100644 --- a/yesod/yesod.cabal +++ b/yesod/yesod.cabal @@ -1,5 +1,5 @@ name: yesod -version: 1.2.6 +version: 1.2.6.1 license: MIT license-file: LICENSE author: Michael Snoyman @@ -50,6 +50,7 @@ library , fast-logger , conduit-extra , shakespeare + , streaming-commons exposed-modules: Yesod , Yesod.Default.Config From feee2d7de8f7e5b66f8604965216e455c655bd1d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Crist=C3=B3v=C3=A3o?= Date: Mon, 14 Jul 2014 10:57:54 +0100 Subject: [PATCH 18/25] requireAuthId does not need YesodAuthPersist master --- yesod-auth/Yesod/Auth.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/yesod-auth/Yesod/Auth.hs b/yesod-auth/Yesod/Auth.hs index d5f5d166..535137b4 100644 --- a/yesod-auth/Yesod/Auth.hs +++ b/yesod-auth/Yesod/Auth.hs @@ -56,7 +56,6 @@ import Data.Monoid (Endo) import Network.HTTP.Conduit (Manager) import qualified Network.Wai as W -import Text.Hamlet (shamlet) import Yesod.Core import Yesod.Persist @@ -419,7 +418,7 @@ type AuthEntity master = KeyEntity (AuthId master) -- authenticated. -- -- Since 1.1.0 -requireAuthId :: YesodAuthPersist master => HandlerT master IO (AuthId master) +requireAuthId :: YesodAuth master => HandlerT master IO (AuthId master) requireAuthId = maybeAuthId >>= maybe redirectLogin return -- | Similar to 'maybeAuth', but redirects to a login page if user is not From bc933bbefb3533ed687635daa7ab2e4c20b088f7 Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Tue, 15 Jul 2014 18:12:16 +1000 Subject: [PATCH 19/25] yesod-bin/Keter.hs : Use System.Process instead of System.Cmd. System.Cmd is deprecated. --- yesod-bin/Keter.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/yesod-bin/Keter.hs b/yesod-bin/Keter.hs index 8093d6f0..1a7192a4 100644 --- a/yesod-bin/Keter.hs +++ b/yesod-bin/Keter.hs @@ -7,7 +7,7 @@ import Data.Yaml import qualified Data.HashMap.Strict as Map import qualified Data.Text as T import System.Exit -import System.Cmd +import System.Process import Control.Monad import System.Directory import Data.Maybe (mapMaybe) From 47456762004bbdc6a8345b9790510db559375bef Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Tue, 15 Jul 2014 18:14:42 +1000 Subject: [PATCH 20/25] yesod-bin/Scaffolding/Scaffolder.hs : Remove un-used variable. --- yesod-bin/Scaffolding/Scaffolder.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/yesod-bin/Scaffolding/Scaffolder.hs b/yesod-bin/Scaffolding/Scaffolder.hs index e3a69faa..6bdfedb8 100644 --- a/yesod-bin/Scaffolding/Scaffolder.hs +++ b/yesod-bin/Scaffolding/Scaffolder.hs @@ -73,7 +73,6 @@ scaffold isBare = do if validPackageName s && s /= "test" then Just s else Nothing - let dir = project puts $ renderTextUrl undefined $(textFile "input/database.cg") From 972efd0ca4bbb0fa891bef6738298bd3fe4e5441 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Tue, 15 Jul 2014 19:06:27 +0300 Subject: [PATCH 21/25] Scaffold update --- yesod-bin/hsfiles/mongo.hsfiles | 53 ++++++++++++++++--------- yesod-bin/hsfiles/mysql.hsfiles | 54 +++++++++++++++++--------- yesod-bin/hsfiles/postgres-fay.hsfiles | 54 +++++++++++++++++--------- yesod-bin/hsfiles/postgres.hsfiles | 54 +++++++++++++++++--------- yesod-bin/hsfiles/simple.hsfiles | 53 ++++++++++++++++--------- yesod-bin/hsfiles/sqlite.hsfiles | 54 +++++++++++++++++--------- 6 files changed, 208 insertions(+), 114 deletions(-) diff --git a/yesod-bin/hsfiles/mongo.hsfiles b/yesod-bin/hsfiles/mongo.hsfiles index a802792a..ed261fe2 100644 --- a/yesod-bin/hsfiles/mongo.hsfiles +++ b/yesod-bin/hsfiles/mongo.hsfiles @@ -211,6 +211,13 @@ instance Yesod App where -- The page to be redirected to when authentication is required. authRoute _ = Just $ AuthR LoginR + -- Routes not requiring authenitcation. + isAuthorized (AuthR _) _ = return Authorized + isAuthorized FaviconR _ = return Authorized + isAuthorized RobotsR _ = return Authorized + -- Default to Authorized for now. + isAuthorized _ _ = return Authorized + -- This function creates static content files in the static folder -- and names them based on a hash of their content. This allows -- expiration dates to be set far in the future without worry of @@ -609,17 +616,21 @@ combineScripts = combineScripts' development combineSettings -- -- cabal repl --ghc-options="-O0 -fobject-code" -- +-- run with: +-- +-- :l DevelMain +-- DevelMain.update +-- -- You will need to add these packages to your .cabal file --- * foreign-store (very light-weight) +-- * foreign-store >= 0.1 (very light-weight) -- * warp (you already depend on this, it just isn't in your .cabal file) -- -- If you don't use cabal repl, you will need --- to run the following in GHCi or to add it to --- your .ghci file. +-- to add settings to your .ghci file. -- -- :set -DDEVELOPMENT -- --- There is more information about this approach, +-- There is more information about using ghci -- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci module DevelMain where @@ -633,27 +644,31 @@ import Foreign.Store import Network.Wai.Handler.Warp -- | Start or restart the server. +-- A Store holds onto some data across ghci reloads update :: IO () update = do - mtidStore <- lookupStore tid_1 + mtidStore <- lookupStore tidStoreNum case mtidStore of + -- no server running Nothing -> do - done <- newEmptyMVar - _done_0 <- newStore done + done <- storeAction doneStore newEmptyMVar tid <- start done - tidRef <- newIORef tid - _tid_1 <- newStore tidRef + _ <- storeAction (Store tidStoreNum) (newIORef tid) return () - Just tidStore -> do - tidRef <- readStore tidStore - tid <- readIORef tidRef - done <- readStore (Store done_0) - killThread tid - takeMVar done - newTid <- start done - writeIORef tidRef newTid - where tid_1 = 1 - done_0 = 0 + -- server is already running + Just tidStore -> + -- shut the server down with killThread and wait for the done signal + modifyStoredIORef tidStore $ \tid -> do + killThread tid + withStore doneStore takeMVar >> readStore doneStore >>= start + where + doneStore = Store 0 + tidStoreNum = 1 + + modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () + modifyStoredIORef store f = withStore store $ \ref -> do + v <- readIORef ref + f v >>= writeIORef ref -- | Start the server in a separate thread. start :: MVar () -- ^ Written to when the thread is killed. diff --git a/yesod-bin/hsfiles/mysql.hsfiles b/yesod-bin/hsfiles/mysql.hsfiles index 30eafe13..9d6b7b9a 100644 --- a/yesod-bin/hsfiles/mysql.hsfiles +++ b/yesod-bin/hsfiles/mysql.hsfiles @@ -218,6 +218,13 @@ instance Yesod App where -- The page to be redirected to when authentication is required. authRoute _ = Just $ AuthR LoginR + -- Routes not requiring authenitcation. + isAuthorized (AuthR _) _ = return Authorized + isAuthorized FaviconR _ = return Authorized + isAuthorized RobotsR _ = return Authorized + -- Default to Authorized for now. + isAuthorized _ _ = return Authorized + -- This function creates static content files in the static folder -- and names them based on a hash of their content. This allows -- expiration dates to be set far in the future without worry of @@ -365,6 +372,7 @@ import Yesod import Data.Text (Text) import Database.Persist.Quasi import Data.Typeable (Typeable) +import Prelude -- You can define all of your database entities in the entities file. -- You can find more information on persistent and how to declare entities @@ -612,17 +620,21 @@ combineScripts = combineScripts' development combineSettings -- -- cabal repl --ghc-options="-O0 -fobject-code" -- +-- run with: +-- +-- :l DevelMain +-- DevelMain.update +-- -- You will need to add these packages to your .cabal file --- * foreign-store (very light-weight) +-- * foreign-store >= 0.1 (very light-weight) -- * warp (you already depend on this, it just isn't in your .cabal file) -- -- If you don't use cabal repl, you will need --- to run the following in GHCi or to add it to --- your .ghci file. +-- to add settings to your .ghci file. -- -- :set -DDEVELOPMENT -- --- There is more information about this approach, +-- There is more information about using ghci -- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci module DevelMain where @@ -636,27 +648,31 @@ import Foreign.Store import Network.Wai.Handler.Warp -- | Start or restart the server. +-- A Store holds onto some data across ghci reloads update :: IO () update = do - mtidStore <- lookupStore tid_1 + mtidStore <- lookupStore tidStoreNum case mtidStore of + -- no server running Nothing -> do - done <- newEmptyMVar - _done_0 <- newStore done + done <- storeAction doneStore newEmptyMVar tid <- start done - tidRef <- newIORef tid - _tid_1 <- newStore tidRef + _ <- storeAction (Store tidStoreNum) (newIORef tid) return () - Just tidStore -> do - tidRef <- readStore tidStore - tid <- readIORef tidRef - done <- readStore (Store done_0) - killThread tid - takeMVar done - newTid <- start done - writeIORef tidRef newTid - where tid_1 = 1 - done_0 = 0 + -- server is already running + Just tidStore -> + -- shut the server down with killThread and wait for the done signal + modifyStoredIORef tidStore $ \tid -> do + killThread tid + withStore doneStore takeMVar >> readStore doneStore >>= start + where + doneStore = Store 0 + tidStoreNum = 1 + + modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () + modifyStoredIORef store f = withStore store $ \ref -> do + v <- readIORef ref + f v >>= writeIORef ref -- | Start the server in a separate thread. start :: MVar () -- ^ Written to when the thread is killed. diff --git a/yesod-bin/hsfiles/postgres-fay.hsfiles b/yesod-bin/hsfiles/postgres-fay.hsfiles index 287a4212..64387842 100644 --- a/yesod-bin/hsfiles/postgres-fay.hsfiles +++ b/yesod-bin/hsfiles/postgres-fay.hsfiles @@ -222,6 +222,13 @@ instance Yesod App where -- The page to be redirected to when authentication is required. authRoute _ = Just $ AuthR LoginR + -- Routes not requiring authenitcation. + isAuthorized (AuthR _) _ = return Authorized + isAuthorized FaviconR _ = return Authorized + isAuthorized RobotsR _ = return Authorized + -- Default to Authorized for now. + isAuthorized _ _ = return Authorized + -- This function creates static content files in the static folder -- and names them based on a hash of their content. This allows -- expiration dates to be set far in the future without worry of @@ -397,6 +404,7 @@ import Yesod import Data.Text (Text) import Database.Persist.Quasi import Data.Typeable (Typeable) +import Prelude -- You can define all of your database entities in the entities file. -- You can find more information on persistent and how to declare entities @@ -661,17 +669,21 @@ combineScripts = combineScripts' development combineSettings -- -- cabal repl --ghc-options="-O0 -fobject-code" -- +-- run with: +-- +-- :l DevelMain +-- DevelMain.update +-- -- You will need to add these packages to your .cabal file --- * foreign-store (very light-weight) +-- * foreign-store >= 0.1 (very light-weight) -- * warp (you already depend on this, it just isn't in your .cabal file) -- -- If you don't use cabal repl, you will need --- to run the following in GHCi or to add it to --- your .ghci file. +-- to add settings to your .ghci file. -- -- :set -DDEVELOPMENT -- --- There is more information about this approach, +-- There is more information about using ghci -- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci module DevelMain where @@ -685,27 +697,31 @@ import Foreign.Store import Network.Wai.Handler.Warp -- | Start or restart the server. +-- A Store holds onto some data across ghci reloads update :: IO () update = do - mtidStore <- lookupStore tid_1 + mtidStore <- lookupStore tidStoreNum case mtidStore of + -- no server running Nothing -> do - done <- newEmptyMVar - _done_0 <- newStore done + done <- storeAction doneStore newEmptyMVar tid <- start done - tidRef <- newIORef tid - _tid_1 <- newStore tidRef + _ <- storeAction (Store tidStoreNum) (newIORef tid) return () - Just tidStore -> do - tidRef <- readStore tidStore - tid <- readIORef tidRef - done <- readStore (Store done_0) - killThread tid - takeMVar done - newTid <- start done - writeIORef tidRef newTid - where tid_1 = 1 - done_0 = 0 + -- server is already running + Just tidStore -> + -- shut the server down with killThread and wait for the done signal + modifyStoredIORef tidStore $ \tid -> do + killThread tid + withStore doneStore takeMVar >> readStore doneStore >>= start + where + doneStore = Store 0 + tidStoreNum = 1 + + modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () + modifyStoredIORef store f = withStore store $ \ref -> do + v <- readIORef ref + f v >>= writeIORef ref -- | Start the server in a separate thread. start :: MVar () -- ^ Written to when the thread is killed. diff --git a/yesod-bin/hsfiles/postgres.hsfiles b/yesod-bin/hsfiles/postgres.hsfiles index e6482c6f..5ea0d5fb 100644 --- a/yesod-bin/hsfiles/postgres.hsfiles +++ b/yesod-bin/hsfiles/postgres.hsfiles @@ -218,6 +218,13 @@ instance Yesod App where -- The page to be redirected to when authentication is required. authRoute _ = Just $ AuthR LoginR + -- Routes not requiring authenitcation. + isAuthorized (AuthR _) _ = return Authorized + isAuthorized FaviconR _ = return Authorized + isAuthorized RobotsR _ = return Authorized + -- Default to Authorized for now. + isAuthorized _ _ = return Authorized + -- This function creates static content files in the static folder -- and names them based on a hash of their content. This allows -- expiration dates to be set far in the future without worry of @@ -365,6 +372,7 @@ import Yesod import Data.Text (Text) import Database.Persist.Quasi import Data.Typeable (Typeable) +import Prelude -- You can define all of your database entities in the entities file. -- You can find more information on persistent and how to declare entities @@ -612,17 +620,21 @@ combineScripts = combineScripts' development combineSettings -- -- cabal repl --ghc-options="-O0 -fobject-code" -- +-- run with: +-- +-- :l DevelMain +-- DevelMain.update +-- -- You will need to add these packages to your .cabal file --- * foreign-store (very light-weight) +-- * foreign-store >= 0.1 (very light-weight) -- * warp (you already depend on this, it just isn't in your .cabal file) -- -- If you don't use cabal repl, you will need --- to run the following in GHCi or to add it to --- your .ghci file. +-- to add settings to your .ghci file. -- -- :set -DDEVELOPMENT -- --- There is more information about this approach, +-- There is more information about using ghci -- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci module DevelMain where @@ -636,27 +648,31 @@ import Foreign.Store import Network.Wai.Handler.Warp -- | Start or restart the server. +-- A Store holds onto some data across ghci reloads update :: IO () update = do - mtidStore <- lookupStore tid_1 + mtidStore <- lookupStore tidStoreNum case mtidStore of + -- no server running Nothing -> do - done <- newEmptyMVar - _done_0 <- newStore done + done <- storeAction doneStore newEmptyMVar tid <- start done - tidRef <- newIORef tid - _tid_1 <- newStore tidRef + _ <- storeAction (Store tidStoreNum) (newIORef tid) return () - Just tidStore -> do - tidRef <- readStore tidStore - tid <- readIORef tidRef - done <- readStore (Store done_0) - killThread tid - takeMVar done - newTid <- start done - writeIORef tidRef newTid - where tid_1 = 1 - done_0 = 0 + -- server is already running + Just tidStore -> + -- shut the server down with killThread and wait for the done signal + modifyStoredIORef tidStore $ \tid -> do + killThread tid + withStore doneStore takeMVar >> readStore doneStore >>= start + where + doneStore = Store 0 + tidStoreNum = 1 + + modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () + modifyStoredIORef store f = withStore store $ \ref -> do + v <- readIORef ref + f v >>= writeIORef ref -- | Start the server in a separate thread. start :: MVar () -- ^ Written to when the thread is killed. diff --git a/yesod-bin/hsfiles/simple.hsfiles b/yesod-bin/hsfiles/simple.hsfiles index d49118b5..11a3e6f6 100644 --- a/yesod-bin/hsfiles/simple.hsfiles +++ b/yesod-bin/hsfiles/simple.hsfiles @@ -196,6 +196,13 @@ instance Yesod App where Just $ uncurry (joinPath y (Settings.staticRoot $ settings y)) $ renderRoute s urlRenderOverride _ _ = Nothing + -- Routes not requiring authenitcation. + isAuthorized (AuthR _) _ = return Authorized + isAuthorized FaviconR _ = return Authorized + isAuthorized RobotsR _ = return Authorized + -- Default to Authorized for now. + isAuthorized _ _ = return Authorized + -- This function creates static content files in the static folder -- and names them based on a hash of their content. This allows -- expiration dates to be set far in the future without worry of @@ -531,17 +538,21 @@ combineScripts = combineScripts' development combineSettings -- -- cabal repl --ghc-options="-O0 -fobject-code" -- +-- run with: +-- +-- :l DevelMain +-- DevelMain.update +-- -- You will need to add these packages to your .cabal file --- * foreign-store (very light-weight) +-- * foreign-store >= 0.1 (very light-weight) -- * warp (you already depend on this, it just isn't in your .cabal file) -- -- If you don't use cabal repl, you will need --- to run the following in GHCi or to add it to --- your .ghci file. +-- to add settings to your .ghci file. -- -- :set -DDEVELOPMENT -- --- There is more information about this approach, +-- There is more information about using ghci -- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci module DevelMain where @@ -555,27 +566,31 @@ import Foreign.Store import Network.Wai.Handler.Warp -- | Start or restart the server. +-- A Store holds onto some data across ghci reloads update :: IO () update = do - mtidStore <- lookupStore tid_1 + mtidStore <- lookupStore tidStoreNum case mtidStore of + -- no server running Nothing -> do - done <- newEmptyMVar - _done_0 <- newStore done + done <- storeAction doneStore newEmptyMVar tid <- start done - tidRef <- newIORef tid - _tid_1 <- newStore tidRef + _ <- storeAction (Store tidStoreNum) (newIORef tid) return () - Just tidStore -> do - tidRef <- readStore tidStore - tid <- readIORef tidRef - done <- readStore (Store done_0) - killThread tid - takeMVar done - newTid <- start done - writeIORef tidRef newTid - where tid_1 = 1 - done_0 = 0 + -- server is already running + Just tidStore -> + -- shut the server down with killThread and wait for the done signal + modifyStoredIORef tidStore $ \tid -> do + killThread tid + withStore doneStore takeMVar >> readStore doneStore >>= start + where + doneStore = Store 0 + tidStoreNum = 1 + + modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () + modifyStoredIORef store f = withStore store $ \ref -> do + v <- readIORef ref + f v >>= writeIORef ref -- | Start the server in a separate thread. start :: MVar () -- ^ Written to when the thread is killed. diff --git a/yesod-bin/hsfiles/sqlite.hsfiles b/yesod-bin/hsfiles/sqlite.hsfiles index d314c06a..30436df7 100644 --- a/yesod-bin/hsfiles/sqlite.hsfiles +++ b/yesod-bin/hsfiles/sqlite.hsfiles @@ -218,6 +218,13 @@ instance Yesod App where -- The page to be redirected to when authentication is required. authRoute _ = Just $ AuthR LoginR + -- Routes not requiring authenitcation. + isAuthorized (AuthR _) _ = return Authorized + isAuthorized FaviconR _ = return Authorized + isAuthorized RobotsR _ = return Authorized + -- Default to Authorized for now. + isAuthorized _ _ = return Authorized + -- This function creates static content files in the static folder -- and names them based on a hash of their content. This allows -- expiration dates to be set far in the future without worry of @@ -365,6 +372,7 @@ import Yesod import Data.Text (Text) import Database.Persist.Quasi import Data.Typeable (Typeable) +import Prelude -- You can define all of your database entities in the entities file. -- You can find more information on persistent and how to declare entities @@ -612,17 +620,21 @@ combineScripts = combineScripts' development combineSettings -- -- cabal repl --ghc-options="-O0 -fobject-code" -- +-- run with: +-- +-- :l DevelMain +-- DevelMain.update +-- -- You will need to add these packages to your .cabal file --- * foreign-store (very light-weight) +-- * foreign-store >= 0.1 (very light-weight) -- * warp (you already depend on this, it just isn't in your .cabal file) -- -- If you don't use cabal repl, you will need --- to run the following in GHCi or to add it to --- your .ghci file. +-- to add settings to your .ghci file. -- -- :set -DDEVELOPMENT -- --- There is more information about this approach, +-- There is more information about using ghci -- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci module DevelMain where @@ -636,27 +648,31 @@ import Foreign.Store import Network.Wai.Handler.Warp -- | Start or restart the server. +-- A Store holds onto some data across ghci reloads update :: IO () update = do - mtidStore <- lookupStore tid_1 + mtidStore <- lookupStore tidStoreNum case mtidStore of + -- no server running Nothing -> do - done <- newEmptyMVar - _done_0 <- newStore done + done <- storeAction doneStore newEmptyMVar tid <- start done - tidRef <- newIORef tid - _tid_1 <- newStore tidRef + _ <- storeAction (Store tidStoreNum) (newIORef tid) return () - Just tidStore -> do - tidRef <- readStore tidStore - tid <- readIORef tidRef - done <- readStore (Store done_0) - killThread tid - takeMVar done - newTid <- start done - writeIORef tidRef newTid - where tid_1 = 1 - done_0 = 0 + -- server is already running + Just tidStore -> + -- shut the server down with killThread and wait for the done signal + modifyStoredIORef tidStore $ \tid -> do + killThread tid + withStore doneStore takeMVar >> readStore doneStore >>= start + where + doneStore = Store 0 + tidStoreNum = 1 + + modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () + modifyStoredIORef store f = withStore store $ \ref -> do + v <- readIORef ref + f v >>= writeIORef ref -- | Start the server in a separate thread. start :: MVar () -- ^ Written to when the thread is killed. From 2d54a5df1360858f6cbbcf45c51511805db39658 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Thu, 24 Jul 2014 10:21:06 +0300 Subject: [PATCH 22/25] Don't ignore leftovers in parsing #780 --- yesod-form/Yesod/Form/Fields.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs index c4170f5b..e305bcce 100644 --- a/yesod-form/Yesod/Form/Fields.hs +++ b/yesod-form/Yesod/Form/Fields.hs @@ -233,7 +233,7 @@ $newline never } readMay :: Read a => String -> Maybe a -readMay s = case reads s of +readMay s = case filter (null . snd) $ reads s of (x, _):_ -> Just x [] -> Nothing From 027dfa9d91e042fed75cdf1752ef86f7f7227e65 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Thu, 24 Jul 2014 10:28:23 +0300 Subject: [PATCH 23/25] Miss qualified function usage --- yesod-form/Yesod/Form/Fields.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs index e305bcce..f3861238 100644 --- a/yesod-form/Yesod/Form/Fields.hs +++ b/yesod-form/Yesod/Form/Fields.hs @@ -233,7 +233,7 @@ $newline never } readMay :: Read a => String -> Maybe a -readMay s = case filter (null . snd) $ reads s of +readMay s = case filter (Prelude.null . snd) $ reads s of (x, _):_ -> Just x [] -> Nothing From 99621c17b0c50f422efdd517fa5db2467690e812 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Thu, 24 Jul 2014 10:45:06 +0300 Subject: [PATCH 24/25] Generate valid HTML from renderTable --- yesod-form/Yesod/Form/Functions.hs | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/yesod-form/Yesod/Form/Functions.hs b/yesod-form/Yesod/Form/Functions.hs index bdf16c66..bd3b5003 100644 --- a/yesod-form/Yesod/Form/Functions.hs +++ b/yesod-form/Yesod/Form/Functions.hs @@ -1,4 +1,5 @@ {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -356,15 +357,21 @@ type FormRender m a = -> MForm m (FormResult a, WidgetT (HandlerSite m) IO ()) renderTable, renderDivs, renderDivsNoLabels :: Monad m => FormRender m a +-- | Render a form into a series of tr tags. Note that, in order to allow +-- you to add extra rows to the table, this function does /not/ wrap up +-- the resulting HTML in a table tag; you must do that yourself. renderTable aform fragment = do (res, views') <- aFormToForm aform let views = views' [] let widget = [whamlet| $newline never -\#{fragment} -$forall view <- views +$if null views + \#{fragment} +$forall (isFirst, view) <- addIsFirst views + $if isFirst + \#{fragment}