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:
commit
6b059aeb5e
@ -115,7 +115,7 @@ instance Yesod App where
|
|||||||
addScript $ StaticR hledger_js
|
addScript $ StaticR hledger_js
|
||||||
$(widgetFile "default-layout")
|
$(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
|
-- This is done to provide an optimization for serving static files from
|
||||||
-- a separate domain. Please see the staticRoot setting in Settings.hs
|
-- a separate domain. Please see the staticRoot setting in Settings.hs
|
||||||
|
|||||||
@ -181,7 +181,7 @@ addform _ vd@VD{..} = [hamlet|
|
|||||||
acctnames = sort $ journalAccountNamesUsed j
|
acctnames = sort $ journalAccountNamesUsed j
|
||||||
-- Construct data for select2. Text must be quoted in a json string.
|
-- 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
|
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 :: ViewData -> Int -> HtmlUrl AppRoute
|
||||||
postingfields _ n = [hamlet|
|
postingfields _ n = [hamlet|
|
||||||
<tr#postingrow>
|
<tr#postingrow>
|
||||||
@ -247,7 +247,7 @@ editform VD{..} = [hamlet|
|
|||||||
|]
|
|]
|
||||||
where
|
where
|
||||||
title = "Edit journal" :: String
|
title = "Edit journal" :: String
|
||||||
manyfiles = (length $ files j) > 1
|
manyfiles = length (files j) > 1
|
||||||
formathelp = helplink "file-format" "file format help"
|
formathelp = helplink "file-format" "file format help"
|
||||||
|
|
||||||
-- | Import journal form.
|
-- | Import journal form.
|
||||||
@ -293,10 +293,10 @@ balanceReportAsHtml _ vd@VD{..} (items',total) =
|
|||||||
<a#accounts-toggle-link.togglelink href="#" title="Toggle sidebar">[+]
|
<a#accounts-toggle-link.togglelink href="#" title="Toggle sidebar">[+]
|
||||||
<div#accounts>
|
<div#accounts>
|
||||||
<table.balancereport>
|
<table.balancereport>
|
||||||
<tr>
|
<tr.item :allaccts:.inacct>
|
||||||
<td.add colspan=3>
|
<td.register colspan=3>
|
||||||
<br>
|
<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>
|
<tr.item :allaccts:.inacct>
|
||||||
<td.journal colspan=3>
|
<td.journal colspan=3>
|
||||||
@ -309,6 +309,11 @@ balanceReportAsHtml _ vd@VD{..} (items',total) =
|
|||||||
<a#editformlink href="#" onclick="return editformToggle(event)" title="Edit the journal">
|
<a#editformlink href="#" onclick="return editformToggle(event)" title="Edit the journal">
|
||||||
edit
|
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>
|
<tr>
|
||||||
<td colspan=3>
|
<td colspan=3>
|
||||||
<br>
|
<br>
|
||||||
@ -527,7 +532,7 @@ numberTransactionsReportItems items = number 0 nulldate items
|
|||||||
where
|
where
|
||||||
number :: Int -> Day -> [TransactionsReportItem] -> [(Int,Bool,Bool,Bool,TransactionsReportItem)]
|
number :: Int -> Day -> [TransactionsReportItem] -> [(Int,Bool,Bool,Bool,TransactionsReportItem)]
|
||||||
number _ _ [] = []
|
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
|
where
|
||||||
newday = d/=prevd
|
newday = d/=prevd
|
||||||
newmonth = dm/=prevdm || dy/=prevdy
|
newmonth = dm/=prevdm || dy/=prevdy
|
||||||
|
|||||||
@ -10,12 +10,12 @@ import Handler.Utils
|
|||||||
|
|
||||||
|
|
||||||
-- | The journal editform, no sidebar.
|
-- | The journal editform, no sidebar.
|
||||||
getJournalEditR :: Handler RepHtml
|
getJournalEditR :: Handler Html
|
||||||
getJournalEditR = do
|
getJournalEditR = do
|
||||||
vd <- getViewData
|
vd <- getViewData
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
setTitle "hledger-web journal edit form"
|
setTitle "hledger-web journal edit form"
|
||||||
toWidget $ editform vd
|
toWidget $ editform vd
|
||||||
|
|
||||||
postJournalEditR :: Handler RepHtml
|
postJournalEditR :: Handler Html
|
||||||
postJournalEditR = handlePost
|
postJournalEditR = handlePost
|
||||||
|
|||||||
@ -16,7 +16,7 @@ import Hledger.Web.Options
|
|||||||
|
|
||||||
|
|
||||||
-- | The journal entries view, with sidebar.
|
-- | The journal entries view, with sidebar.
|
||||||
getJournalEntriesR :: Handler RepHtml
|
getJournalEntriesR :: Handler Html
|
||||||
getJournalEntriesR = do
|
getJournalEntriesR = do
|
||||||
vd@VD{..} <- getViewData
|
vd@VD{..} <- getViewData
|
||||||
staticRootUrl <- (staticRoot . settings) <$> getYesod
|
staticRootUrl <- (staticRoot . settings) <$> getYesod
|
||||||
@ -41,6 +41,6 @@ getJournalEntriesR = do
|
|||||||
^{importform}
|
^{importform}
|
||||||
|]
|
|]
|
||||||
|
|
||||||
postJournalEntriesR :: Handler RepHtml
|
postJournalEntriesR :: Handler Html
|
||||||
postJournalEntriesR = handlePost
|
postJournalEntriesR = handlePost
|
||||||
|
|
||||||
|
|||||||
@ -14,7 +14,7 @@ import Hledger.Cli.Options
|
|||||||
import Hledger.Web.Options
|
import Hledger.Web.Options
|
||||||
|
|
||||||
-- | The formatted journal view, with sidebar.
|
-- | The formatted journal view, with sidebar.
|
||||||
getJournalR :: Handler RepHtml
|
getJournalR :: Handler Html
|
||||||
getJournalR = do
|
getJournalR = do
|
||||||
vd@VD{..} <- getViewData
|
vd@VD{..} <- getViewData
|
||||||
staticRootUrl <- (staticRoot . settings) <$> getYesod
|
staticRootUrl <- (staticRoot . settings) <$> getYesod
|
||||||
@ -48,6 +48,6 @@ getJournalR = do
|
|||||||
^{importform}
|
^{importform}
|
||||||
|]
|
|]
|
||||||
|
|
||||||
postJournalR :: Handler RepHtml
|
postJournalR :: Handler Html
|
||||||
postJournalR = handlePost
|
postJournalR = handlePost
|
||||||
|
|
||||||
|
|||||||
@ -20,7 +20,7 @@ import Hledger.Cli
|
|||||||
|
|
||||||
|
|
||||||
-- | Handle a post from any of the edit forms.
|
-- | Handle a post from any of the edit forms.
|
||||||
handlePost :: Handler RepHtml
|
handlePost :: Handler Html
|
||||||
handlePost = do
|
handlePost = do
|
||||||
action <- lookupPostParam "action"
|
action <- lookupPostParam "action"
|
||||||
case action of Just "add" -> handleAdd
|
case action of Just "add" -> handleAdd
|
||||||
@ -29,7 +29,7 @@ handlePost = do
|
|||||||
_ -> invalidArgs ["invalid action"]
|
_ -> invalidArgs ["invalid action"]
|
||||||
|
|
||||||
-- | Handle a post from the transaction add form.
|
-- | Handle a post from the transaction add form.
|
||||||
handleAdd :: Handler RepHtml
|
handleAdd :: Handler Html
|
||||||
handleAdd = do
|
handleAdd = do
|
||||||
VD{..} <- getViewData
|
VD{..} <- getViewData
|
||||||
-- get form input values. M means a Maybe value.
|
-- get form input values. M means a Maybe value.
|
||||||
@ -91,7 +91,7 @@ handleAdd = do
|
|||||||
redirect (RegisterR, [("add","1")])
|
redirect (RegisterR, [("add","1")])
|
||||||
|
|
||||||
-- | Handle a post from the journal edit form.
|
-- | Handle a post from the journal edit form.
|
||||||
handleEdit :: Handler RepHtml
|
handleEdit :: Handler Html
|
||||||
handleEdit = do
|
handleEdit = do
|
||||||
VD{..} <- getViewData
|
VD{..} <- getViewData
|
||||||
-- get form input values, or validation errors.
|
-- get form input values, or validation errors.
|
||||||
@ -137,7 +137,7 @@ handleEdit = do
|
|||||||
jE
|
jE
|
||||||
|
|
||||||
-- | Handle a post from the journal import form.
|
-- | Handle a post from the journal import form.
|
||||||
handleImport :: Handler RepHtml
|
handleImport :: Handler Html
|
||||||
handleImport = do
|
handleImport = do
|
||||||
setMessage "can't handle file upload yet"
|
setMessage "can't handle file upload yet"
|
||||||
redirect JournalR
|
redirect JournalR
|
||||||
|
|||||||
@ -16,7 +16,7 @@ import Hledger.Cli.Options
|
|||||||
import Hledger.Web.Options
|
import Hledger.Web.Options
|
||||||
|
|
||||||
-- | The main journal/account register view, with accounts sidebar.
|
-- | The main journal/account register view, with accounts sidebar.
|
||||||
getRegisterR :: Handler RepHtml
|
getRegisterR :: Handler Html
|
||||||
getRegisterR = do
|
getRegisterR = do
|
||||||
vd@VD{..} <- getViewData
|
vd@VD{..} <- getViewData
|
||||||
staticRootUrl <- (staticRoot . settings) <$> getYesod
|
staticRootUrl <- (staticRoot . settings) <$> getYesod
|
||||||
@ -46,5 +46,5 @@ getRegisterR = do
|
|||||||
^{importform}
|
^{importform}
|
||||||
|]
|
|]
|
||||||
|
|
||||||
postRegisterR :: Handler RepHtml
|
postRegisterR :: Handler Html
|
||||||
postRegisterR = handlePost
|
postRegisterR = handlePost
|
||||||
|
|||||||
@ -4,5 +4,5 @@ module Handler.RootR where
|
|||||||
|
|
||||||
import Import
|
import Import
|
||||||
|
|
||||||
getRootR :: Handler RepHtml
|
getRootR :: Handler Html
|
||||||
getRootR = redirect defaultroute where defaultroute = RegisterR
|
getRootR = redirect defaultroute where defaultroute = RegisterR
|
||||||
|
|||||||
@ -16,8 +16,8 @@ import Yesod.Default.Config --(fromArgs)
|
|||||||
import Settings -- (parseExtra)
|
import Settings -- (parseExtra)
|
||||||
import Application (makeApplication)
|
import Application (makeApplication)
|
||||||
import Data.String
|
import Data.String
|
||||||
import Data.Conduit.Network
|
import Data.Conduit.Network hiding (setPort)
|
||||||
import Network.Wai.Handler.Warp (runSettings, defaultSettings, settingsPort)
|
import Network.Wai.Handler.Warp (runSettings, defaultSettings, setPort)
|
||||||
import Network.Wai.Handler.Launch (runUrlPort)
|
import Network.Wai.Handler.Launch (runUrlPort)
|
||||||
--
|
--
|
||||||
import Prelude hiding (putStrLn)
|
import Prelude hiding (putStrLn)
|
||||||
@ -61,19 +61,19 @@ web opts j = do
|
|||||||
let j' = filterJournalTransactions (queryFromOpts d $ reportopts_ $ cliopts_ opts) j
|
let j' = filterJournalTransactions (queryFromOpts d $ reportopts_ $ cliopts_ opts) j
|
||||||
p = port_ opts
|
p = port_ opts
|
||||||
u = base_url_ 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
|
_ <- printf "Starting web app on port %d with base url %s\n" p u
|
||||||
app <- makeApplication opts j' AppConfig{appEnv = Development
|
app <- makeApplication opts j' AppConfig{appEnv = Development
|
||||||
,appPort = p
|
,appPort = p
|
||||||
,appRoot = pack u
|
,appRoot = pack u
|
||||||
,appHost = fromString "*4"
|
,appHost = fromString "*4"
|
||||||
,appExtra = Extra "" Nothing staticRoot
|
,appExtra = Extra "" Nothing staticRoot'
|
||||||
}
|
}
|
||||||
if server_ opts
|
if server_ opts
|
||||||
then do
|
then do
|
||||||
putStrLn "Press ctrl-c to quit"
|
putStrLn "Press ctrl-c to quit"
|
||||||
hFlush stdout
|
hFlush stdout
|
||||||
runSettings defaultSettings{settingsPort=p} app
|
runSettings (setPort p defaultSettings) app
|
||||||
else do
|
else do
|
||||||
putStrLn "Starting web browser if possible"
|
putStrLn "Starting web browser if possible"
|
||||||
putStrLn "Web app will auto-exit after a few minutes with no browsers (or press ctrl-c)"
|
putStrLn "Web app will auto-exit after a few minutes with no browsers (or press ctrl-c)"
|
||||||
|
|||||||
@ -97,8 +97,8 @@ tests_Hledger_Cli = TestList
|
|||||||
,"account directive should preserve \"virtual\" posting type" ~: do
|
,"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
|
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
|
let p = head $ tpostings $ head $ jtxns j
|
||||||
assertBool "" $ (paccount p) == "test:from"
|
assertBool "" $ paccount p == "test:from"
|
||||||
assertBool "" $ (ptype p) == VirtualPosting
|
assertBool "" $ ptype p == VirtualPosting
|
||||||
|
|
||||||
]
|
]
|
||||||
|
|
||||||
@ -188,6 +188,7 @@ sample_journal_str = unlines
|
|||||||
]
|
]
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
defaultyear_journal_str :: String
|
||||||
defaultyear_journal_str = unlines
|
defaultyear_journal_str = unlines
|
||||||
["Y2009"
|
["Y2009"
|
||||||
,""
|
,""
|
||||||
@ -337,9 +338,10 @@ defaultyear_journal_str = unlines
|
|||||||
-- ,""
|
-- ,""
|
||||||
-- ]
|
-- ]
|
||||||
|
|
||||||
|
journal7 :: Journal
|
||||||
journal7 = nulljournal {jtxns =
|
journal7 = nulljournal {jtxns =
|
||||||
[
|
[
|
||||||
txnTieKnot $ Transaction {
|
txnTieKnot Transaction {
|
||||||
tdate=parsedate "2007/01/01",
|
tdate=parsedate "2007/01/01",
|
||||||
tdate2=Nothing,
|
tdate2=Nothing,
|
||||||
tstatus=False,
|
tstatus=False,
|
||||||
@ -354,7 +356,7 @@ journal7 = nulljournal {jtxns =
|
|||||||
tpreceding_comment_lines=""
|
tpreceding_comment_lines=""
|
||||||
}
|
}
|
||||||
,
|
,
|
||||||
txnTieKnot $ Transaction {
|
txnTieKnot Transaction {
|
||||||
tdate=parsedate "2007/02/01",
|
tdate=parsedate "2007/02/01",
|
||||||
tdate2=Nothing,
|
tdate2=Nothing,
|
||||||
tstatus=False,
|
tstatus=False,
|
||||||
@ -369,7 +371,7 @@ journal7 = nulljournal {jtxns =
|
|||||||
tpreceding_comment_lines=""
|
tpreceding_comment_lines=""
|
||||||
}
|
}
|
||||||
,
|
,
|
||||||
txnTieKnot $ Transaction {
|
txnTieKnot Transaction {
|
||||||
tdate=parsedate "2007/01/02",
|
tdate=parsedate "2007/01/02",
|
||||||
tdate2=Nothing,
|
tdate2=Nothing,
|
||||||
tstatus=False,
|
tstatus=False,
|
||||||
@ -384,7 +386,7 @@ journal7 = nulljournal {jtxns =
|
|||||||
tpreceding_comment_lines=""
|
tpreceding_comment_lines=""
|
||||||
}
|
}
|
||||||
,
|
,
|
||||||
txnTieKnot $ Transaction {
|
txnTieKnot Transaction {
|
||||||
tdate=parsedate "2007/01/03",
|
tdate=parsedate "2007/01/03",
|
||||||
tdate2=Nothing,
|
tdate2=Nothing,
|
||||||
tstatus=False,
|
tstatus=False,
|
||||||
@ -399,7 +401,7 @@ journal7 = nulljournal {jtxns =
|
|||||||
tpreceding_comment_lines=""
|
tpreceding_comment_lines=""
|
||||||
}
|
}
|
||||||
,
|
,
|
||||||
txnTieKnot $ Transaction {
|
txnTieKnot Transaction {
|
||||||
tdate=parsedate "2007/01/03",
|
tdate=parsedate "2007/01/03",
|
||||||
tdate2=Nothing,
|
tdate2=Nothing,
|
||||||
tstatus=False,
|
tstatus=False,
|
||||||
@ -414,7 +416,7 @@ journal7 = nulljournal {jtxns =
|
|||||||
tpreceding_comment_lines=""
|
tpreceding_comment_lines=""
|
||||||
}
|
}
|
||||||
,
|
,
|
||||||
txnTieKnot $ Transaction {
|
txnTieKnot Transaction {
|
||||||
tdate=parsedate "2007/01/03",
|
tdate=parsedate "2007/01/03",
|
||||||
tdate2=Nothing,
|
tdate2=Nothing,
|
||||||
tstatus=False,
|
tstatus=False,
|
||||||
@ -431,4 +433,5 @@ journal7 = nulljournal {jtxns =
|
|||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
|
||||||
|
ledger7 :: Ledger
|
||||||
ledger7 = ledgerFromJournal Any journal7
|
ledger7 = ledgerFromJournal Any journal7
|
||||||
|
|||||||
@ -6,6 +6,7 @@ Print a histogram report. (The "activity" command).
|
|||||||
|
|
||||||
module Hledger.Cli.Histogram
|
module Hledger.Cli.Histogram
|
||||||
where
|
where
|
||||||
|
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Ord
|
import Data.Ord
|
||||||
@ -19,7 +20,7 @@ import Hledger.Query
|
|||||||
import Prelude hiding (putStr)
|
import Prelude hiding (putStr)
|
||||||
import Hledger.Utils.UTF8IOCompat (putStr)
|
import Hledger.Utils.UTF8IOCompat (putStr)
|
||||||
|
|
||||||
|
activitymode :: Mode RawOpts
|
||||||
activitymode = (defCommandMode $ ["activity"] ++ aliases) {
|
activitymode = (defCommandMode $ ["activity"] ++ aliases) {
|
||||||
modeHelp = "show an ascii barchart of posting counts per interval (default: daily)" `withAliases` aliases
|
modeHelp = "show an ascii barchart of posting counts per interval (default: daily)" `withAliases` aliases
|
||||||
,modeHelpSuffix = []
|
,modeHelpSuffix = []
|
||||||
@ -31,6 +32,7 @@ activitymode = (defCommandMode $ ["activity"] ++ aliases) {
|
|||||||
}
|
}
|
||||||
where aliases = []
|
where aliases = []
|
||||||
|
|
||||||
|
barchar :: Char
|
||||||
barchar = '*'
|
barchar = '*'
|
||||||
|
|
||||||
-- | Print a histogram of some statistic per reporting interval, such as
|
-- | 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
|
i = intervalFromOpts opts
|
||||||
interval | i == NoInterval = Days 1
|
interval | i == NoInterval = Days 1
|
||||||
| otherwise = i
|
| otherwise = i
|
||||||
span = queryDateSpan (date2_ opts) q `spanDefaultsFrom` journalDateSpan (date2_ opts) j
|
span' = queryDateSpan (date2_ opts) q `spanDefaultsFrom` journalDateSpan (date2_ opts) j
|
||||||
spans = filter (DateSpan Nothing Nothing /=) $ splitSpan interval span
|
spans = filter (DateSpan Nothing Nothing /=) $ splitSpan interval span'
|
||||||
spanps = [(s, filter (isPostingInDateSpan s) ps) | s <- spans]
|
spanps = [(s, filter (isPostingInDateSpan s) ps) | s <- spans]
|
||||||
-- same as Register
|
-- same as Register
|
||||||
-- should count transactions, not postings ?
|
-- should count transactions, not postings ?
|
||||||
|
|||||||
@ -197,3 +197,21 @@ test-suite tests
|
|||||||
, wizards == 1.0.*
|
, wizards == 1.0.*
|
||||||
if impl(ghc >= 7.4)
|
if impl(ghc >= 7.4)
|
||||||
build-depends: pretty-show >= 1.6.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
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user