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