Merge branch 'rdesfo-0.23'

Conflicts:
	.version
	hledger-lib/Hledger/Read/CsvReader.hs
	hledger-lib/hledger-lib.cabal
	hledger-web/hledger-web.cabal
	hledger/hledger.cabal
This commit is contained in:
Simon Michael 2014-05-22 16:15:35 -07:00
commit 6b059aeb5e
12 changed files with 64 additions and 36 deletions

View File

@ -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

View File

@ -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|
<tr#postingrow>
@ -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) =
<a#accounts-toggle-link.togglelink href="#" title="Toggle sidebar">[+]
<div#accounts>
<table.balancereport>
<tr>
<td.add colspan=3>
<tr.item :allaccts:.inacct>
<td.register colspan=3>
<br>
<a#addformlink href="#" onclick="return addformToggle(event)" title="Add a new transaction to the journal">Add a transaction..
<a href=@{RegisterR} title="Show current register">Register
<tr.item :allaccts:.inacct>
<td.journal colspan=3>
@ -309,6 +309,11 @@ balanceReportAsHtml _ vd@VD{..} (items',total) =
<a#editformlink href="#" onclick="return editformToggle(event)" title="Edit the journal">
edit
<tr>
<td.add colspan=3>
<br>
<a#addformlink href="#" onclick="return addformToggle(event)" title="Add a new transaction to the journal">Add a transaction..
<tr>
<td colspan=3>
<br>
@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -4,5 +4,5 @@ module Handler.RootR where
import Import
getRootR :: Handler RepHtml
getRootR :: Handler Html
getRootR = redirect defaultroute where defaultroute = RegisterR

View File

@ -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)"

View File

@ -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

View File

@ -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 ?

View File

@ -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