Merge branch 'master' into wai-2.0

Conflicts:
	yesod-bin/Devel.hs

.gitignore

@@ -6,7 +6,9 @@ dist
 client_session_key.aes
 cabal-dev/
 yesod/foobar/
-.virthualenv
+.hsenv/
+.cabal-sandbox/
+cabal.sandbox.config
 /vendor/
 /.shelly/
 /tarballs/

yesod-bin/Devel.hs

@@ -1,14 +1,13 @@
 {-# LANGUAGE CPP                 #-}
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell   #-}
 module Devel
     ( devel
     , DevelOpts(..)
     , defaultDevelOpts
     ) where
 
-import           Paths_yesod_bin
-
 import qualified Distribution.Compiler                 as D
 import qualified Distribution.ModuleName               as D
 import qualified Distribution.PackageDescription       as D
@@ -24,7 +23,7 @@ import           Control.Concurrent.MVar               (MVar, newEmptyMVar,
                                                         takeMVar, tryPutMVar)
 import qualified Control.Exception                     as Ex
 import           Control.Monad                         (forever, unless, void,
-                                                        when)
+                                                        when, forM)
 import           Control.Monad.IO.Class                (liftIO)
 import           Control.Monad.Trans.State             (evalStateT, get)
 import qualified Data.IORef                            as I
@@ -83,6 +82,7 @@ import           Network.Socket                        (sClose)
 import           Network.Wai                           (responseLBS)
 import           Network.Wai.Handler.Warp              (run)
 import           SrcLoc                                (Located)
+import           Data.FileEmbed        (embedFile)
 
 lockFile :: DevelOpts -> FilePath
 lockFile _opts =  "yesod-devel/devel-terminate"
@@ -131,7 +131,14 @@ reverseProxy opts iappPort = do
 #else
     manager <- newManager def
 #endif
-    let loop = forever $ do
+    let refreshHtml = LB.fromStrict $(embedFile "refreshing.html")
+    let onExc _ _ = return $ responseLBS status200
+            [ ("content-type", "text/html")
+            , ("Refresh", "1")
+            ]
+            refreshHtml
+
+    let runProxy =
             run (develPort opts) $ waiProxyToSettings
                 (const $ do
                     appPort <- liftIO $ I.readIORef iappPort
@@ -150,20 +157,13 @@ reverseProxy opts iappPort = do
                             else Just (1000000 * proxyTimeout opts)
                     }
                 manager
-            putStrLn "Reverse proxy stopped, but it shouldn't"
+    loop runProxy `Ex.onException` exitFailure
-            threadDelay 1000000
-            putStrLn "Restarting reverse proxy"
-    loop `Ex.onException` exitFailure
   where
-    onExc _ _ = do
+    loop proxy = forever $ do
-      refreshing <- liftIO $ getDataFileName "refreshing.html"
+        void proxy
-      html <- liftIO $ LB.readFile refreshing
+        putStrLn "Reverse proxy stopped, but it shouldn't"
-      return $ responseLBS
+        threadDelay 1000000
-        status200
+        putStrLn "Restarting reverse proxy"
-        [ ("content-type", "text/html")
-        , ("Refresh", "1")
-        ]
-        html
 
 checkPort :: Int -> IO Bool
 checkPort p = do
@@ -183,10 +183,12 @@ getPort _ p0 =
         avail <- checkPort p
         if avail then return p else loop (succ p)
 
+unlessM :: Monad m => m Bool -> m () -> m ()
+unlessM c a = c >>= \res -> unless res a
+
 devel :: DevelOpts -> [String] -> IO ()
 devel opts passThroughArgs = withSocketsDo $ withManager $ \manager -> do
-    avail <- checkPort $ develPort opts
+    unlessM (checkPort $ develPort opts) $ error "devel port unavailable"
-    unless avail $ error "devel port unavailable"
     iappPort <- getPort opts 17834 >>= I.newIORef
     when (useReverseProxy opts) $ void $ forkIO $ reverseProxy opts iappPort
     checkDevelFile
@@ -287,8 +289,8 @@ runBuildHook Nothing = return ()
 -}
 configure :: DevelOpts -> [String] -> IO Bool
 configure opts extraArgs =
-  checkExit =<< (createProcess $ proc (cabalProgram opts)
+  checkExit =<< createProcess (proc (cabalProgram opts) $
-                                ([ "configure"
+                                 [ "configure"
                                  , "-flibrary-only"
                                  , "-fdevel"
                                  , "--disable-library-profiling"
@@ -296,7 +298,7 @@ configure opts extraArgs =
                                  , "--with-ghc=yesod-ghc-wrapper"
                                  , "--with-ar=yesod-ar-wrapper"
                                  , "--with-hc-pkg=ghc-pkg"
-                                 ] ++ extraArgs)
+                                 ] ++ extraArgs
                )
 
 removeFileIfExists :: FilePath -> IO ()
@@ -311,7 +313,7 @@ mkRebuild ghcVer cabalFile opts (ldPath, arPath)
   | GHC.cProjectVersion /= ghcVer =
        failWith "Yesod has been compiled with a different GHC version, please reinstall"
   | forceCabal opts               = return (rebuildCabal opts)
-  | otherwise                     = do
+  | otherwise                     =
       return $ do
         ns <- mapM (cabalFile `isNewerThan`)
            [ "yesod-devel/ghcargs.txt", "yesod-devel/arargs.txt", "yesod-devel/ldargs.txt" ]
@@ -336,7 +338,7 @@ rebuildCabal opts = do
            | otherwise    = [ "build", "-v0" ]
 
 try_ :: forall a. IO a -> IO ()
-try_ x = (Ex.try x :: IO (Either Ex.SomeException a)) >> return ()
+try_ x = void (Ex.try x :: IO (Either Ex.SomeException a))
 
 type FileList = Map.Map FilePath EpochTime
 
@@ -344,7 +346,7 @@ getFileList :: [FilePath] -> [FilePath] -> IO FileList
 getFileList hsSourceDirs extraFiles = do
     (files, deps) <- getDeps hsSourceDirs
     let files' = extraFiles ++ files ++ map fst (Map.toList deps)
-    fmap Map.fromList $ flip mapM files' $ \f -> do
+    fmap Map.fromList $ forM files' $ \f -> do
         efs <- Ex.try $ getFileStatus f
         return $ case efs of
             Left (_ :: Ex.SomeException) -> (f, 0)

yesod-bin/Options.hs

@@ -11,7 +11,7 @@ import           Data.Char                 (isAlphaNum, isSpace, toLower)
 import           Data.List                 (foldl')
 import           Data.List.Split           (splitOn)
 import qualified Data.Map                  as M
-import           Data.Maybe                (catMaybes)
+import           Data.Maybe                (mapMaybe)
 import           Data.Monoid
 import           Options.Applicative
 import           Options.Applicative.Types
@@ -52,10 +52,10 @@ updateA env key upd a =
 
 -- | really simple key/value file reader:   x.y = z -> (["x","y"],"z")
 configLines :: String -> [([String], String)]
-configLines = catMaybes . map (mkLine . takeWhile (/='#')) . lines
+configLines = mapMaybe (mkLine . takeWhile (/='#')) . lines
   where
     trim = let f = reverse . dropWhile isSpace in f . f
-    mkLine l | (k, ('=':v)) <- break (=='=') l = Just (splitOn "." (trim k), trim v)
+    mkLine l | (k, '=':v) <- break (=='=') l = Just (splitOn "." (trim k), trim v)
              | otherwise                       = Nothing
 
 -- | inject the environment into the parser
@@ -75,21 +75,22 @@ injectDefaultP env path p@(OptP o)
   | (Option (FlagReader names a) _) <- o =
      p <|> if any ((==Just "1") . getEnvValue env path) names then pure a else empty
   | otherwise = p
+  where
+#if MIN_VERSION_optparse_applicative(0,6,0)
+    right= ReadM . Right
+    left = ReadM . Left
+    either' f g (ReadM x) = either f g x
+#else
+    right = Right
+    left = Left
+    either' = either
+#endif
 injectDefaultP env path (MultP p1 p2) =
    MultP (injectDefaultP env path p1) (injectDefaultP env path p2)
 injectDefaultP env path (AltP p1 p2) =
    AltP (injectDefaultP env path p1) (injectDefaultP env path p2)
 injectDefaultP _env _path b@(BindP {}) = b
 
-#if MIN_VERSION_optparse_applicative(0,6,0)
-right = ReadM . Right
-left = ReadM . Left
-either' f g (ReadM x) = either f g x
-#else
-right = Right
-left = Left
-either' = either
-#endif
 
 getEnvValue :: M.Map [String] String -> [String] -> OptName -> Maybe String
 getEnvValue env path (OptLong l) = M.lookup (path ++ [normalizeName l]) env

yesod-bin/hsfiles/mongo.hsfiles

@@ -12,6 +12,8 @@ config/client_session_key.aes
 .hsenv*
 cabal-dev/
 yesod-devel/
+.cabal-sandbox
+cabal.sandbox.config
 
 {-# START_FILE Application.hs #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}

yesod-bin/hsfiles/mysql.hsfiles

@@ -12,6 +12,8 @@ config/client_session_key.aes
 .hsenv*
 cabal-dev/
 yesod-devel/
+.cabal-sandbox
+cabal.sandbox.config
 
 {-# START_FILE Application.hs #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}

yesod-bin/hsfiles/postgres-fay.hsfiles

@@ -13,6 +13,8 @@ fay/Language/Fay/Yesod.hs
 .hsenv*
 cabal-dev/
 yesod-devel/
+.cabal-sandbox
+cabal.sandbox.config
 
 {-# START_FILE Application.hs #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}

yesod-bin/hsfiles/postgres.hsfiles

@@ -12,6 +12,8 @@ config/client_session_key.aes
 .hsenv*
 cabal-dev/
 yesod-devel/
+.cabal-sandbox
+cabal.sandbox.config
 
 {-# START_FILE Application.hs #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}

yesod-bin/hsfiles/simple.hsfiles

@@ -12,6 +12,8 @@ config/client_session_key.aes
 .hsenv*
 cabal-dev/
 yesod-devel/
+.cabal-sandbox
+cabal.sandbox.config
 
 {-# START_FILE Application.hs #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}

yesod-bin/hsfiles/sqlite.hsfiles

@@ -12,6 +12,8 @@ config/client_session_key.aes
 .hsenv*
 cabal-dev/
 yesod-devel/
+.cabal-sandbox
+cabal.sandbox.config
 
 {-# START_FILE Application.hs #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}

yesod-bin/main.hs

@@ -15,9 +15,10 @@ import           Options                (injectDefaults)
 import qualified Paths_yesod_bin
 import           Scaffolding.Scaffolder
 
-import           Options.Applicative.Builder.Internal (Mod, OptionFields)
 #if MIN_VERSION_optparse_applicative(0,6,0)
 import           Options.Applicative.Types (ReadM (ReadM))
+#else
+import           Options.Applicative.Builder.Internal (Mod, OptionFields)
 #endif
 
 #ifndef WINDOWS

yesod-bin/refreshing.html

@@ -58,7 +58,8 @@
       <h1>The application isn’t built</h1>
       <h2>We’ll keep trying to refresh every second</h2>
       <div class="msgs">
-        <p>Meanwhile, here are some motivational messages:</p>
+        <script> document.getElementsByClassName("msgs")[0].style.display = "none"; </script>
+        <p>Meanwhile, here is a motivational message:</p>
         <ul>
           <li>You are a beautiful person making a beautiful web site.</li>
           <li>Keep going, you’ve nearly fixed the bug!</li>
@@ -66,7 +67,20 @@
           <li>Get a glass of water, keep hydrated.</li>
         </ul>
       </div>
-      <footer><small><script>document.write(new Date())</script></small></footer>
+      <script>
+        var msg = document.getElementsByClassName("msgs")[0];
+        var lis = Array.prototype.slice.call(msg.querySelectorAll("li"));
+        lis.forEach(function(li){ li.style.display = "none"; });
+        lis[Math.floor(Math.random() * lis.length)].style.display = "block";
+        msg.style.display = "block";
+      </script>
+      <footer>
+        <small>
+          <script>
+            document.write(new Date())
+          </script>
+        </small>
+      </footer>
     </div>
   </body>
 </html>

yesod-bin/yesod-bin.cabal

@@ -1,5 +1,5 @@
 name:            yesod-bin
-version:         1.2.4
+version:         1.2.4.1
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>

yesod-static/Yesod/Static.hs

@@ -101,7 +101,7 @@ import Filesystem (createTree)
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.Encoding as TLE
 import Data.Default
-import Text.Lucius (luciusRTMinified)
+--import Text.Lucius (luciusRTMinified)
 
 import Network.Wai.Application.Static
     ( StaticSettings (..)
@@ -478,10 +478,13 @@ data CombineSettings = CombineSettings
 instance Default CombineSettings where
     def = CombineSettings
         { csStaticDir = "static"
+        {- Disabled due to: https://github.com/yesodweb/yesod/issues/623
         , csCssPostProcess = \fps ->
               either (error . (errorIntro fps)) (return . TLE.encodeUtf8)
             . flip luciusRTMinified []
             . TLE.decodeUtf8
+        -}
+        , csCssPostProcess = const return
         , csJsPostProcess = const return
            -- FIXME The following borders on a hack. With combining of files,
            -- the final location of the CSS is no longer fixed, so relative

yesod-static/yesod-static.cabal

@@ -1,5 +1,5 @@
 name:            yesod-static
-version:         1.2.1
+version:         1.2.1.1
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>