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 | ||||
|             $(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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
| 
 | ||||
|  | ||||
| @ -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 | ||||
| 
 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -4,5 +4,5 @@ module Handler.RootR where | ||||
| 
 | ||||
| import Import | ||||
| 
 | ||||
| getRootR :: Handler RepHtml | ||||
| getRootR :: Handler Html | ||||
| getRootR = redirect defaultroute where defaultroute = RegisterR | ||||
|  | ||||
| @ -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)" | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 ? | ||||
|  | ||||
| @ -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 | ||||
|    | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user