move openBrowserOn to Utils
This commit is contained in:
		
							parent
							
								
									472b65c5ab
								
							
						
					
					
						commit
						1c9eb60a04
					
				@ -1,5 +1,5 @@
 | 
			
		||||
{-| 
 | 
			
		||||
A happs-based web UI for hledger.
 | 
			
		||||
A server-side-html web UI using happstack.
 | 
			
		||||
-}
 | 
			
		||||
 | 
			
		||||
module Commands.Web
 | 
			
		||||
@ -7,9 +7,6 @@ where
 | 
			
		||||
import Control.Concurrent
 | 
			
		||||
import Happstack.Server
 | 
			
		||||
import Happstack.State.Control (waitForTermination)
 | 
			
		||||
import System.Cmd (system)
 | 
			
		||||
import System.Info (os)
 | 
			
		||||
import System.Exit
 | 
			
		||||
import Network.HTTP (urlEncode, urlDecode)
 | 
			
		||||
import Text.XHtml hiding (dir)
 | 
			
		||||
 | 
			
		||||
@ -19,7 +16,7 @@ import Commands.Balance
 | 
			
		||||
import Commands.Register
 | 
			
		||||
import Commands.Print
 | 
			
		||||
import Commands.Histogram
 | 
			
		||||
import Utils (filterAndCacheLedgerWithOpts)
 | 
			
		||||
import Utils (filterAndCacheLedgerWithOpts, openBrowserOn)
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
tcpport = 5000
 | 
			
		||||
@ -31,11 +28,11 @@ web opts args l = do
 | 
			
		||||
   then do
 | 
			
		||||
    -- just run the server in the foreground
 | 
			
		||||
    putStrLn $ printf "starting web server on port %d in debug mode" tcpport
 | 
			
		||||
    simpleHTTP nullConf{port=tcpport} $ webHandlers opts args l t
 | 
			
		||||
    simpleHTTP nullConf{port=tcpport} $ handlers opts args l t
 | 
			
		||||
   else do
 | 
			
		||||
    -- start the server (in background, so we can..) then start the web browser
 | 
			
		||||
    putStrLn $ printf "starting web server on port %d" tcpport
 | 
			
		||||
    tid <- forkIO $ simpleHTTP nullConf{port=tcpport} $ webHandlers opts args l t
 | 
			
		||||
    tid <- forkIO $ simpleHTTP nullConf{port=tcpport} $ handlers opts args l t
 | 
			
		||||
    putStrLn "starting web browser"
 | 
			
		||||
    openBrowserOn $ printf "http://localhost:%d/" tcpport
 | 
			
		||||
    waitForTermination
 | 
			
		||||
@ -43,8 +40,8 @@ web opts args l = do
 | 
			
		||||
    killThread tid
 | 
			
		||||
    putStrLn "shutdown complete"
 | 
			
		||||
 | 
			
		||||
webHandlers :: [Opt] -> [String] -> Ledger -> LocalTime -> ServerPartT IO Response
 | 
			
		||||
webHandlers opts args l t = msum
 | 
			
		||||
handlers :: [Opt] -> [String] -> Ledger -> LocalTime -> ServerPartT IO Response
 | 
			
		||||
handlers opts args l t = msum
 | 
			
		||||
 [
 | 
			
		||||
  methodSP GET    $ view showBalanceReport
 | 
			
		||||
 ,dir "balance"   $ view showBalanceReport
 | 
			
		||||
@ -69,22 +66,6 @@ webHandlers opts args l t = msum
 | 
			
		||||
     r <- askRq
 | 
			
		||||
     return $ setHeader "Content-Type" "text/html" $ toResponse $ renderHtml $ hledgerview r a p s
 | 
			
		||||
 | 
			
		||||
{-
 | 
			
		||||
 <div style=\"float:right;text-align:right;\">
 | 
			
		||||
 <form action=%s>
 | 
			
		||||
   filter by: <input name=a size=30 value=\"%s\">
 | 
			
		||||
   reporting period: <input name=p size=30 value=\"%s\">
 | 
			
		||||
 %s
 | 
			
		||||
 </form>
 | 
			
		||||
 </div>
 | 
			
		||||
 <div style=\"width:100%%; font-weight:bold;\">
 | 
			
		||||
  <a href=balance%s>balance</a>
 | 
			
		||||
 | <a href=register%s>register</a>
 | 
			
		||||
 | <a href=print%s>print</a>
 | 
			
		||||
 | <a href=histogram%s>histogram</a>
 | 
			
		||||
 </div>
 | 
			
		||||
 <pre>%s</pre>
 | 
			
		||||
-}
 | 
			
		||||
hledgerview :: Request -> String -> String -> String -> Html
 | 
			
		||||
hledgerview r a p' s = body << topbar r a p' +++ pre << s
 | 
			
		||||
 | 
			
		||||
@ -130,26 +111,3 @@ navlinks _ a p' =
 | 
			
		||||
--                    [] -> Nothing
 | 
			
		||||
--                    is -> Just $ B.unpack $ inputValue $ snd $ head is
 | 
			
		||||
 | 
			
		||||
-- | Attempt to open a web browser on the given url, all platforms.
 | 
			
		||||
openBrowserOn :: String -> IO ExitCode
 | 
			
		||||
openBrowserOn u = trybrowsers browsers u
 | 
			
		||||
    where
 | 
			
		||||
      trybrowsers (b:bs) u = do
 | 
			
		||||
        e <- system $ printf "%s %s" b u
 | 
			
		||||
        case e of
 | 
			
		||||
          ExitSuccess -> return ExitSuccess
 | 
			
		||||
          ExitFailure _ -> trybrowsers bs u
 | 
			
		||||
      trybrowsers [] u = do
 | 
			
		||||
        putStrLn $ printf "Sorry, I could not start a browser (tried: %s)" $ intercalate ", " browsers
 | 
			
		||||
        putStrLn $ printf "Please open your browser and visit %s" u
 | 
			
		||||
        return $ ExitFailure 127
 | 
			
		||||
      browsers | os=="darwin"  = ["open"]
 | 
			
		||||
               | os=="mingw32" = ["start","firefox","safari","opera","iexplore"]
 | 
			
		||||
               | otherwise     = ["sensible-browser","firefox"]
 | 
			
		||||
    -- jeffz: write a ffi binding for it using the Win32 package as a basis
 | 
			
		||||
    -- start by adding System/Win32/Shell.hsc and follow the style of any
 | 
			
		||||
    -- other module in that directory for types, headers, error handling and
 | 
			
		||||
    -- what not.
 | 
			
		||||
    -- ::ShellExecute(NULL, "open", "www.somepage.com", NULL, NULL, SW_SHOWNORMAL);
 | 
			
		||||
    -- ::ShellExecute(NULL, "open", "firefox.exe", "www.somepage.com" NULL, SW_SHOWNORMAL);
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
							
								
								
									
										26
									
								
								Utils.hs
									
									
									
									
									
								
							
							
						
						
									
										26
									
								
								Utils.hs
									
									
									
									
									
								
							@ -12,6 +12,9 @@ import Ledger
 | 
			
		||||
import Options (Opt,ledgerFilePathFromOpts,optsToFilterSpec)
 | 
			
		||||
import System.Directory (doesFileExist)
 | 
			
		||||
import System.IO
 | 
			
		||||
import System.Exit
 | 
			
		||||
import System.Cmd (system)
 | 
			
		||||
import System.Info (os)
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
-- | Parse the user's specified ledger file and run a hledger command on
 | 
			
		||||
@ -49,3 +52,26 @@ readLedgerWithOpts opts args f = do
 | 
			
		||||
filterAndCacheLedgerWithOpts ::  [Opt] -> [String] -> LocalTime -> String -> RawLedger -> Ledger
 | 
			
		||||
filterAndCacheLedgerWithOpts opts args = filterAndCacheLedger . optsToFilterSpec opts args
 | 
			
		||||
 | 
			
		||||
-- | Attempt to open a web browser on the given url, all platforms.
 | 
			
		||||
openBrowserOn :: String -> IO ExitCode
 | 
			
		||||
openBrowserOn u = trybrowsers browsers u
 | 
			
		||||
    where
 | 
			
		||||
      trybrowsers (b:bs) u = do
 | 
			
		||||
        e <- system $ printf "%s %s" b u
 | 
			
		||||
        case e of
 | 
			
		||||
          ExitSuccess -> return ExitSuccess
 | 
			
		||||
          ExitFailure _ -> trybrowsers bs u
 | 
			
		||||
      trybrowsers [] u = do
 | 
			
		||||
        putStrLn $ printf "Sorry, I could not start a browser (tried: %s)" $ intercalate ", " browsers
 | 
			
		||||
        putStrLn $ printf "Please open your browser and visit %s" u
 | 
			
		||||
        return $ ExitFailure 127
 | 
			
		||||
      browsers | os=="darwin"  = ["open"]
 | 
			
		||||
               | os=="mingw32" = ["start","firefox","safari","opera","iexplore"]
 | 
			
		||||
               | otherwise     = ["sensible-browser","firefox"]
 | 
			
		||||
    -- jeffz: write a ffi binding for it using the Win32 package as a basis
 | 
			
		||||
    -- start by adding System/Win32/Shell.hsc and follow the style of any
 | 
			
		||||
    -- other module in that directory for types, headers, error handling and
 | 
			
		||||
    -- what not.
 | 
			
		||||
    -- ::ShellExecute(NULL, "open", "www.somepage.com", NULL, NULL, SW_SHOWNORMAL);
 | 
			
		||||
    -- ::ShellExecute(NULL, "open", "firefox.exe", "www.somepage.com" NULL, SW_SHOWNORMAL);
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
		Loading…
	
		Reference in New Issue
	
	Block a user