git.iko.soy/typeable/wai
on master help sign in
Initial Windows code
commitdda3a765abb2af5d6f7c6ed3c5af5df76692f74b authorMichael <michael@snoyman.com> dateTue 24 May 2011, 10:22 (15 years ago) parent4a9a8ff
6 files changed+125
compare with master
unifiedsplit
LICENSE+30 Network/Wai/Handler/Launch.hs+54 Setup.hs+2 test.hs+6 wai-handler-launch.cabal+26 windows.c+7
LICENSEnew file+30
@@ -0,0 +1,30 @@
1+Copyright (c)2011, Michael Snoyman
2+
3+All rights reserved.
4+
5+Redistribution and use in source and binary forms, with or without
6+modification, are permitted provided that the following conditions are met:
7+
8+ * Redistributions of source code must retain the above copyright
9+ notice, this list of conditions and the following disclaimer.
10+
11+ * Redistributions in binary form must reproduce the above
12+ copyright notice, this list of conditions and the following
13+ disclaimer in the documentation and/or other materials provided
14+ with the distribution.
15+
16+ * Neither the name of Michael Snoyman nor the names of other
17+ contributors may be used to endorse or promote products derived
18+ from this software without specific prior written permission.
19+
20+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
Network/Wai/Handler/Launch.hsnew file+54
@@ -0,0 +1,54 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE ForeignFunctionInterface #-}
3+{-# LANGUAGE CPP #-}
4+module Network.Wai.Handler.Launch (run) where
5+
6+import Network.Wai
7+import Network.HTTP.Types
8+import qualified Network.Wai.Handler.Warp as Warp
9+import Data.IORef
10+import Control.Concurrent
11+import Foreign
12+import Foreign.C.String
13+import Control.Monad.IO.Class (liftIO)
14+import qualified Data.ByteString as S
15+import Data.Enumerator (($$), enumList)
16+import Blaze.ByteString.Builder (fromByteString)
17+
18+ping :: IORef Bool -> Middleware
19+ping var app req
20+ | pathInfo req == ["_ping"] = do
21+ liftIO $ writeIORef var True
22+ return $ responseLBS status200 [] ""
23+ | otherwise = do
24+ res <- app req
25+ let renum = responseEnumerator res
26+ return $ ResponseEnumerator $ \f -> do
27+ renum $ \status headers -> do
28+ case lookup "content-type" headers of
29+ Just ct
30+ | "text/html" `S.isPrefixOf` ct -> do
31+ enumList 1 [fromByteString "<script>setInterval(function(){var x;if(window.XMLHttpRequest){x=new XMLHttpRequest();}else{x=new ActiveXObject(\"Microsoft.XMLHTTP\");}x.open(\"GET\",\"/_ping\",false);x.send();},1000)</script>"] $$ f status headers
32+ _ -> f status headers
33+
34+#if WINDOWS
35+foreign import ccall "launch"
36+ launch :: IO ()
37+#else
38+#endif
39+
40+run :: Application -> IO ()
41+run app = do
42+ x <- newIORef True
43+ forkIO $ Warp.run 4587 $ ping x app
44+ launch
45+ loop x
46+
47+loop :: IORef Bool -> IO ()
48+loop x = do
49+ let seconds = 2
50+ threadDelay $ 1000000 * seconds
51+ b <- readIORef x
52+ if b
53+ then writeIORef x False >> loop x
54+ else return ()
Setup.hsnew file+2
@@ -0,0 +1,2 @@
1+import Distribution.Simple
2+main = defaultMain
test.hsnew file+6
@@ -0,0 +1,6 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+import Network.Wai
3+import Network.HTTP.Types
4+import Network.Wai.Handler.Launch
5+
6+main = run $ \_ -> return $ responseLBS status200 [("Content-Type", "text/html; charset=utf8")] "HELLO THERE"
wai-handler-launch.cabalnew file+26
@@ -0,0 +1,26 @@
1+Name: wai-handler-launch
2+Version: 0.0.0
3+Synopsis: Launch a web app in the default browser.
4+Description: This handles cross-platform launching and inserts Javascript code to ping the server. When the server no longer receives pings, it shuts down.
5+License: BSD3
6+License-file: LICENSE
7+Author: Michael Snoyman
8+Maintainer: michael@snoyman.com
9+Category: Web
10+Build-type: Simple
11+Cabal-version: >=1.2
12+
13+Library
14+ Exposed-modules: Network.Wai.Handler.Launch
15+ build-depends: base >= 4 && < 5
16+ , wai >= 0.4 && < 0.5
17+ , warp >= 0.4 && < 0.5
18+ , http-types >= 0.6 && < 0.7
19+ , transformers >= 0.2 && < 0.3
20+ , bytestring >= 0.9 && < 1
21+ , blaze-builder >= 0.3 && < 0.4
22+ , enumerator >= 0.4 && < 0.5
23+ if os(windows)
24+ c-sources: windows.c
25+ cpp-options: -DWINDOWS
26+ extra-libraries: Shell32
windows.cnew file+7
@@ -0,0 +1,7 @@
1+#include <windows.h>
2+#include <shellapi.h>
3+
4+void launch(void)
5+{
6+ ShellExecute(NULL, "open", "http://localhost:4587/", NULL, NULL, SW_SHOWNORMAL);
7+}