Merge branch 'master' into wai-2.0

Conflicts: yesod-bin/Devel.hs
2013-12-02 08:00:37 +02:00 · 2013-12-02 08:00:37 +02:00 · a2851c929c
commit a2851c929c
parent 3330e89e10 6b2e4ef3a4
14 changed files with 79 additions and 44 deletions
--- a/.gitignore
+++ b/.gitignore
@ -6,7 +6,9 @@ dist
 client_session_key.aes
 cabal-dev/
 yesod/foobar/
-.virthualenv
+.hsenv/
+.cabal-sandbox/
+cabal.sandbox.config
 /vendor/
 /.shelly/
 /tarballs/
--- a/yesod-bin/Devel.hs
+++ b/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"
-            threadDelay 1000000
-            putStrLn "Restarting reverse proxy"
-    loop `Ex.onException` exitFailure
+    loop runProxy `Ex.onException` exitFailure
  where
-    onExc _ _ = do
-      refreshing <- liftIO $ getDataFileName "refreshing.html"
-      html <- liftIO $ LB.readFile refreshing
-      return $ responseLBS
-        status200
-        [ ("content-type", "text/html")
-        , ("Refresh", "1")
-        ]
-        html
+    loop proxy = forever $ do
+        void proxy
+        putStrLn "Reverse proxy stopped, but it shouldn't"
+        threadDelay 1000000
+        putStrLn "Restarting reverse proxy"

 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
-    unless avail $ error "devel port unavailable"
+    unlessM (checkPort $ develPort opts) $ 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)
-                                ([ "configure"
+  checkExit =<< createProcess (proc (cabalProgram opts) $
+                                 [ "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)
--- a/yesod-bin/Options.hs
+++ b/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
--- a/yesod-bin/hsfiles/mongo.hsfiles
+++ b/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 #-}
--- a/yesod-bin/hsfiles/mysql.hsfiles
+++ b/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 #-}
--- a/yesod-bin/hsfiles/postgres-fay.hsfiles
+++ b/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 #-}
--- a/yesod-bin/hsfiles/postgres.hsfiles
+++ b/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 #-}
--- a/yesod-bin/hsfiles/simple.hsfiles
+++ b/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 #-}
--- a/yesod-bin/hsfiles/sqlite.hsfiles
+++ b/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 #-}
--- a/yesod-bin/main.hs
+++ b/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
--- a/yesod-bin/refreshing.html
+++ b/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>
--- a/yesod-bin/yesod-bin.cabal
+++ b/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>
--- a/yesod-static/Yesod/Static.hs
+++ b/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
--- a/yesod-static/yesod-static.cabal
+++ b/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>