diff --git a/hledger-web/Foundation.hs b/hledger-web/Foundation.hs index ebedca187..05348014e 100644 --- a/hledger-web/Foundation.hs +++ b/hledger-web/Foundation.hs @@ -115,7 +115,7 @@ instance Yesod App where addScript $ StaticR hledger_js $(widgetFile "default-layout") - hamletToRepHtml $(hamletFile "templates/default-layout-wrapper.hamlet") + giveUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") -- This is done to provide an optimization for serving static files from -- a separate domain. Please see the staticRoot setting in Settings.hs diff --git a/hledger-web/Handler/Common.hs b/hledger-web/Handler/Common.hs index dbf2a1c9b..c6ae14ded 100644 --- a/hledger-web/Handler/Common.hs +++ b/hledger-web/Handler/Common.hs @@ -181,7 +181,7 @@ addform _ vd@VD{..} = [hamlet| acctnames = sort $ journalAccountNamesUsed j -- Construct data for select2. Text must be quoted in a json string. toSelectData as = preEscapedString $ encode $ JSArray $ map (\a -> JSObject $ toJSObject [("text", showJSON a)]) as - manyfiles = (length $ files j) > 1 + manyfiles = length (files j) > 1 postingfields :: ViewData -> Int -> HtmlUrl AppRoute postingfields _ n = [hamlet| @@ -247,7 +247,7 @@ editform VD{..} = [hamlet| |] where title = "Edit journal" :: String - manyfiles = (length $ files j) > 1 + manyfiles = length (files j) > 1 formathelp = helplink "file-format" "file format help" -- | Import journal form. @@ -293,10 +293,10 @@ balanceReportAsHtml _ vd@VD{..} (items',total) = [+] - - + +
- Add a transaction.. + Register @@ -309,6 +309,11 @@ balanceReportAsHtml _ vd@VD{..} (items',total) = edit + + +
+ Add a transaction.. +
@@ -527,7 +532,7 @@ numberTransactionsReportItems items = number 0 nulldate items where number :: Int -> Day -> [TransactionsReportItem] -> [(Int,Bool,Bool,Bool,TransactionsReportItem)] number _ _ [] = [] - number n prevd (i@(Transaction{tdate=d},_,_,_,_,_):rest) = (n+1,newday,newmonth,newyear,i):(number (n+1) d rest) + number n prevd (i@(Transaction{tdate=d},_,_,_,_,_):rest) = (n+1,newday,newmonth,newyear,i): number (n+1) d rest where newday = d/=prevd newmonth = dm/=prevdm || dy/=prevdy diff --git a/hledger-web/Handler/JournalEditR.hs b/hledger-web/Handler/JournalEditR.hs index 6ef40517a..4d890c6dd 100644 --- a/hledger-web/Handler/JournalEditR.hs +++ b/hledger-web/Handler/JournalEditR.hs @@ -10,12 +10,12 @@ import Handler.Utils -- | The journal editform, no sidebar. -getJournalEditR :: Handler RepHtml +getJournalEditR :: Handler Html getJournalEditR = do vd <- getViewData defaultLayout $ do setTitle "hledger-web journal edit form" toWidget $ editform vd -postJournalEditR :: Handler RepHtml +postJournalEditR :: Handler Html postJournalEditR = handlePost diff --git a/hledger-web/Handler/JournalEntriesR.hs b/hledger-web/Handler/JournalEntriesR.hs index 56fb8f6db..127d137cc 100644 --- a/hledger-web/Handler/JournalEntriesR.hs +++ b/hledger-web/Handler/JournalEntriesR.hs @@ -16,7 +16,7 @@ import Hledger.Web.Options -- | The journal entries view, with sidebar. -getJournalEntriesR :: Handler RepHtml +getJournalEntriesR :: Handler Html getJournalEntriesR = do vd@VD{..} <- getViewData staticRootUrl <- (staticRoot . settings) <$> getYesod @@ -41,6 +41,6 @@ getJournalEntriesR = do ^{importform} |] -postJournalEntriesR :: Handler RepHtml +postJournalEntriesR :: Handler Html postJournalEntriesR = handlePost diff --git a/hledger-web/Handler/JournalR.hs b/hledger-web/Handler/JournalR.hs index 1cbd10e29..7c9276e47 100644 --- a/hledger-web/Handler/JournalR.hs +++ b/hledger-web/Handler/JournalR.hs @@ -14,7 +14,7 @@ import Hledger.Cli.Options import Hledger.Web.Options -- | The formatted journal view, with sidebar. -getJournalR :: Handler RepHtml +getJournalR :: Handler Html getJournalR = do vd@VD{..} <- getViewData staticRootUrl <- (staticRoot . settings) <$> getYesod @@ -48,6 +48,6 @@ getJournalR = do ^{importform} |] -postJournalR :: Handler RepHtml +postJournalR :: Handler Html postJournalR = handlePost diff --git a/hledger-web/Handler/Post.hs b/hledger-web/Handler/Post.hs index dae62f597..f46403538 100644 --- a/hledger-web/Handler/Post.hs +++ b/hledger-web/Handler/Post.hs @@ -20,7 +20,7 @@ import Hledger.Cli -- | Handle a post from any of the edit forms. -handlePost :: Handler RepHtml +handlePost :: Handler Html handlePost = do action <- lookupPostParam "action" case action of Just "add" -> handleAdd @@ -29,7 +29,7 @@ handlePost = do _ -> invalidArgs ["invalid action"] -- | Handle a post from the transaction add form. -handleAdd :: Handler RepHtml +handleAdd :: Handler Html handleAdd = do VD{..} <- getViewData -- get form input values. M means a Maybe value. @@ -91,7 +91,7 @@ handleAdd = do redirect (RegisterR, [("add","1")]) -- | Handle a post from the journal edit form. -handleEdit :: Handler RepHtml +handleEdit :: Handler Html handleEdit = do VD{..} <- getViewData -- get form input values, or validation errors. @@ -137,7 +137,7 @@ handleEdit = do jE -- | Handle a post from the journal import form. -handleImport :: Handler RepHtml +handleImport :: Handler Html handleImport = do setMessage "can't handle file upload yet" redirect JournalR diff --git a/hledger-web/Handler/RegisterR.hs b/hledger-web/Handler/RegisterR.hs index 2b91cf4bd..9addca3b2 100644 --- a/hledger-web/Handler/RegisterR.hs +++ b/hledger-web/Handler/RegisterR.hs @@ -16,7 +16,7 @@ import Hledger.Cli.Options import Hledger.Web.Options -- | The main journal/account register view, with accounts sidebar. -getRegisterR :: Handler RepHtml +getRegisterR :: Handler Html getRegisterR = do vd@VD{..} <- getViewData staticRootUrl <- (staticRoot . settings) <$> getYesod @@ -46,5 +46,5 @@ getRegisterR = do ^{importform} |] -postRegisterR :: Handler RepHtml +postRegisterR :: Handler Html postRegisterR = handlePost diff --git a/hledger-web/Handler/RootR.hs b/hledger-web/Handler/RootR.hs index 2d9c64044..5437efd9e 100644 --- a/hledger-web/Handler/RootR.hs +++ b/hledger-web/Handler/RootR.hs @@ -4,5 +4,5 @@ module Handler.RootR where import Import -getRootR :: Handler RepHtml +getRootR :: Handler Html getRootR = redirect defaultroute where defaultroute = RegisterR diff --git a/hledger-web/Hledger/Web/Main.hs b/hledger-web/Hledger/Web/Main.hs index 3eba8f72c..af0100a6e 100644 --- a/hledger-web/Hledger/Web/Main.hs +++ b/hledger-web/Hledger/Web/Main.hs @@ -16,8 +16,8 @@ import Yesod.Default.Config --(fromArgs) import Settings -- (parseExtra) import Application (makeApplication) import Data.String -import Data.Conduit.Network -import Network.Wai.Handler.Warp (runSettings, defaultSettings, settingsPort) +import Data.Conduit.Network hiding (setPort) +import Network.Wai.Handler.Warp (runSettings, defaultSettings, setPort) import Network.Wai.Handler.Launch (runUrlPort) -- import Prelude hiding (putStrLn) @@ -61,19 +61,19 @@ web opts j = do let j' = filterJournalTransactions (queryFromOpts d $ reportopts_ $ cliopts_ opts) j p = port_ opts u = base_url_ opts - staticRoot = pack <$> static_root_ opts + staticRoot' = pack <$> static_root_ 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 = fromString "*4" - ,appExtra = Extra "" Nothing staticRoot + ,appExtra = Extra "" Nothing staticRoot' } if server_ opts then do putStrLn "Press ctrl-c to quit" hFlush stdout - runSettings defaultSettings{settingsPort=p} app + runSettings (setPort p defaultSettings) 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)" diff --git a/hledger/Hledger/Cli.hs b/hledger/Hledger/Cli.hs index 8f3f821ee..21fca23bc 100644 --- a/hledger/Hledger/Cli.hs +++ b/hledger/Hledger/Cli.hs @@ -97,8 +97,8 @@ tests_Hledger_Cli = TestList ,"account directive should preserve \"virtual\" posting type" ~: do j <- readJournal Nothing Nothing Nothing "!account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return let p = head $ tpostings $ head $ jtxns j - assertBool "" $ (paccount p) == "test:from" - assertBool "" $ (ptype p) == VirtualPosting + assertBool "" $ paccount p == "test:from" + assertBool "" $ ptype p == VirtualPosting ] @@ -188,6 +188,7 @@ sample_journal_str = unlines ] -} +defaultyear_journal_str :: String defaultyear_journal_str = unlines ["Y2009" ,"" @@ -337,9 +338,10 @@ defaultyear_journal_str = unlines -- ,"" -- ] +journal7 :: Journal journal7 = nulljournal {jtxns = [ - txnTieKnot $ Transaction { + txnTieKnot Transaction { tdate=parsedate "2007/01/01", tdate2=Nothing, tstatus=False, @@ -354,7 +356,7 @@ journal7 = nulljournal {jtxns = tpreceding_comment_lines="" } , - txnTieKnot $ Transaction { + txnTieKnot Transaction { tdate=parsedate "2007/02/01", tdate2=Nothing, tstatus=False, @@ -369,7 +371,7 @@ journal7 = nulljournal {jtxns = tpreceding_comment_lines="" } , - txnTieKnot $ Transaction { + txnTieKnot Transaction { tdate=parsedate "2007/01/02", tdate2=Nothing, tstatus=False, @@ -384,7 +386,7 @@ journal7 = nulljournal {jtxns = tpreceding_comment_lines="" } , - txnTieKnot $ Transaction { + txnTieKnot Transaction { tdate=parsedate "2007/01/03", tdate2=Nothing, tstatus=False, @@ -399,7 +401,7 @@ journal7 = nulljournal {jtxns = tpreceding_comment_lines="" } , - txnTieKnot $ Transaction { + txnTieKnot Transaction { tdate=parsedate "2007/01/03", tdate2=Nothing, tstatus=False, @@ -414,7 +416,7 @@ journal7 = nulljournal {jtxns = tpreceding_comment_lines="" } , - txnTieKnot $ Transaction { + txnTieKnot Transaction { tdate=parsedate "2007/01/03", tdate2=Nothing, tstatus=False, @@ -431,4 +433,5 @@ journal7 = nulljournal {jtxns = ] } +ledger7 :: Ledger ledger7 = ledgerFromJournal Any journal7 diff --git a/hledger/Hledger/Cli/Histogram.hs b/hledger/Hledger/Cli/Histogram.hs index af88305b5..97693ce5a 100644 --- a/hledger/Hledger/Cli/Histogram.hs +++ b/hledger/Hledger/Cli/Histogram.hs @@ -6,6 +6,7 @@ Print a histogram report. (The "activity" command). module Hledger.Cli.Histogram where + import Data.List import Data.Maybe import Data.Ord @@ -19,7 +20,7 @@ import Hledger.Query import Prelude hiding (putStr) import Hledger.Utils.UTF8IOCompat (putStr) - +activitymode :: Mode RawOpts activitymode = (defCommandMode $ ["activity"] ++ aliases) { modeHelp = "show an ascii barchart of posting counts per interval (default: daily)" `withAliases` aliases ,modeHelpSuffix = [] @@ -31,6 +32,7 @@ activitymode = (defCommandMode $ ["activity"] ++ aliases) { } where aliases = [] +barchar :: Char barchar = '*' -- | Print a histogram of some statistic per reporting interval, such as @@ -46,8 +48,8 @@ showHistogram opts q j = concatMap (printDayWith countBar) spanps i = intervalFromOpts opts interval | i == NoInterval = Days 1 | otherwise = i - span = queryDateSpan (date2_ opts) q `spanDefaultsFrom` journalDateSpan (date2_ opts) j - spans = filter (DateSpan Nothing Nothing /=) $ splitSpan interval span + span' = queryDateSpan (date2_ opts) q `spanDefaultsFrom` journalDateSpan (date2_ opts) j + spans = filter (DateSpan Nothing Nothing /=) $ splitSpan interval span' spanps = [(s, filter (isPostingInDateSpan s) ps) | s <- spans] -- same as Register -- should count transactions, not postings ? diff --git a/hledger/hledger.cabal b/hledger/hledger.cabal index a7070cf13..46c3ffd99 100644 --- a/hledger/hledger.cabal +++ b/hledger/hledger.cabal @@ -197,3 +197,21 @@ test-suite tests , wizards == 1.0.* if impl(ghc >= 7.4) build-depends: pretty-show >= 1.6.4 + +benchmark bench + type: exitcode-stdio-1.0 +-- hs-source-dirs: src + main-is: ../tools/simplebench.hs + ghc-options: -Wall + default-language: Haskell2010 + build-depends: hledger-lib, + hledger, + base >= 4.3 && < 5, + old-locale, + time, + html, + tabular >= 0.2 && < 0.3, + process, + filepath, + directory +