module Hledger.Web.Main
where
import Yesod.Default.Config --(fromArgs)
import Settings
import Application (makeApplication)
import Data.String
import Network.Wai.Handler.Warp (runSettings, defaultSettings, setHost, setPort)
import Network.Wai.Handler.Launch (runHostPortUrl)
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Control.Monad (when)
import Data.Text (pack)
import System.Exit (exitSuccess)
import System.IO (hFlush, stdout)
import Text.Printf
import Prelude hiding (putStrLn)
import Hledger
import Hledger.Utils.UTF8IOCompat (putStrLn)
import Hledger.Cli hiding (progname,prognameandversion)
import Hledger.Web.WebOptions
hledgerWebMain :: IO ()
hledgerWebMain = do
opts <- getHledgerWebOpts
when (debug_ (cliopts_ opts) > 0) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show opts)
runWith opts
runWith :: WebOpts -> IO ()
runWith opts
| "h" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStr (showModeUsage webmode) >> exitSuccess
| "help" `inRawOpts` (rawopts_ $ cliopts_ opts) = printHelpForTopic (topicForMode webmode) >> exitSuccess
| "man" `inRawOpts` (rawopts_ $ cliopts_ opts) = runManForTopic (topicForMode webmode) >> exitSuccess
| "info" `inRawOpts` (rawopts_ $ cliopts_ opts) = runInfoForTopic (topicForMode webmode) >> exitSuccess
| "version" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStrLn prognameandversion >> exitSuccess
| "binary-filename" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname)
| otherwise = do
requireJournalFileExists =<< (head `fmap` journalFilePathFromOpts (cliopts_ opts))
withJournalDo' opts web
withJournalDo' :: WebOpts -> (WebOpts -> Journal -> IO ()) -> IO ()
withJournalDo' opts cmd = do
f <- head `fmap` journalFilePathFromOpts (cliopts_ opts)
when (f == "-") $ error' "hledger-web doesn't support -f -, please specify a file path"
readJournalFile Nothing Nothing True f >>=
either error' (cmd opts . journalApplyAliases (aliasesFromOpts $ cliopts_ opts))
web :: WebOpts -> Journal -> IO ()
web opts j = do
d <- getCurrentDay
let initq = queryFromOpts d $ reportopts_ $ cliopts_ opts
j' = filterJournalTransactions initq j
h = host_ opts
p = port_ opts
u = base_url_ opts
staticRoot = pack <$> file_url_ opts
appconfig = AppConfig{appEnv = Development
,appHost = fromString h
,appPort = p
,appRoot = pack u
,appExtra = Extra "" Nothing staticRoot
}
app <- makeApplication opts j' appconfig
_ <- printf "Starting web app on IP address %s port %d with base url %s\n" h p u
if serve_ opts
then do
putStrLn "Press ctrl-c to quit"
hFlush stdout
let warpsettings =
setHost (fromString h) $
setPort p $
defaultSettings
Network.Wai.Handler.Warp.runSettings warpsettings app
else do
putStrLn "Starting web browser..."
putStrLn "Web app will auto-exit after a few minutes with no browsers (or press ctrl-c)"
hFlush stdout
Network.Wai.Handler.Launch.runHostPortUrl h p "" app