slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

web: also launch a browser at startup; auto-terminate after 2m or on enter

Browse Source 
We're now using the wai-handler-launch middleware. This injects a
script in each page that pings the server repeatedly, and terminates
the server if it gets no pings (ie there are no browser tabs
displaying the app) for two minutes. The server can also be easily
terminated at the console by pressing enter, yesod devel style.
This commit is contained in:
Simon Michael 2013-04-20 20:02:50 -07:00
parent 9148bd8e8c
commit 0a47715b17
1 changed files with 21 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
hledger-web/Hledger/Web/Main.hs
View File

@ -17,12 +17,14 @@ import Settings -- (parseExtra)
import Application (makeApplication) import Application (makeApplication)
import Data.Conduit.Network (HostPreference(HostIPv4)) import Data.Conduit.Network (HostPreference(HostIPv4))
import Network.Wai.Handler.Warp (runSettings, defaultSettings, settingsPort) import Network.Wai.Handler.Warp (runSettings, defaultSettings, settingsPort)
import Network.Wai.Handler.Launch (run, runUrl, runUrlPort) import Network.Wai.Handler.Launch (runUrlPort)
-- --
import Prelude hiding (putStrLn) import Prelude hiding (putStrLn)
import Control.Concurrent (forkIO)
import Control.Monad (when) import Control.Monad (when)
import Data.Text (pack) import Data.Text (pack)
import System.Exit (exitSuccess) import System.Exit (exitSuccess)
import System.IO (hFlush, stdout)
import Text.Printf import Text.Printf
import Hledger import Hledger
@ -54,28 +56,23 @@ withJournalDo' opts cmd = do
-- | The web command. -- | The web command.
web :: WebOpts -> Journal -> IO () web :: WebOpts -> Journal -> IO ()
web opts j = do web opts j = do
-- unless (debug_ $ cliopts_ opts) $ forkIO (browser baseurl) >> return ()
d <- getCurrentDay d <- getCurrentDay
let j' = filterJournalTransactions (queryFromOpts d $ reportopts_ $ cliopts_ opts) j let j' = filterJournalTransactions (queryFromOpts d $ reportopts_ $ cliopts_ opts) j
server (base_url_ opts) (port_ opts) opts j' p = port_ opts
u = base_url_ opts
-- browser :: String -> IO () _ <- printf "Starting http server on port %d with base url %s\n" p u
-- browser baseurl = do app <- makeApplication j' AppConfig{appEnv = Development
-- threadDelay $ fromIntegral browserstartdelay ,appPort = p
-- putStrLn "Attempting to start a web browser" ,appRoot = pack u
-- openBrowserOn baseurl >> return () ,appHost = HostIPv4
,appExtra = Extra "" Nothing
server :: String -> Int -> WebOpts -> Journal -> IO () }
server baseurl port opts j = do if False
_ <- printf "Starting http server on port %d with base url %s\n" port baseurl then
app <- makeApplication j (AppConfig { runSettings defaultSettings{settingsPort=p} app
appEnv = Development else do
, appPort = port_ opts putStrLn "Launching web browser" >> hFlush stdout
, appRoot = pack baseurl forkIO $ runUrlPort p "" app
, appHost = HostIPv4 putStrLn "Press ENTER to quit (or close browser windows for 2 minutes)" >> hFlush stdout
, appExtra = Extra "" Nothing getLine >> exitSuccess
})
-- runSettings defaultSettings
-- { settingsPort = port_ opts
-- } app
run app