open url on launch of web server (issue 6460061)

[mz...@google.com]

Reviewers: thecomfyshell_googlegroups.com, Jasvir Nagra,

Message:
review please

Description:
open url on launch of web server

simple implementation of this feature: just call xdg-open (or if that
fails, open) after sleep 1 second when we run the web server.

see issue #3 for related features this CL is _not_ trying to solve:
http://code.google.com/p/plush/issues/detail?id=3

Please review this at http://codereview.appspot.com/6460061/

Affected files:
M src/Plush/Server.hs


Index: src/Plush/Server.hs
diff --git a/src/Plush/Server.hs b/src/Plush/Server.hs
index
73a55181608d05baa30694c2fd26f8a8fc11d57e..5fc18970520969fb4c6213e42027c18348c681c1
100644
--- a/src/Plush/Server.hs
+++ b/src/Plush/Server.hs
@@ -22,7 +22,8 @@ module Plush.Server (
where


-import Control.Monad (replicateM)
+import Control.Concurrent (forkIO)
+import Control.Monad (replicateM, void)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Network.HTTP.Types
@@ -31,9 +32,11 @@ import Network.Wai.Middleware.Route
import Network.Wai.Middleware.Static
import System.FilePath
import System.IO
+import System.Posix (sleep)
import System.Random

import Plush.Job
+import Plush.Parser
import Plush.Run
import Plush.Server.API
import Plush.Server.Utilities
@@ -44,15 +47,20 @@ import Plush.Utilities
-- shell exits.
server :: Runner -> Maybe Int -> IO ()
server runner port = do
- (shellThread, origOut, _origErr) <- startShell runner
+ (shellThread, origOut, origErr) <- startShell runner
staticPath <- (</> "static") `fmap` getDataDir
key <- genKey
hPutStrLn origOut $ "Starting server, connect to: " ++ startUrl key
+ case parseNextCommand (openCmd $ startUrl key) of
+ Right (cl, _rest) -> void $ forkIO $ launchOpen shellThread cl
+ Left errs -> hPutStrLn origErr errs
Warp.run port' $ application shellThread key staticPath
where
port' = fromMaybe 29544 port
genKey = replicateM 40 $ randomRIO ('a','z')
startUrl key = "http://localhost:" ++ show port' ++ "/index.html#" ++
key
+ openCmd url = "xdg-open " ++ url ++ " 2>/dev/null || open " ++ url
+ launchOpen st cl = sleep 1 >> submitJob st "opener" cl


application shellThread key staticPath = dispatch

[jas...@gmail.com]

LGTM


http://codereview.appspot.com/6460061/diff/1/src/Plush/Server.hs
File src/Plush/Server.hs (right):

http://codereview.appspot.com/6460061/diff/1/src/Plush/Server.hs#newcode62
src/Plush/Server.hs:62: openCmd url = "xdg-open " ++ url ++ "

2>/dev/null || open " ++ url

clever.

http://codereview.appspot.com/6460061/