hledger/hledger-web/Hledger/Web/Main.hs

79 lines
2.8 KiB
Haskell

{-|
hledger-web - a hledger add-on providing a web interface.
Copyright (c) 2007-2012 Simon Michael <simon@joyful.com>
Released under GPL version 3 or later.
-}
module Hledger.Web.Main
where
-- yesod scaffold imports
import Prelude (IO)
import Yesod.Default.Config --(fromArgs)
-- import Yesod.Default.Main (defaultMain)
import Settings -- (parseExtra)
import Application (makeApplication)
import Data.Conduit.Network (HostPreference(HostIPv4))
import Network.Wai.Handler.Warp (runSettings, defaultSettings, settingsPort)
import Network.Wai.Handler.Launch (runUrlPort)
--
import Prelude hiding (putStrLn)
import Control.Monad (when)
import Data.Text (pack)
import System.Exit (exitSuccess)
import System.IO (hFlush, stdout)
import Text.Printf
import Hledger
import Hledger.Utils.UTF8IOCompat (putStrLn)
import Hledger.Cli hiding (progname,prognameandversion)
import Hledger.Web.Options
main :: IO ()
main = do
opts <- getHledgerWebOpts
when (debug_ $ cliopts_ opts) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show opts)
runWith opts
runWith :: WebOpts -> IO ()
runWith opts
| "help" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStr (showModeHelp webmode) >> exitSuccess
| "version" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStrLn prognameandversion >> exitSuccess
| "binary-filename" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname)
| otherwise = do
requireJournalFileExists =<< journalFilePathFromOpts (cliopts_ opts)
withJournalDo' opts web
withJournalDo' :: WebOpts -> (WebOpts -> Journal -> IO ()) -> IO ()
withJournalDo' opts cmd = do
journalFilePathFromOpts (cliopts_ opts) >>= readJournalFile Nothing Nothing >>=
either error' (cmd opts . journalApplyAliases (aliasesFromOpts $ cliopts_ opts))
-- | The web command.
web :: WebOpts -> Journal -> IO ()
web opts j = do
d <- getCurrentDay
let j' = filterJournalTransactions (queryFromOpts d $ reportopts_ $ cliopts_ opts) j
p = port_ opts
u = base_url_ opts
_ <- printf "Starting web app on port %d with base url %s\n" p u
app <- makeApplication opts j' AppConfig{appEnv = Development
,appPort = p
,appRoot = pack u
,appHost = HostIPv4
,appExtra = Extra "" Nothing
}
if server_ opts
then do
putStrLn "Press ctrl-c to quit"
hFlush stdout
runSettings defaultSettings{settingsPort=p} app
else do
putStrLn "Starting web browser if possible"
putStrLn "Web app will auto-exit after a few minutes with no browsers (or press ctrl-c)"
hFlush stdout
runUrlPort p "" app