mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-19 18:29:36 +03:00
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