From c782b9a8bace746506a10aa6081fae942fead345 Mon Sep 17 00:00:00 2001 From: Greg Weber Date: Fri, 10 Feb 2012 13:27:02 -0800 Subject: [PATCH 01/57] READMED: add --clean, improve cabal-dev --- README.md | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/README.md b/README.md index be4c89ff..2c5af78b 100644 --- a/README.md +++ b/README.md @@ -95,9 +95,12 @@ virthualenv --name=yesod #### individual cabal packages ~~~ { .bash } -# install and test all packages +# install and test all packages in a repo ./scripts/install +# If things seem weird, you may need to do a clean. +./scripts/install --clean + # move to the individual package you are working on cd shakespeare-text @@ -109,17 +112,12 @@ cabal test #### cabal-dev -cabal-dev works very well if you are working on a single package, but it can be very cumbersome to work on multiple packages at once. +cabal-dev works very well if you are working on a single package. +For working on multiple packages at once (installing Yesod), you need to use the shared sandbox feature. ### Use your development version of Yesod in your application Note that we have recommended to you to install Yesod into a sandboxed virthualenv environment. This is great for development, but when you want to use these development versions in your application that means they are not available through your user/global cabal database for your application. You should just continue to use your yesod virthualenv shell for your application. - -You can also use `cabal-dev install` to retrieve these packages. -cd to your application directory, and the reference the source list. - -~~~ { .bash } -cabal-dev install /path/to/yesodweb/yesod/*(/) -~~~ +You can also use the same`cabal-dev shared sandbox. From f2d7b0bda05e9fc7c763ca57c27e80af154a07bd Mon Sep 17 00:00:00 2001 From: Luite Stegeman Date: Sat, 11 Feb 2012 03:56:07 +0100 Subject: [PATCH 02/57] Bugfixes and better error reporting for yesod devel --- yesod/Devel.hs | 148 +++++++++++++++++++++++++++++++------------------ 1 file changed, 93 insertions(+), 55 deletions(-) diff --git a/yesod/Devel.hs b/yesod/Devel.hs index 007cbbbf..984c8917 100644 --- a/yesod/Devel.hs +++ b/yesod/Devel.hs @@ -12,31 +12,27 @@ import qualified Distribution.Simple.Utils as D import qualified Distribution.Verbosity as D import qualified Distribution.PackageDescription.Parse as D import qualified Distribution.PackageDescription as D +import qualified Distribution.ModuleName as D import Control.Concurrent (forkIO, threadDelay) import qualified Control.Exception as Ex -import Control.Monad (forever) +import Control.Monad (forever, when) +import Data.Char (isUpper, isNumber) import qualified Data.List as L import qualified Data.Map as Map -import Data.Maybe (listToMaybe) +import qualified Data.Set as Set -import System.Directory (createDirectoryIfMissing, removeFile, - getDirectoryContents) +import System.Directory import System.Exit (exitFailure, exitSuccess) +import System.FilePath (splitDirectories, dropExtension, takeExtension) import System.Posix.Types (EpochTime) import System.PosixCompat.Files (modificationTime, getFileStatus) -import System.Process (runCommand, terminateProcess, +import System.Process (runCommand, terminateProcess, readProcess, waitForProcess, rawSystem) import Build (recompDeps, getDeps,findHaskellFiles) -#if __GLASGOW_HASKELL__ >= 700 -#define ST st -#else -#define ST $st -#endif - lockFile :: FilePath lockFile = "dist/devel-terminate" @@ -50,6 +46,9 @@ removeLock = try_ (removeFile lockFile) devel :: Bool -> IO () devel isCabalDev = do + + checkDevelFile + writeLock putStrLn "Yesod devel server. Press ENTER to quit" @@ -79,51 +78,46 @@ devel isCabalDev = do writeLock exitSuccess - - mainLoop :: Bool -> IO () -mainLoop isCabalDev = forever $ do - putStrLn "Rebuilding application..." +mainLoop isCabalDev = do + ghcVer <- ghcVersion + forever $ do + putStrLn "Rebuilding application..." - recompDeps + recompDeps - list <- getFileList - _ <- if isCabalDev - then rawSystem "cabal-dev" ["build"] - else rawSystem "cabal" ["build"] + list <- getFileList + _ <- if isCabalDev + then rawSystem "cabal-dev" ["build"] + else rawSystem "cabal" ["build"] - removeLock - pkg <- pkgConfigs isCabalDev - let start = concat ["runghc ", pkg, " devel.hs"] - putStrLn $ "Starting development server: " ++ start - ph <- runCommand start - watchTid <- forkIO . try_ $ do - watchForChanges list - putStrLn "Stopping development server..." - writeLock - threadDelay 1000000 - putStrLn "Terminating development server..." - terminateProcess ph - ec <- waitForProcess ph - putStrLn $ "Exit code: " ++ show ec - Ex.throwTo watchTid (userError "process finished") - watchForChanges list + removeLock + let pkg = pkgConfigs isCabalDev ghcVer + let start = concat ["runghc ", pkg, " devel.hs"] + putStrLn $ "Starting development server: " ++ start + ph <- runCommand start + watchTid <- forkIO . try_ $ do + watchForChanges list + putStrLn "Stopping development server..." + writeLock + threadDelay 1000000 + putStrLn "Terminating development server..." + terminateProcess ph + ec <- waitForProcess ph + putStrLn $ "Exit code: " ++ show ec + Ex.throwTo watchTid (userError "process finished") + watchForChanges list try_ :: forall a. IO a -> IO () try_ x = (Ex.try x :: IO (Either Ex.SomeException a)) >> return () -pkgConfigs :: Bool -> IO String -pkgConfigs isDev - | isDev = do - devContents <- getDirectoryContents "cabal-dev" - let confs = filter isConfig devContents - return . unwords $ inplacePkg : - map ("-package-confcabal-dev/"++) confs - | otherwise = return inplacePkg +pkgConfigs :: Bool -> String -> String +pkgConfigs isCabalDev ghcVer + | isCabalDev = unwords ["-package-confcabal-dev/packages-" ++ ghcVer ++ ".conf", inplacePkg] + | otherwise = inplacePkg where inplacePkg = "-package-confdist/package.conf.inplace" - isConfig dir = "packages-" `L.isPrefixOf` dir && - ".conf" `L.isSuffixOf` dir + type FileList = Map.Map FilePath EpochTime @@ -143,29 +137,73 @@ watchForChanges list = do then return () else threadDelay 1000000 >> watchForChanges list +checkDevelFile :: IO () +checkDevelFile = do + e <- doesFileExist "devel.hs" + when (not e) $ failWith "file devel.hs not found" + checkCabalFile :: D.GenericPackageDescription -> IO () checkCabalFile gpd = case D.condLibrary gpd of - Nothing -> do - putStrLn "Error: incorrect cabal file, no library" - exitFailure + Nothing -> failWith "incorrect cabal file, no library" Just ct -> case lookupDevelLib ct of - Nothing -> do - putStrLn "Error: no development flag found in your configuration file. Expected a 'library-only' flag or the older 'devel' flag" - exitFailure - Just dLib -> + Nothing -> + failWith "no development flag found in your configuration file. Expected a 'library-only' flag or the older 'devel' flag" + Just dLib -> do case (D.hsSourceDirs . D.libBuildInfo) dLib of [] -> return () ["."] -> return () _ -> putStrLn $ "WARNING: yesod devel may not work correctly with " ++ "custom hs-source-dirs" + fl <- getFileList + print (allModules dLib) + let unlisted = checkFileList fl dLib + print fl + when (not . null $ unlisted) $ do + putStrLn "WARNING: the following source files are not listed in exposed-modules or other-modules:" + mapM_ putStrLn unlisted + when (D.fromString "Application" `notElem` D.exposedModules dLib) $ do + putStrLn "WARNING: no exposed module Application" + print (D.exposedModules dLib) + print dLib + +failWith :: String -> IO a +failWith msg = do + putStrLn $ "ERROR: " ++ msg + exitFailure + +checkFileList :: FileList -> D.Library -> [FilePath] +checkFileList fl lib = filter isUnlisted . filter isSrcFile $ sourceFiles + where + al = allModules lib + -- a file is only a possible 'module file' if all path pieces start with a capital letter + sourceFiles = filter isSrcFile . map fst . Map.toList $ fl + isSrcFile file = let dirs = filter (/=".") $ splitDirectories file + in all (isUpper . head) dirs && (takeExtension file `elem` [".hs", ".lhs"]) + isUnlisted file = not (toModuleName file `Set.member` al) + toModuleName = L.intercalate "." . filter (/=".") . splitDirectories . dropExtension + +allModules :: D.Library -> Set.Set String +allModules lib = Set.fromList $ map toString $ D.exposedModules lib ++ (D.otherModules . D.libBuildInfo) lib + where + toString = L.intercalate "." . D.components + +ghcVersion :: IO String +ghcVersion = fmap getNumber $ readProcess "runghc" ["--numeric-version", "0"] [] + where + getNumber = filter (\x -> isNumber x || x == '.') + lookupDevelLib :: D.CondTree D.ConfVar c a -> Maybe a -lookupDevelLib ct = listToMaybe . map (\(_,x,_) -> D.condTreeData x) . - filter isDevelLib . D.condTreeComponents $ ct +lookupDevelLib ct | found = Just (D.condTreeData ct) + | otherwise = Nothing where + found = not . null . map (\(_,x,_) -> D.condTreeData x) . + filter isDevelLib . D.condTreeComponents $ ct isDevelLib ((D.Var (D.Flag (D.FlagName f))), _, _) = f `elem` ["library-only", "devel"] isDevelLib _ = False + + From 2d3e10b372eefb44f7a3a9738d45fb093449ee80 Mon Sep 17 00:00:00 2001 From: Luite Stegeman Date: Sat, 11 Feb 2012 04:26:26 +0100 Subject: [PATCH 03/57] Check cabal build exit code, don't try to start application if build failed --- yesod/Devel.hs | 33 ++++++++++++++++----------------- 1 file changed, 16 insertions(+), 17 deletions(-) diff --git a/yesod/Devel.hs b/yesod/Devel.hs index 984c8917..c8fcdced 100644 --- a/yesod/Devel.hs +++ b/yesod/Devel.hs @@ -24,7 +24,7 @@ import qualified Data.Map as Map import qualified Data.Set as Set import System.Directory -import System.Exit (exitFailure, exitSuccess) +import System.Exit (exitFailure, exitSuccess, ExitCode (..)) import System.FilePath (splitDirectories, dropExtension, takeExtension) import System.Posix.Types (EpochTime) import System.PosixCompat.Files (modificationTime, getFileStatus) @@ -87,25 +87,28 @@ mainLoop isCabalDev = do recompDeps list <- getFileList - _ <- if isCabalDev - then rawSystem "cabal-dev" ["build"] - else rawSystem "cabal" ["build"] + exit <- if isCabalDev + then rawSystem "cabal-dev" ["build"] + else rawSystem "cabal" ["build"] - removeLock - let pkg = pkgConfigs isCabalDev ghcVer - let start = concat ["runghc ", pkg, " devel.hs"] - putStrLn $ "Starting development server: " ++ start - ph <- runCommand start - watchTid <- forkIO . try_ $ do + case exit of + ExitFailure _ -> putStrLn "Build failure, pausing..." + _ -> do + removeLock + let pkg = pkgConfigs isCabalDev ghcVer + let start = concat ["runghc ", pkg, " devel.hs"] + putStrLn $ "Starting development server: " ++ start + ph <- runCommand start + watchTid <- forkIO . try_ $ do watchForChanges list putStrLn "Stopping development server..." writeLock threadDelay 1000000 putStrLn "Terminating development server..." terminateProcess ph - ec <- waitForProcess ph - putStrLn $ "Exit code: " ++ show ec - Ex.throwTo watchTid (userError "process finished") + ec <- waitForProcess ph + putStrLn $ "Exit code: " ++ show ec + Ex.throwTo watchTid (userError "process finished") watchForChanges list try_ :: forall a. IO a -> IO () @@ -157,16 +160,12 @@ checkCabalFile gpd = case D.condLibrary gpd of putStrLn $ "WARNING: yesod devel may not work correctly with " ++ "custom hs-source-dirs" fl <- getFileList - print (allModules dLib) let unlisted = checkFileList fl dLib - print fl when (not . null $ unlisted) $ do putStrLn "WARNING: the following source files are not listed in exposed-modules or other-modules:" mapM_ putStrLn unlisted when (D.fromString "Application" `notElem` D.exposedModules dLib) $ do putStrLn "WARNING: no exposed module Application" - print (D.exposedModules dLib) - print dLib failWith :: String -> IO a failWith msg = do From 9b7ebbabe5f53ebe40711365db8ed09a1ae9958c Mon Sep 17 00:00:00 2001 From: Falco Hirschenberger Date: Sat, 11 Feb 2012 19:30:45 +0100 Subject: [PATCH 04/57] Fix german grammar, no I'm no grammar-nazi, just improving things in the details ;-) --- yesod-form/Yesod/Form/I18n/German.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/yesod-form/Yesod/Form/I18n/German.hs b/yesod-form/Yesod/Form/I18n/German.hs index aac5229e..d6f4de94 100644 --- a/yesod-form/Yesod/Form/I18n/German.hs +++ b/yesod-form/Yesod/Form/I18n/German.hs @@ -16,7 +16,7 @@ germanFormMessage (MsgInvalidEmail t) = "Ungültige e-Mail Adresse: " `mappend` germanFormMessage (MsgInvalidHour t) = "Ungültige Stunde: " `mappend` t germanFormMessage (MsgInvalidMinute t) = "Ungültige Minute: " `mappend` t germanFormMessage (MsgInvalidSecond t) = "Ungültige Sekunde: " `mappend` t -germanFormMessage MsgCsrfWarning = "Bitte bestätigen Sie ihre Eingabe, als Schutz gegen Cross-Site Forgery Angriffen" +germanFormMessage MsgCsrfWarning = "Bitte bestätigen Sie ihre Eingabe, als Schutz gegen Cross-Site Forgery Angriffe" germanFormMessage MsgValueRequired = "Wert wird benötigt" germanFormMessage (MsgInputNotFound t) = "Eingabe nicht gefunden: " `mappend` t germanFormMessage MsgSelectNone = "" From 2e71fb0a285192289905291c0fa93fd6b601afff Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Sun, 12 Feb 2012 15:23:01 +0200 Subject: [PATCH 05/57] GoogleEmail skips unnecessary parameter --- yesod-auth/Yesod/Auth/GoogleEmail.hs | 54 ++++++++++++---------------- yesod-auth/yesod-auth.cabal | 2 +- 2 files changed, 24 insertions(+), 32 deletions(-) diff --git a/yesod-auth/Yesod/Auth/GoogleEmail.hs b/yesod-auth/Yesod/Auth/GoogleEmail.hs index 5c0eb587..6a2c15b4 100644 --- a/yesod-auth/Yesod/Auth/GoogleEmail.hs +++ b/yesod-auth/Yesod/Auth/GoogleEmail.hs @@ -31,45 +31,37 @@ import Control.Exception.Lifted (try, SomeException) forwardUrl :: AuthRoute forwardUrl = PluginR "googleemail" ["forward"] +googleIdent :: Text +googleIdent = "https://www.google.com/accounts/o8/id" + authGoogleEmail :: YesodAuth m => AuthPlugin m authGoogleEmail = AuthPlugin "googleemail" dispatch login where complete = PluginR "googleemail" ["complete"] name = "openid_identifier" - login tm = do - [whamlet| -
- - -|] + login tm = + [whamlet|_{Msg.LoginGoogle}|] dispatch "GET" ["forward"] = do - roid <- runInputGet $ iopt textField name - case roid of - Just oid -> do - render <- getUrlRender - toMaster <- getRouteToMaster - let complete' = render $ toMaster complete - master <- getYesod - eres <- lift $ try $ OpenId.getForwardUrl oid complete' Nothing - [ ("openid.ax.type.email", "http://schema.openid.net/contact/email") - , ("openid.ns.ax", "http://openid.net/srv/ax/1.0") - , ("openid.ns.ax.required", "email") - , ("openid.ax.mode", "fetch_request") - , ("openid.ax.required", "email") - , ("openid.ui.icon", "true") - ] (authHttpManager master) - either - (\err -> do - setMessage $ toHtml $ show (err :: SomeException) - redirect $ toMaster LoginR - ) - redirect - eres - Nothing -> do - toMaster <- getRouteToMaster - setMessageI Msg.NoOpenID + render <- getUrlRender + toMaster <- getRouteToMaster + let complete' = render $ toMaster complete + master <- getYesod + eres <- lift $ try $ OpenId.getForwardUrl googleIdent complete' Nothing + [ ("openid.ax.type.email", "http://schema.openid.net/contact/email") + , ("openid.ns.ax", "http://openid.net/srv/ax/1.0") + , ("openid.ns.ax.required", "email") + , ("openid.ax.mode", "fetch_request") + , ("openid.ax.required", "email") + , ("openid.ui.icon", "true") + ] (authHttpManager master) + either + (\err -> do + setMessage $ toHtml $ show (err :: SomeException) redirect $ toMaster LoginR + ) + redirect + eres dispatch "GET" ["complete", ""] = dispatch "GET" ["complete"] -- compatibility issues dispatch "GET" ["complete"] = do rr <- getRequest diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal index dfcd7d70..1524adff 100644 --- a/yesod-auth/yesod-auth.cabal +++ b/yesod-auth/yesod-auth.cabal @@ -1,5 +1,5 @@ name: yesod-auth -version: 0.8.1 +version: 0.8.1.1 license: BSD3 license-file: LICENSE author: Michael Snoyman, Patrick Brisbin From a58f859d4136cca05f2cfce9e3f19e70d4dc6e81 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Sun, 12 Feb 2012 15:35:44 +0200 Subject: [PATCH 06/57] Fix warnings --- yesod-auth/Yesod/Auth/GoogleEmail.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/yesod-auth/Yesod/Auth/GoogleEmail.hs b/yesod-auth/Yesod/Auth/GoogleEmail.hs index 6a2c15b4..233866ca 100644 --- a/yesod-auth/Yesod/Auth/GoogleEmail.hs +++ b/yesod-auth/Yesod/Auth/GoogleEmail.hs @@ -18,7 +18,6 @@ module Yesod.Auth.GoogleEmail import Yesod.Auth import qualified Web.Authenticate.OpenId as OpenId -import Yesod.Form import Yesod.Handler import Yesod.Widget import Yesod.Request @@ -39,7 +38,6 @@ authGoogleEmail = AuthPlugin "googleemail" dispatch login where complete = PluginR "googleemail" ["complete"] - name = "openid_identifier" login tm = [whamlet|_{Msg.LoginGoogle}|] dispatch "GET" ["forward"] = do From f1474f4432b5059d58a70f51a3ccbe619fd0234a Mon Sep 17 00:00:00 2001 From: Khan Thompson Date: Mon, 13 Feb 2012 01:09:01 +1100 Subject: [PATCH 07/57] Adding a comment to the models config file for the scaffolded site to help avoid gotcha --- yesod/scaffold/config/models.cg | 2 ++ 1 file changed, 2 insertions(+) diff --git a/yesod/scaffold/config/models.cg b/yesod/scaffold/config/models.cg index c6e732e2..bebe304c 100644 --- a/yesod/scaffold/config/models.cg +++ b/yesod/scaffold/config/models.cg @@ -9,3 +9,5 @@ Email UniqueEmail email -- By default this file is used in Model.hs (which is imported by Foundation.hs) + -- If you are using the devel server, and don't see your changes being generated, + -- you need to 'touch' the Model.hs file \ No newline at end of file From 651a1f8abdfc213a719db31920c9e82edae216b5 Mon Sep 17 00:00:00 2001 From: Greg Weber Date: Sun, 12 Feb 2012 08:09:01 -0800 Subject: [PATCH 08/57] more flexible js loading * write your own async jsLoader widget. * Suport loading from the bottom of body tag. Bottom of the page is actually the best default until you profile your application. --- yesod-core/Yesod/Core.hs | 3 + yesod-core/Yesod/Internal/Core.hs | 100 +++++++++++++++++++-------- yesod-form/Yesod/Form/Nic.hs | 8 +-- yesod/scaffold/Foundation.hs.cg | 4 +- yesod/scaffold/tiny/Foundation.hs.cg | 4 +- 5 files changed, 82 insertions(+), 37 deletions(-) diff --git a/yesod-core/Yesod/Core.hs b/yesod-core/Yesod/Core.hs index 740bb1dc..e27ffedf 100644 --- a/yesod-core/Yesod/Core.hs +++ b/yesod-core/Yesod/Core.hs @@ -27,6 +27,9 @@ module Yesod.Core , logWarn , logError , logOther + -- * JS loaders + , loadJsYepnope + , ScriptLoadPosition (..) -- * Misc , yesodVersion , yesodRender diff --git a/yesod-core/Yesod/Internal/Core.hs b/yesod-core/Yesod/Internal/Core.hs index 9f1d6403..3011d004 100644 --- a/yesod-core/Yesod/Internal/Core.hs +++ b/yesod-core/Yesod/Internal/Core.hs @@ -25,6 +25,9 @@ module Yesod.Internal.Core , formatLogMessage , fileLocationToString , messageLoggerHandler + -- * jsLoader + , ScriptLoadPosition (..) + , loadJsYepnope -- * Misc , yesodVersion , yesodRender @@ -313,11 +316,20 @@ class RenderRoute a => Yesod a where gzipSettings :: a -> GzipSettings gzipSettings _ = def - -- | Location of yepnope.js, if any. If one is provided, then all + -- | Deprecated. Use 'jsloader'. To use yepnope: jsLoader = BottomOfHeadAsync (loadJsYepnope eyn) + -- Location of yepnope.js, if any. If one is provided, then all -- Javascript files will be loaded asynchronously. yepnopeJs :: a -> Maybe (Either Text (Route a)) yepnopeJs _ = Nothing + -- | Where to Load sripts from. We recommend changing this to 'BottomOfBody' + -- Alternatively use the built in async yepnope loader: BottomOfHeadAsync (loadJsYepnope eyn) + -- Or write your own async js loader: see 'loadJsYepnope' + jsLoader :: a -> ScriptLoadPosition a + jsLoader y = case yepnopeJs y of + Nothing -> BottomOfHeadBlocking + Just eyn -> BottomOfHeadAsync (loadJsYepnope eyn) + messageLoggerHandler :: Yesod m => Loc -> LogLevel -> Text -> GHandler s m () messageLoggerHandler loc level msg = do @@ -573,7 +585,16 @@ widgetToPageContent w = do -- modernizr should be at the end of the http://www.modernizr.com/docs/#installing -- the asynchronous loader means your page doesn't have to wait for all the js to load - let (mcomplete, ynscripts) = ynHelper render scripts jscript jsLoc + let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc + regularScriptLoad = [HAMLET| +$forall s <- scripts + ^{mkScriptTag s} +$maybe j <- jscript + $maybe s <- jsLoc + " res + + , it "link from head async" $ runner HA $ do + res <- request defaultRequest + assertBody "\n" res + + , it "link from bottom" $ runner B $ do + res <- request defaultRequest + assertBody "\n" res + ] + +runner :: (YesodDispatch master master, Yesod master) => master -> Session () -> IO () +runner app f = toWaiApp app >>= runSession f diff --git a/yesod-core/test/YesodCoreTest/JsLoaderSites/Bottom.hs b/yesod-core/test/YesodCoreTest/JsLoaderSites/Bottom.hs new file mode 100644 index 00000000..81ef8eb1 --- /dev/null +++ b/yesod-core/test/YesodCoreTest/JsLoaderSites/Bottom.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances #-} +module YesodCoreTest.JsLoaderSites.Bottom (B(..)) where + +import Yesod.Core + +data B = B +mkYesod "B" [parseRoutes| +/ BottomR GET +|] +instance Yesod B where + jsLoader _ = BottomOfBody + +getBottomR :: Handler RepHtml +getBottomR = defaultLayout $ addScriptRemote "load.js" + diff --git a/yesod-core/test/YesodCoreTest/JsLoaderSites/HeadAsync.hs b/yesod-core/test/YesodCoreTest/JsLoaderSites/HeadAsync.hs new file mode 100644 index 00000000..438fa83f --- /dev/null +++ b/yesod-core/test/YesodCoreTest/JsLoaderSites/HeadAsync.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances #-} +module YesodCoreTest.JsLoaderSites.HeadAsync (HA(..)) where + +import Yesod.Core + +data HA = HA +mkYesod "HA" [parseRoutes| +/ HeadAsyncR GET +|] +instance Yesod HA where + jsLoader _ = BottomOfHeadAsync $ loadJsYepnope $ Left "yepnope.js" + +getHeadAsyncR :: Handler RepHtml +getHeadAsyncR = defaultLayout $ addScriptRemote "load.js" From e1d584cf1fa0668dbc59bd4de8cecd476261071b Mon Sep 17 00:00:00 2001 From: Greg Weber Date: Thu, 16 Feb 2012 19:03:37 -0800 Subject: [PATCH 19/57] pass through args to yesod devel --- yesod/Devel.hs | 91 +++++++++++++++++++++++++------------------------- yesod/main.hs | 2 +- 2 files changed, 46 insertions(+), 47 deletions(-) diff --git a/yesod/Devel.hs b/yesod/Devel.hs index c8fcdced..e6033f30 100644 --- a/yesod/Devel.hs +++ b/yesod/Devel.hs @@ -28,7 +28,7 @@ import System.Exit (exitFailure, exitSuccess, ExitCode (..)) import System.FilePath (splitDirectories, dropExtension, takeExtension) import System.Posix.Types (EpochTime) import System.PosixCompat.Files (modificationTime, getFileStatus) -import System.Process (runCommand, terminateProcess, readProcess, +import System.Process (createProcess, proc, terminateProcess, readProcess, waitForProcess, rawSystem) import Build (recompDeps, getDeps,findHaskellFiles) @@ -44,8 +44,8 @@ writeLock = do removeLock :: IO () removeLock = try_ (removeFile lockFile) -devel :: Bool -> IO () -devel isCabalDev = do +devel :: Bool -> [String] -> IO () +devel isCabalDev passThroughArgs = do checkDevelFile @@ -58,58 +58,57 @@ devel isCabalDev = do checkCabalFile gpd - _ <- if isCabalDev - then rawSystem "cabal-dev" - [ "configure" - , "--cabal-install-arg=-fdevel" -- legacy - , "--cabal-install-arg=-flibrary-only" - , "--disable-library-profiling" - ] - else rawSystem "cabal" - [ "configure" - , "-fdevel" -- legacy - , "-flibrary-only" - , "--disable-library-profiling" - ] + _<- rawSystem cmd args - mainLoop isCabalDev + mainLoop _ <- getLine writeLock exitSuccess + where + cmd | isCabalDev == True = "cabal-dev" + | otherwise = "cabal" -mainLoop :: Bool -> IO () -mainLoop isCabalDev = do - ghcVer <- ghcVersion - forever $ do - putStrLn "Rebuilding application..." + diffArgs | isCabalDev == True = [ + "--cabal-install-arg=-fdevel" -- legacy + , "--cabal-install-arg=-flibrary-only" + ] + | otherwise = [ + "-fdevel" -- legacy + , "-flibrary-only" + ] + args = "configure":diffArgs ++ ["--disable-library-profiling" ] - recompDeps + mainLoop :: IO () + mainLoop = do + ghcVer <- ghcVersion + forever $ do + putStrLn "Rebuilding application..." - list <- getFileList - exit <- if isCabalDev - then rawSystem "cabal-dev" ["build"] - else rawSystem "cabal" ["build"] + recompDeps - case exit of - ExitFailure _ -> putStrLn "Build failure, pausing..." - _ -> do - removeLock - let pkg = pkgConfigs isCabalDev ghcVer - let start = concat ["runghc ", pkg, " devel.hs"] - putStrLn $ "Starting development server: " ++ start - ph <- runCommand start - watchTid <- forkIO . try_ $ do - watchForChanges list - putStrLn "Stopping development server..." - writeLock - threadDelay 1000000 - putStrLn "Terminating development server..." - terminateProcess ph - ec <- waitForProcess ph - putStrLn $ "Exit code: " ++ show ec - Ex.throwTo watchTid (userError "process finished") - watchForChanges list + list <- getFileList + exit <- rawSystem cmd ["build"] + + case exit of + ExitFailure _ -> putStrLn "Build failure, pausing..." + _ -> do + removeLock + let pkg = pkgConfigs isCabalDev ghcVer + let dev_args = ([pkg, "devel.hs"] ++ passThroughArgs) + putStrLn $ "Starting development server: runghc " ++ L.intercalate " " dev_args + (_,_,_,ph) <- createProcess $ proc "runghc" dev_args + watchTid <- forkIO . try_ $ do + watchForChanges list + putStrLn "Stopping development server..." + writeLock + threadDelay 1000000 + putStrLn "Terminating development server..." + terminateProcess ph + ec <- waitForProcess ph + putStrLn $ "Exit code: " ++ show ec + Ex.throwTo watchTid (userError "process finished") + watchForChanges list try_ :: forall a. IO a -> IO () try_ x = (Ex.try x :: IO (Either Ex.SomeException a)) >> return () diff --git a/yesod/main.hs b/yesod/main.hs index dcf20cfa..72a7c9b1 100755 --- a/yesod/main.hs +++ b/yesod/main.hs @@ -35,7 +35,7 @@ main = do "build":rest -> touch >> build rest >>= exitWith ["touch"] -> touch #endif - ["devel"] -> devel isDev + "devel":rest -> devel isDev rest ["version"] -> putStrLn yesodVersion "configure":rest -> rawSystem cmd ("configure":rest) >>= exitWith _ -> do From 29140252027a5acd87b9852d96459109c5753566 Mon Sep 17 00:00:00 2001 From: Arash Rouhani Date: Fri, 17 Feb 2012 23:22:39 +0100 Subject: [PATCH 20/57] Include Swedish support in yesod-auth --- yesod-auth/Yesod/Auth/Message.hs | 35 ++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) diff --git a/yesod-auth/Yesod/Auth/Message.hs b/yesod-auth/Yesod/Auth/Message.hs index e3af1dfa..9be0776b 100644 --- a/yesod-auth/Yesod/Auth/Message.hs +++ b/yesod-auth/Yesod/Auth/Message.hs @@ -6,6 +6,7 @@ module Yesod.Auth.Message -- * All languages , englishMessage , portugueseMessage + , swedishMessage ) where import Data.Monoid (mappend) @@ -113,3 +114,37 @@ portugueseMessage NowLoggedIn = "Você acaba de entrar no site com sucesso!" portugueseMessage LoginTitle = "Entrar no site" portugueseMessage PleaseProvideUsername = "Por favor digite seu nome de usuário" portugueseMessage PleaseProvidePassword = "Por favor digite sua senha" + +swedishMessage :: AuthMessage -> Text +swedishMessage NoOpenID = "Fann ej OpenID identifierare" +swedishMessage LoginOpenID = "Logga in via OpenID" +swedishMessage LoginGoogle = "Logga in via Google" +swedishMessage LoginYahoo = "Logga in via Yahoo" +swedishMessage Email = "Epost" +swedishMessage Password = "Lösenord" +swedishMessage Register = "Registrera" +swedishMessage RegisterLong = "Registrera ett nytt konto" +swedishMessage EnterEmail = "Skriv in din epost nedan så kommer ett konfirmationsmail skickas till adressen." +swedishMessage ConfirmationEmailSentTitle = "Konfirmationsmail skickat" +swedishMessage (ConfirmationEmailSent email) = + "Ett konfirmationsmeddelande har skickats till" `mappend` + email `mappend` + "." +swedishMessage AddressVerified = "Adress verifierad, vänligen välj nytt lösenord" +swedishMessage InvalidKeyTitle = "Ogiltig verifikationsnyckel" +swedishMessage InvalidKey = "Tyvärr, du angav en ogiltig verifimationsnyckel." +swedishMessage InvalidEmailPass = "Ogiltig epost/lösenord kombination" +swedishMessage BadSetPass = "Du måste vara inloggad för att ange ett lösenord" +swedishMessage SetPassTitle = "Ange lösenord" +swedishMessage SetPass = "Ange nytt lösenord" +swedishMessage NewPass = "Nytt lösenord" +swedishMessage ConfirmPass = "Godkänn" +swedishMessage PassMismatch = "Lösenorden matcha ej, vänligen försök igen" +swedishMessage PassUpdated = "Lösenord updaterades" +swedishMessage Facebook = "Logga in med Facebook" +swedishMessage LoginViaEmail = "Logga in via epost" +swedishMessage InvalidLogin = "Ogiltigt login" +swedishMessage NowLoggedIn = "Du är nu inloggad" +swedishMessage LoginTitle = "Logga in" +swedishMessage PleaseProvideUsername = "Vänligen fyll i användarnamn" +swedishMessage PleaseProvidePassword = "Vänligen fyll i lösenord" From 44119c6e02dc3968378a8a68405c3606cc6be39d Mon Sep 17 00:00:00 2001 From: Tom Streller Date: Sun, 19 Feb 2012 23:09:12 +0100 Subject: [PATCH 21/57] added svg content type --- yesod-core/Yesod/Content.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/yesod-core/Yesod/Content.hs b/yesod-core/Yesod/Content.hs index 41afaee0..5bf1c1a7 100644 --- a/yesod-core/Yesod/Content.hs +++ b/yesod-core/Yesod/Content.hs @@ -19,6 +19,7 @@ module Yesod.Content , typeJpeg , typePng , typeGif + , typeSvg , typeJavascript , typeCss , typeFlv @@ -196,6 +197,9 @@ typePng = "image/png" typeGif :: ContentType typeGif = "image/gif" +typeSvg :: ContentType +typeSvg = "image/svg+xml" + typeJavascript :: ContentType typeJavascript = "text/javascript; charset=utf-8" From 8a3024113f2d3f35d6917b09f361d686af884846 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Mon, 20 Feb 2012 16:32:55 -0200 Subject: [PATCH 22/57] Bump yesod-form to 0.4.2. --- yesod-form/yesod-form.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/yesod-form/yesod-form.cabal b/yesod-form/yesod-form.cabal index 2e798546..e860d1eb 100644 --- a/yesod-form/yesod-form.cabal +++ b/yesod-form/yesod-form.cabal @@ -1,5 +1,5 @@ name: yesod-form -version: 0.4.1 +version: 0.4.2 license: BSD3 license-file: LICENSE author: Michael Snoyman From 4c21c092ab7a48a2e9141159a3ca14bd9773febd Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Tue, 21 Feb 2012 15:17:36 +0200 Subject: [PATCH 23/57] Fix Haddocks (#277) --- yesod-core/Yesod/Core.hs | 1 + yesod-core/Yesod/Internal/Core.hs | 15 ++++++++++----- 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/yesod-core/Yesod/Core.hs b/yesod-core/Yesod/Core.hs index e27ffedf..6a59c563 100644 --- a/yesod-core/Yesod/Core.hs +++ b/yesod-core/Yesod/Core.hs @@ -30,6 +30,7 @@ module Yesod.Core -- * JS loaders , loadJsYepnope , ScriptLoadPosition (..) + , BottomOfHeadAsync -- * Misc , yesodVersion , yesodRender diff --git a/yesod-core/Yesod/Internal/Core.hs b/yesod-core/Yesod/Internal/Core.hs index f099eefa..8aabc737 100644 --- a/yesod-core/Yesod/Internal/Core.hs +++ b/yesod-core/Yesod/Internal/Core.hs @@ -27,6 +27,7 @@ module Yesod.Internal.Core , messageLoggerHandler -- * jsLoader , ScriptLoadPosition (..) + , BottomOfHeadAsync , loadJsYepnope -- * Misc , yesodVersion @@ -641,11 +642,15 @@ $case jsLoader master : attrs ) -data Yesod master => ScriptLoadPosition master = BottomOfBody | BottomOfHeadBlocking | BottomOfHeadAsync ( - [Text] -- ^ urls to load asynchronously - -> Maybe (HtmlUrl (Route master)) -- ^ widget of js to run on async completion - -> (HtmlUrl (Route master)) -- ^ widget to insert at the bottom of - ) +data ScriptLoadPosition master + = BottomOfBody + | BottomOfHeadBlocking + | BottomOfHeadAsync (BottomOfHeadAsync master) + +type BottomOfHeadAsync master + = [Text] -- ^ urls to load asynchronously + -> Maybe (HtmlUrl (Route master)) -- ^ widget of js to run on async completion + -> (HtmlUrl (Route master)) -- ^ widget to insert at the bottom of left :: Either a b -> Maybe a left (Left x) = Just x From e3a07d2b80c9db65f047987f414c3eae42527af8 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Tue, 21 Feb 2012 15:17:56 +0200 Subject: [PATCH 24/57] Version bump --- yesod-core/yesod-core.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index 665bc6b0..b6d84fb0 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 0.10.2 +version: 0.10.2.1 license: BSD3 license-file: LICENSE author: Michael Snoyman From a304c0daa5bd033f53e8f06e907516c9ce6773e3 Mon Sep 17 00:00:00 2001 From: Jonathan Grochowski Date: Fri, 24 Feb 2012 17:01:28 -0800 Subject: [PATCH 25/57] Remove CRLF line endings from modernizr.js This is a minor pet peeve, but the modernizr.js included in the scaffold has CRLF line endings in the repository, and thus any scaffolded sites. This appears to be the only affected file in this repo. --- yesod/scaffold/static/js/modernizr.js.cg | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/yesod/scaffold/static/js/modernizr.js.cg b/yesod/scaffold/static/js/modernizr.js.cg index 76dc0298..737d8fe8 100644 --- a/yesod/scaffold/static/js/modernizr.js.cg +++ b/yesod/scaffold/static/js/modernizr.js.cg @@ -1,4 +1,4 @@ -/* Modernizr 2.0.6 (Custom Build) | MIT & BSD - * Build: http://www.modernizr.com/download/#-fontface-backgroundsize-borderimage-borderradius-boxshadow-flexbox-hsla-multiplebgs-opacity-rgba-textshadow-cssanimations-csscolumns-generatedcontent-cssgradients-cssreflections-csstransforms-csstransforms3d-csstransitions-applicationcache-canvas-canvastext-draganddrop-hashchange-history-audio-video-indexeddb-input-inputtypes-localstorage-postmessage-sessionstorage-websockets-websqldatabase-webworkers-geolocation-inlinesvg-smil-svg-svgclippaths-touch-webgl-iepp-cssclasses-teststyles-testprop-testallprops-hasevent-prefixes-domprefixes-load - */ +/* Modernizr 2.0.6 (Custom Build) | MIT & BSD + * Build: http://www.modernizr.com/download/#-fontface-backgroundsize-borderimage-borderradius-boxshadow-flexbox-hsla-multiplebgs-opacity-rgba-textshadow-cssanimations-csscolumns-generatedcontent-cssgradients-cssreflections-csstransforms-csstransforms3d-csstransitions-applicationcache-canvas-canvastext-draganddrop-hashchange-history-audio-video-indexeddb-input-inputtypes-localstorage-postmessage-sessionstorage-websockets-websqldatabase-webworkers-geolocation-inlinesvg-smil-svg-svgclippaths-touch-webgl-iepp-cssclasses-teststyles-testprop-testallprops-hasevent-prefixes-domprefixes-load + */ ;window.Modernizr=function(a,b,c){function H(){e.input=function(a){for(var b=0,c=a.length;b",a,""].join(""),k.id=i,k.innerHTML+=f,g.appendChild(k),h=c(k,a),k.parentNode.removeChild(k);return!!h},w=function(){function d(d,e){e=e||b.createElement(a[d]||"div"),d="on"+d;var f=d in e;f||(e.setAttribute||(e=b.createElement("div")),e.setAttribute&&e.removeAttribute&&(e.setAttribute(d,""),f=C(e[d],"function"),C(e[d],c)||(e[d]=c),e.removeAttribute(d))),e=null;return f}var a={select:"input",change:"input",submit:"form",reset:"form",error:"img",load:"img",abort:"img"};return d}(),x,y={}.hasOwnProperty,z;!C(y,c)&&!C(y.call,c)?z=function(a,b){return y.call(a,b)}:z=function(a,b){return b in a&&C(a.constructor.prototype[b],c)};var G=function(c,d){var f=c.join(""),g=d.length;v(f,function(c,d){var f=b.styleSheets[b.styleSheets.length-1],h=f.cssRules&&f.cssRules[0]?f.cssRules[0].cssText:f.cssText||"",i=c.childNodes,j={};while(g--)j[i[g].id]=i[g];e.touch="ontouchstart"in a||j.touch.offsetTop===9,e.csstransforms3d=j.csstransforms3d.offsetLeft===9,e.generatedcontent=j.generatedcontent.offsetHeight>=1,e.fontface=/src/i.test(h)&&h.indexOf(d.split(" ")[0])===0},g,d)}(['@font-face {font-family:"font";src:url("https://")}',["@media (",o.join("touch-enabled),("),i,")","{#touch{top:9px;position:absolute}}"].join(""),["@media (",o.join("transform-3d),("),i,")","{#csstransforms3d{left:9px;position:absolute}}"].join(""),['#generatedcontent:after{content:"',m,'";visibility:hidden}'].join("")],["fontface","touch","csstransforms3d","generatedcontent"]);r.flexbox=function(){function c(a,b,c,d){a.style.cssText=o.join(b+":"+c+";")+(d||"")}function a(a,b,c,d){b+=":",a.style.cssText=(b+o.join(c+";"+b)).slice(0,-b.length)+(d||"")}var d=b.createElement("div"),e=b.createElement("div");a(d,"display","box","width:42px;padding:0;"),c(e,"box-flex","1","width:10px;"),d.appendChild(e),g.appendChild(d);var f=e.offsetWidth===42;d.removeChild(e),g.removeChild(d);return f},r.canvas=function(){var a=b.createElement("canvas");return!!a.getContext&&!!a.getContext("2d")},r.canvastext=function(){return!!e.canvas&&!!C(b.createElement("canvas").getContext("2d").fillText,"function")},r.webgl=function(){return!!a.WebGLRenderingContext},r.touch=function(){return e.touch},r.geolocation=function(){return!!navigator.geolocation},r.postmessage=function(){return!!a.postMessage},r.websqldatabase=function(){var b=!!a.openDatabase;return b},r.indexedDB=function(){for(var b=-1,c=p.length;++b7)},r.history=function(){return!!a.history&&!!history.pushState},r.draganddrop=function(){return w("dragstart")&&w("drop")},r.websockets=function(){for(var b=-1,c=p.length;++b";return(a.firstChild&&a.firstChild.namespaceURI)==q.svg},r.smil=function(){return!!b.createElementNS&&/SVG/.test(n.call(b.createElementNS(q.svg,"animate")))},r.svgclippaths=function(){return!!b.createElementNS&&/SVG/.test(n.call(b.createElementNS(q.svg,"clipPath")))};for(var I in r)z(r,I)&&(x=I.toLowerCase(),e[x]=r[I](),u.push((e[x]?"":"no-")+x));e.input||H(),A(""),j=l=null,a.attachEvent&&function(){var a=b.createElement("div");a.innerHTML="";return a.childNodes.length!==1}()&&function(a,b){function s(a){var b=-1;while(++b Date: Sat, 25 Feb 2012 15:19:38 -0800 Subject: [PATCH 26/57] don't use Yepnope for google analytics it is already at the bottom of the body --- .../templates/default-layout-wrapper.hamlet.cg | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/yesod/scaffold/templates/default-layout-wrapper.hamlet.cg b/yesod/scaffold/templates/default-layout-wrapper.hamlet.cg index 320b3034..4e88ffc1 100644 --- a/yesod/scaffold/templates/default-layout-wrapper.hamlet.cg +++ b/yesod/scaffold/templates/default-layout-wrapper.hamlet.cg @@ -31,10 +31,14 @@ $maybe analytics <- extraAnalytics $ appExtra $ settings master