lib, app, web, ui: rename readJournalFile[s]WithOpts to readJournalFile, same for tryReader[s]WithOpts
This commit is contained in:
		
							parent
							
								
									2bed041135
								
							
						
					
					
						commit
						f6ec26e321
					
				
							
								
								
									
										13
									
								
								dev.hs
									
									
									
									
									
								
							
							
						
						
									
										13
									
								
								dev.hs
									
									
									
									
									
								
							| @ -13,6 +13,7 @@ import System.TimeIt      (timeItT) | |||||||
| import Text.Printf | import Text.Printf | ||||||
| 
 | 
 | ||||||
| import Hledger | import Hledger | ||||||
|  | import Data.Default (def) | ||||||
| -- import Hledger.Utils.Regex (toRegexCI) | -- import Hledger.Utils.Regex (toRegexCI) | ||||||
| -- import Hledger.Utils.Debug | -- import Hledger.Utils.Debug | ||||||
| -- import qualified Hledger.Read.JournalReader as JR | -- import qualified Hledger.Read.JournalReader as JR | ||||||
| @ -46,18 +47,18 @@ timeit name action = do | |||||||
|   return (t,a) |   return (t,a) | ||||||
| 
 | 
 | ||||||
| timeReadJournal :: String -> String -> IO (Double, Journal) | timeReadJournal :: String -> String -> IO (Double, Journal) | ||||||
| timeReadJournal msg s = timeit msg $ either error id <$> readJournal Nothing Nothing True Nothing s | timeReadJournal msg s = timeit msg $ either error id <$> readJournal def Nothing s | ||||||
| 
 | 
 | ||||||
| main = do | main = do | ||||||
|   -- putStrLn $ regexReplaceCI "^aa" "xx" "aa:bb:cc:dd:ee" |   -- putStrLn $ regexReplaceCI "^aa" "xx" "aa:bb:cc:dd:ee" | ||||||
| 
 | 
 | ||||||
|   (_t0,_j) <- timeit ("read "++journal) $ either error id <$> readJournalFileWithOpts def journal |   (_t0,_j) <- timeit ("read "++journal) $ either error id <$> readJournalFile def journal | ||||||
|   return () |   return () | ||||||
|   -- printf "Total: %0.2fs\n" (sum [t0,t1,t2,t3,t4]) |   -- printf "Total: %0.2fs\n" (sum [t0,t1,t2,t3,t4]) | ||||||
| 
 | 
 | ||||||
|   -- -- read the input journal |   -- -- read the input journal | ||||||
|   -- s <- readFile journal |   -- s <- readFile journal | ||||||
|   -- j <- either error id <$> readJournal Nothing Nothing True Nothing s |   -- j <- either error id <$> readJournal def Nothing s | ||||||
|   -- -- putStrLn $ show $ length $ jtxns j -- sanity check we parsed it all |   -- -- putStrLn $ show $ length $ jtxns j -- sanity check we parsed it all | ||||||
|   -- let accts = map paccount $ journalPostings j |   -- let accts = map paccount $ journalPostings j | ||||||
| 
 | 
 | ||||||
| @ -82,10 +83,10 @@ main = do | |||||||
| 
 | 
 | ||||||
|   --   -- ,bench ("readJournal") $ whnfIO $ |   --   -- ,bench ("readJournal") $ whnfIO $ | ||||||
|   --   --    either error id <$> |   --   --    either error id <$> | ||||||
|   --   --    readJournal Nothing Nothing True Nothing s |   --   --    readJournal def Nothing s | ||||||
|   --   -- ,bench ("readJournal with aliases") $ whnfIO $ |   --   -- ,bench ("readJournal with aliases") $ whnfIO $ | ||||||
|   --   --    either error id <$> |   --   --    either error id <$> | ||||||
|   --   --    readJournal Nothing Nothing True Nothing ( |   --   --    readJournal def Nothing ( | ||||||
|   --   --      unlines [ |   --   --      unlines [ | ||||||
|   --   --         "alias /^fb:/=xx \n" |   --   --         "alias /^fb:/=xx \n" | ||||||
|   --   --         ,"alias /^f1:/=xx \n" |   --   --         ,"alias /^f1:/=xx \n" | ||||||
| @ -156,7 +157,7 @@ main = do | |||||||
| -- benchWithTimeit = do | -- benchWithTimeit = do | ||||||
| --   getCurrentDirectory >>= printf "Benchmarking hledger in %s with timeit\n" | --   getCurrentDirectory >>= printf "Benchmarking hledger in %s with timeit\n" | ||||||
| --   let opts = defcliopts{output_file_=Just outputfile} | --   let opts = defcliopts{output_file_=Just outputfile} | ||||||
| --   (t0,j) <- timeit ("read "++inputfile) $ either error id <$> readJournalFileWithOpts def inputfile | --   (t0,j) <- timeit ("read "++inputfile) $ either error id <$> readJournalFile def inputfile | ||||||
| --   (t1,_) <- timeit ("print") $ print' opts j | --   (t1,_) <- timeit ("print") $ print' opts j | ||||||
| --   (t2,_) <- timeit ("register") $ register opts j | --   (t2,_) <- timeit ("register") $ register opts j | ||||||
| --   (t3,_) <- timeit ("balance") $ balance  opts j | --   (t3,_) <- timeit ("balance") $ balance  opts j | ||||||
|  | |||||||
| @ -91,7 +91,7 @@ main = do | |||||||
|   let |   let | ||||||
|     defd = "." |     defd = "." | ||||||
|     d = getArgWithDefault args defd (longOption "static-dir") |     d = getArgWithDefault args defd (longOption "static-dir") | ||||||
|   readJournalFileWithOpts def f >>= either error' (serveApi h p d f) |   readJournalFile def f >>= either error' (serveApi h p d f) | ||||||
| 
 | 
 | ||||||
| serveApi :: String -> Int -> FilePath -> FilePath -> Journal -> IO () | serveApi :: String -> Int -> FilePath -> FilePath -> Journal -> IO () | ||||||
| serveApi h p d f j = do | serveApi h p d f j = do | ||||||
|  | |||||||
| @ -14,8 +14,8 @@ module Hledger.Read ( | |||||||
|   PrefixedFilePath, |   PrefixedFilePath, | ||||||
|   defaultJournal, |   defaultJournal, | ||||||
|   defaultJournalPath, |   defaultJournalPath, | ||||||
|   readJournalFilesWithOpts, |   readJournalFiles, | ||||||
|   readJournalFileWithOpts, |   readJournalFile, | ||||||
|   requireJournalFileExists, |   requireJournalFileExists, | ||||||
|   ensureJournalFileExists, |   ensureJournalFileExists, | ||||||
|   splitReaderPrefix, |   splitReaderPrefix, | ||||||
| @ -89,7 +89,7 @@ type PrefixedFilePath = FilePath | |||||||
| 
 | 
 | ||||||
| -- | Read the default journal file specified by the environment, or raise an error. | -- | Read the default journal file specified by the environment, or raise an error. | ||||||
| defaultJournal :: IO Journal | defaultJournal :: IO Journal | ||||||
| defaultJournal = defaultJournalPath >>= readJournalFileWithOpts def >>= either error' return | defaultJournal = defaultJournalPath >>= readJournalFile def >>= either error' return | ||||||
| 
 | 
 | ||||||
| -- | Get the default journal file path specified by the environment. | -- | Get the default journal file path specified by the environment. | ||||||
| -- Like ledger, we look first for the LEDGER_FILE environment | -- Like ledger, we look first for the LEDGER_FILE environment | ||||||
| @ -148,7 +148,7 @@ newJournalContent = do | |||||||
| 
 | 
 | ||||||
| -- | Read a Journal from the given text trying all readers in turn, or throw an error. | -- | Read a Journal from the given text trying all readers in turn, or throw an error. | ||||||
| readJournal' :: Text -> IO Journal | readJournal' :: Text -> IO Journal | ||||||
| readJournal' t = readJournal Nothing def Nothing t >>= either error' return | readJournal' t = readJournal def Nothing t >>= either error' return | ||||||
| 
 | 
 | ||||||
| tests_readJournal' = [ | tests_readJournal' = [ | ||||||
|   "readJournal' parses sample journal" ~: do |   "readJournal' parses sample journal" ~: do | ||||||
| @ -156,27 +156,6 @@ tests_readJournal' = [ | |||||||
|      assertBool "" True |      assertBool "" True | ||||||
|  ] |  ] | ||||||
| 
 | 
 | ||||||
| -- | @readJournal mformat mrulesfile assrt mfile txt@ |  | ||||||
| -- |  | ||||||
| -- Read a Journal from some text, or return an error message. |  | ||||||
| -- |  | ||||||
| -- The reader (data format) is chosen based on (in priority order): |  | ||||||
| -- the @mformat@ argument; |  | ||||||
| -- a recognised file name extension in @mfile@ (if provided). |  | ||||||
| -- If none of these identify a known reader, all built-in readers are tried in turn |  | ||||||
| -- (returning the first one's error message if none of them succeed). |  | ||||||
| -- |  | ||||||
| -- Input ioptions (@iopts@) specify CSV conversion rules file to help convert CSV data, |  | ||||||
| -- enable or disable balance assertion checking and automated posting generation. |  | ||||||
| -- |  | ||||||
| readJournal :: Maybe StorageFormat -> InputOpts -> Maybe FilePath -> Text -> IO (Either String Journal) |  | ||||||
| readJournal mformat iopts mfile txt = |  | ||||||
|   let |  | ||||||
|     stablereaders = filter (not.rExperimental) readers |  | ||||||
|     rs = maybe stablereaders (:[]) $ findReader mformat mfile |  | ||||||
|   in |  | ||||||
|     tryReaders rs iopts mfile txt |  | ||||||
| 
 |  | ||||||
| -- | @findReader mformat mpath@ | -- | @findReader mformat mpath@ | ||||||
| -- | -- | ||||||
| -- Find the reader named by @mformat@, if provided. | -- Find the reader named by @mformat@, if provided. | ||||||
| @ -193,25 +172,6 @@ findReader Nothing (Just path) = | |||||||
|     (prefix,path') = splitReaderPrefix path |     (prefix,path') = splitReaderPrefix path | ||||||
|     ext            = drop 1 $ takeExtension path' |     ext            = drop 1 $ takeExtension path' | ||||||
| 
 | 
 | ||||||
| -- | @tryReaders readers mrulesfile assrt path t@ |  | ||||||
| -- |  | ||||||
| -- Try to parse the given text to a Journal using each reader in turn, |  | ||||||
| -- returning the first success, or if all of them fail, the first error message. |  | ||||||
| tryReaders :: [Reader] -> InputOpts -> Maybe FilePath -> Text -> IO (Either String Journal) |  | ||||||
| tryReaders readers iopts path t = firstSuccessOrFirstError [] readers |  | ||||||
|   where |  | ||||||
|     firstSuccessOrFirstError :: [String] -> [Reader] -> IO (Either String Journal) |  | ||||||
|     firstSuccessOrFirstError [] []        = return $ Left "no readers found" |  | ||||||
|     firstSuccessOrFirstError errs (r:rs) = do |  | ||||||
|       dbg1IO "trying reader" (rFormat r) |  | ||||||
|       result <- (runExceptT . (rParser r) iopts path') t |  | ||||||
|       dbg1IO "reader result" $ either id show result |  | ||||||
|       case result of Right j -> return $ Right j                        -- success! |  | ||||||
|                      Left e  -> firstSuccessOrFirstError (errs++[e]) rs -- keep trying |  | ||||||
|     firstSuccessOrFirstError (e:_) []    = return $ Left e              -- none left, return first error |  | ||||||
|     path' = fromMaybe "(string)" path |  | ||||||
| 
 |  | ||||||
| 
 |  | ||||||
| -- | Read a Journal from each specified file path and combine them into one. | -- | Read a Journal from each specified file path and combine them into one. | ||||||
| -- Or, return the first error message. | -- Or, return the first error message. | ||||||
| -- | -- | ||||||
| @ -220,9 +180,9 @@ tryReaders readers iopts path t = firstSuccessOrFirstError [] readers | |||||||
| -- directives & aliases do not affect subsequent sibling or parent files. | -- directives & aliases do not affect subsequent sibling or parent files. | ||||||
| -- They do affect included child files though.  | -- They do affect included child files though.  | ||||||
| -- Also the final parse state saved in the Journal does span all files. | -- Also the final parse state saved in the Journal does span all files. | ||||||
| readJournalFilesWithOpts :: InputOpts -> [FilePath] -> IO (Either String Journal) | readJournalFiles :: InputOpts -> [FilePath] -> IO (Either String Journal) | ||||||
| readJournalFilesWithOpts iopts = | readJournalFiles iopts = | ||||||
|   (right mconcat1 . sequence <$>) . mapM (readJournalFileWithOpts iopts) |   (right mconcat1 . sequence <$>) . mapM (readJournalFile iopts) | ||||||
|   where |   where | ||||||
|     mconcat1 :: Monoid t => [t] -> t |     mconcat1 :: Monoid t => [t] -> t | ||||||
|     mconcat1 [] = mempty |     mconcat1 [] = mempty | ||||||
| @ -239,14 +199,14 @@ readJournalFilesWithOpts iopts = | |||||||
| -- | -- | ||||||
| -- The input options can also configure balance assertion checking, automated posting | -- The input options can also configure balance assertion checking, automated posting | ||||||
| -- generation, a rules file for converting CSV data, etc. | -- generation, a rules file for converting CSV data, etc. | ||||||
| readJournalFileWithOpts :: InputOpts -> PrefixedFilePath -> IO (Either String Journal) | readJournalFile :: InputOpts -> PrefixedFilePath -> IO (Either String Journal) | ||||||
| readJournalFileWithOpts iopts prefixedfile = do | readJournalFile iopts prefixedfile = do | ||||||
|   let  |   let  | ||||||
|     (mfmt, f) = splitReaderPrefix prefixedfile |     (mfmt, f) = splitReaderPrefix prefixedfile | ||||||
|     iopts' = iopts{mformat_=firstJust [mfmt, mformat_ iopts]} |     iopts' = iopts{mformat_=firstJust [mfmt, mformat_ iopts]} | ||||||
|   requireJournalFileExists f |   requireJournalFileExists f | ||||||
|   t <- readFileOrStdinPortably f |   t <- readFileOrStdinPortably f | ||||||
|   ej <- readJournalWithOpts iopts' (Just f) t |   ej <- readJournal iopts' (Just f) t | ||||||
|   case ej of |   case ej of | ||||||
|     Left e  -> return $ Left e |     Left e  -> return $ Left e | ||||||
|     Right j | new_ iopts -> do |     Right j | new_ iopts -> do | ||||||
| @ -311,15 +271,34 @@ journalFilterSinceLatestDates ds@(d:_) j = (j', ds') | |||||||
|     j'                    = j{jtxns=newsamedatets++laterts} |     j'                    = j{jtxns=newsamedatets++laterts} | ||||||
|     ds'                   = latestDates $ map tdate $ samedatets++laterts |     ds'                   = latestDates $ map tdate $ samedatets++laterts | ||||||
| 
 | 
 | ||||||
| readJournalWithOpts :: InputOpts -> Maybe FilePath -> Text -> IO (Either String Journal) | -- | @readJournal iopts mfile txt@ | ||||||
| readJournalWithOpts iopts mfile txt = | -- | ||||||
|   tryReadersWithOpts iopts mfile specifiedorallreaders txt | -- Read a Journal from some text, or return an error message. | ||||||
|  | -- | ||||||
|  | -- The reader (data format) is chosen based on a recognised file name extension in @mfile@ (if provided). | ||||||
|  | -- If it does not identify a known reader, all built-in readers are tried in turn | ||||||
|  | -- (returning the first one's error message if none of them succeed). | ||||||
|  | -- | ||||||
|  | -- Input ioptions (@iopts@) specify CSV conversion rules file to help convert CSV data, | ||||||
|  | -- enable or disable balance assertion checking and automated posting generation. | ||||||
|  | -- | ||||||
|  | readJournal :: InputOpts -> Maybe FilePath -> Text -> IO (Either String Journal) | ||||||
|  | readJournal iopts mfile txt = | ||||||
|  |   tryReaders iopts mfile specifiedorallreaders txt | ||||||
|   where |   where | ||||||
|     specifiedorallreaders = maybe stablereaders (:[]) $ findReader (mformat_ iopts) mfile |     specifiedorallreaders = maybe stablereaders (:[]) $ findReader (mformat_ iopts) mfile | ||||||
|     stablereaders = filter (not.rExperimental) readers |     stablereaders = filter (not.rExperimental) readers | ||||||
| 
 | 
 | ||||||
| tryReadersWithOpts :: InputOpts -> Maybe FilePath -> [Reader] -> Text -> IO (Either String Journal) | -- | @tryReaders iopts readers path t@ | ||||||
| tryReadersWithOpts iopts mpath readers txt = firstSuccessOrFirstError [] readers | -- | ||||||
|  | -- Try to parse the given text to a Journal using each reader in turn, | ||||||
|  | -- returning the first success, or if all of them fail, the first error message. | ||||||
|  | --     | ||||||
|  | -- Input ioptions (@iopts@) specify CSV conversion rules file to help convert CSV data, | ||||||
|  | -- enable or disable balance assertion checking and automated posting generation. | ||||||
|  | -- | ||||||
|  | tryReaders :: InputOpts -> Maybe FilePath -> [Reader] -> Text -> IO (Either String Journal) | ||||||
|  | tryReaders iopts mpath readers txt = firstSuccessOrFirstError [] readers | ||||||
|   where |   where | ||||||
|     firstSuccessOrFirstError :: [String] -> [Reader] -> IO (Either String Journal) |     firstSuccessOrFirstError :: [String] -> [Reader] -> IO (Either String Journal) | ||||||
|     firstSuccessOrFirstError [] []        = return $ Left "no readers found" |     firstSuccessOrFirstError [] []        = return $ Left "no readers found" | ||||||
| @ -377,7 +356,7 @@ tests_Hledger_Read = TestList $ | |||||||
|    "journal" ~: do |    "journal" ~: do | ||||||
|     r <- runExceptT $ parseWithState mempty JournalReader.journalp "" |     r <- runExceptT $ parseWithState mempty JournalReader.journalp "" | ||||||
|     assertBool "journalp should parse an empty file" (isRight $ r) |     assertBool "journalp should parse an empty file" (isRight $ r) | ||||||
|     jE <- readJournal Nothing def Nothing "" -- don't know how to get it from journal |     jE <- readJournal def Nothing "" -- don't know how to get it from journal | ||||||
|     either error' (assertBool "journalp parsing an empty file should give an empty journal" . null . jtxns) jE |     either error' (assertBool "journalp parsing an empty file should give an empty journal" . null . jtxns) jE | ||||||
| 
 | 
 | ||||||
|   ] |   ] | ||||||
|  | |||||||
| @ -350,7 +350,7 @@ tests_balanceReport = | |||||||
|      ] |      ] | ||||||
| 
 | 
 | ||||||
|     ,"accounts report with cost basis" ~: do |     ,"accounts report with cost basis" ~: do | ||||||
|        j <- (readJournal Nothing Nothing Nothing $ unlines |        j <- (readJournal def Nothing $ unlines | ||||||
|               ["" |               ["" | ||||||
|               ,"2008/1/1 test           " |               ,"2008/1/1 test           " | ||||||
|               ,"  a:b          10h @ $50" |               ,"  a:b          10h @ $50" | ||||||
|  | |||||||
| @ -74,7 +74,7 @@ main = do | |||||||
| withJournalDoUICommand :: UIOpts -> (UIOpts -> Journal -> IO ()) -> IO () | withJournalDoUICommand :: UIOpts -> (UIOpts -> Journal -> IO ()) -> IO () | ||||||
| withJournalDoUICommand uopts@UIOpts{cliopts_=copts} cmd = do | withJournalDoUICommand uopts@UIOpts{cliopts_=copts} cmd = do | ||||||
|   journalpath <- journalFilePathFromOpts copts |   journalpath <- journalFilePathFromOpts copts | ||||||
|   ej <- readJournalFilesWithOpts (inputopts_ copts) journalpath |   ej <- readJournalFiles (inputopts_ copts) journalpath | ||||||
|   let fn = cmd uopts |   let fn = cmd uopts | ||||||
|          . pivotByOpts copts |          . pivotByOpts copts | ||||||
|          . anonymiseByOpts copts |          . anonymiseByOpts copts | ||||||
|  | |||||||
| @ -39,7 +39,7 @@ import Handler.SidebarR | |||||||
| 
 | 
 | ||||||
| import Hledger.Web.WebOptions (WebOpts(..), defwebopts) | import Hledger.Web.WebOptions (WebOpts(..), defwebopts) | ||||||
| import Hledger.Data (Journal, nulljournal) | import Hledger.Data (Journal, nulljournal) | ||||||
| import Hledger.Read (readJournalFileWithOpts) | import Hledger.Read (readJournalFile) | ||||||
| import Hledger.Utils (error') | import Hledger.Utils (error') | ||||||
| import Hledger.Cli.CliOptions (defcliopts, journalFilePathFromOpts) | import Hledger.Cli.CliOptions (defcliopts, journalFilePathFromOpts) | ||||||
| 
 | 
 | ||||||
| @ -80,7 +80,7 @@ makeFoundation conf opts = do | |||||||
| getApplicationDev :: IO (Int, Application) | getApplicationDev :: IO (Int, Application) | ||||||
| getApplicationDev = do | getApplicationDev = do | ||||||
|   f <- head `fmap` journalFilePathFromOpts defcliopts -- XXX head should be safe for now |   f <- head `fmap` journalFilePathFromOpts defcliopts -- XXX head should be safe for now | ||||||
|   j <- either error' id `fmap` readJournalFileWithOpts def f |   j <- either error' id `fmap` readJournalFile def f | ||||||
|   defaultDevelApp loader (makeApplication defwebopts j) |   defaultDevelApp loader (makeApplication defwebopts j) | ||||||
|   where |   where | ||||||
|     loader = Yesod.Default.Config.loadConfig (configSettings Development) |     loader = Yesod.Default.Config.loadConfig (configSettings Development) | ||||||
|  | |||||||
| @ -61,7 +61,7 @@ | |||||||
| --        setMessage "No change" | --        setMessage "No change" | ||||||
| --        redirect JournalR | --        redirect JournalR | ||||||
| --      else do | --      else do | ||||||
| --       jE <- liftIO $ readJournal Nothing Nothing True (Just journalpath) tnew | --       jE <- liftIO $ readJournal def (Just journalpath) tnew | ||||||
| --       either | --       either | ||||||
| --        (\e -> do | --        (\e -> do | ||||||
| --           setMessage $ toHtml e | --           setMessage $ toHtml e | ||||||
|  | |||||||
| @ -66,7 +66,7 @@ withJournalDo' opts@WebOpts {cliopts_ = cliopts} cmd = do | |||||||
|          . journalApplyAliases (aliasesFromOpts cliopts) |          . journalApplyAliases (aliasesFromOpts cliopts) | ||||||
|        <=< journalApplyValue (reportopts_ cliopts) |        <=< journalApplyValue (reportopts_ cliopts) | ||||||
|        <=< journalAddForecast cliopts |        <=< journalAddForecast cliopts | ||||||
|   readJournalFileWithOpts def f >>= either error' fn |   readJournalFile def f >>= either error' fn | ||||||
| 
 | 
 | ||||||
| -- | The web command. | -- | The web command. | ||||||
| web :: WebOpts -> Journal -> IO () | web :: WebOpts -> Journal -> IO () | ||||||
|  | |||||||
| @ -270,8 +270,8 @@ tests_Hledger_Cli_Commands = TestList [ | |||||||
|    |    | ||||||
|   ,"apply account directive" ~:  |   ,"apply account directive" ~:  | ||||||
|     let ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)} in |     let ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)} in | ||||||
|     let sameParse str1 str2 = do j1 <- readJournal Nothing def Nothing str1 >>= either error' (return . ignoresourcepos) |     let sameParse str1 str2 = do j1 <- readJournal def Nothing str1 >>= either error' (return . ignoresourcepos) | ||||||
|                                  j2 <- readJournal Nothing def Nothing str2 >>= either error' (return . ignoresourcepos) |                                  j2 <- readJournal def Nothing str2 >>= either error' (return . ignoresourcepos) | ||||||
|                                  j1 `is` j2{jlastreadtime=jlastreadtime j1, jfiles=jfiles j1} --, jparsestate=jparsestate j1} |                                  j1 `is` j2{jlastreadtime=jlastreadtime j1, jfiles=jfiles j1} --, jparsestate=jparsestate j1} | ||||||
|     in sameParse |     in sameParse | ||||||
|                          ("2008/12/07 One\n  alpha  $-1\n  beta  $1\n" <> |                          ("2008/12/07 One\n  alpha  $-1\n  beta  $1\n" <> | ||||||
| @ -288,13 +288,13 @@ tests_Hledger_Cli_Commands = TestList [ | |||||||
|                          ) |                          ) | ||||||
| 
 | 
 | ||||||
|   ,"apply account directive should preserve \"virtual\" posting type" ~: do |   ,"apply account directive should preserve \"virtual\" posting type" ~: do | ||||||
|     j <- readJournal Nothing def Nothing "apply account test\n2008/12/07 One\n  (from)  $-1\n  (to)  $1\n" >>= either error' return |     j <- readJournal def Nothing "apply 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 | ||||||
|    |    | ||||||
|   ,"account aliases" ~: do |   ,"account aliases" ~: do | ||||||
|     j <- readJournal Nothing def Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food)  1\n" >>= either error' return |     j <- readJournal def Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food)  1\n" >>= either error' return | ||||||
|     let p = head $ tpostings $ head $ jtxns j |     let p = head $ tpostings $ head $ jtxns j | ||||||
|     assertBool "" $ paccount p == "equity:draw:personal:food" |     assertBool "" $ paccount p == "equity:draw:personal:food" | ||||||
| 
 | 
 | ||||||
| @ -316,7 +316,7 @@ tests_Hledger_Cli_Commands = TestList [ | |||||||
|   --     `is` "aa:aa:aaaaaaaaaaaaaa") |   --     `is` "aa:aa:aaaaaaaaaaaaaa") | ||||||
| 
 | 
 | ||||||
|   ,"default year" ~: do |   ,"default year" ~: do | ||||||
|     j <- readJournal Nothing def Nothing defaultyear_journal_txt >>= either error' return |     j <- readJournal def Nothing defaultyear_journal_txt >>= either error' return | ||||||
|     tdate (head $ jtxns j) `is` fromGregorian 2009 1 1 |     tdate (head $ jtxns j) `is` fromGregorian 2009 1 1 | ||||||
|     return () |     return () | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -44,7 +44,7 @@ importcmd opts@CliOpts{rawopts_=rawopts,inputopts_=iopts} j = do | |||||||
|   case inputfiles of |   case inputfiles of | ||||||
|     [] -> error' "please provide one or more input files as arguments" |     [] -> error' "please provide one or more input files as arguments" | ||||||
|     fs -> do |     fs -> do | ||||||
|       enewj <- readJournalFilesWithOpts iopts' fs |       enewj <- readJournalFiles iopts' fs | ||||||
|       case enewj of |       case enewj of | ||||||
|         Left e     -> error' e  |         Left e     -> error' e  | ||||||
|         Right newj -> |         Right newj -> | ||||||
|  | |||||||
| @ -19,7 +19,7 @@ You can use the command line: | |||||||
| or ghci: | or ghci: | ||||||
| 
 | 
 | ||||||
| > $ ghci hledger | > $ ghci hledger | ||||||
| > > j <- readJournalFileWithOpts def "examples/sample.journal" | > > j <- readJournalFile def "examples/sample.journal" | ||||||
| > > register [] ["income","expenses"] j | > > register [] ["income","expenses"] j | ||||||
| > 2008/01/01 income               income:salary                   $-1          $-1 | > 2008/01/01 income               income:salary                   $-1          $-1 | ||||||
| > 2008/06/01 gift                 income:gifts                    $-1          $-2 | > 2008/06/01 gift                 income:gifts                    $-1          $-2 | ||||||
|  | |||||||
| @ -66,7 +66,7 @@ withJournalDo opts cmd = do | |||||||
|   -- it's stdin, or it doesn't exist and we are adding. We read it strictly |   -- it's stdin, or it doesn't exist and we are adding. We read it strictly | ||||||
|   -- to let the add command work. |   -- to let the add command work. | ||||||
|   journalpaths <- journalFilePathFromOpts opts |   journalpaths <- journalFilePathFromOpts opts | ||||||
|   ej <- readJournalFilesWithOpts (inputopts_ opts) journalpaths |   ej <- readJournalFiles (inputopts_ opts) journalpaths | ||||||
|   let f   = cmd opts |   let f   = cmd opts | ||||||
|           . pivotByOpts opts |           . pivotByOpts opts | ||||||
|           . anonymiseByOpts opts |           . anonymiseByOpts opts | ||||||
| @ -152,8 +152,8 @@ writeOutput opts s = do | |||||||
|   (if f == "-" then putStr else writeFile f) s |   (if f == "-" then putStr else writeFile f) s | ||||||
|    |    | ||||||
| -- -- | Get a journal from the given string and options, or throw an error. | -- -- | Get a journal from the given string and options, or throw an error. | ||||||
| -- readJournalWithOpts :: CliOpts -> String -> IO Journal | -- readJournal :: CliOpts -> String -> IO Journal | ||||||
| -- readJournalWithOpts opts s = readJournal Nothing Nothing Nothing s >>= either error' return | -- readJournal opts s = readJournal def Nothing s >>= either error' return | ||||||
| 
 | 
 | ||||||
| -- | Re-read the journal file(s) specified by options and maybe apply some | -- | Re-read the journal file(s) specified by options and maybe apply some | ||||||
| -- transformations (aliases, pivot), or return an error string. | -- transformations (aliases, pivot), or return an error string. | ||||||
| @ -162,7 +162,7 @@ journalReload :: CliOpts -> IO (Either String Journal) | |||||||
| journalReload opts = do | journalReload opts = do | ||||||
|   journalpaths <- journalFilePathFromOpts opts |   journalpaths <- journalFilePathFromOpts opts | ||||||
|   ((pivotByOpts opts . journalApplyAliases (aliasesFromOpts opts)) <$>) <$> |   ((pivotByOpts opts . journalApplyAliases (aliasesFromOpts opts)) <$>) <$> | ||||||
|     readJournalFilesWithOpts (inputopts_ opts) journalpaths |     readJournalFiles (inputopts_ opts) journalpaths | ||||||
| 
 | 
 | ||||||
| -- | Re-read the option-specified journal file(s), but only if any of | -- | Re-read the option-specified journal file(s), but only if any of | ||||||
| -- them has changed since last read. (If the file is standard input, | -- them has changed since last read. (If the file is standard input, | ||||||
|  | |||||||
| @ -34,7 +34,7 @@ main = do | |||||||
| benchWithTimeit = do | benchWithTimeit = do | ||||||
|   getCurrentDirectory >>= printf "Benchmarking hledger in %s with timeit\n" |   getCurrentDirectory >>= printf "Benchmarking hledger in %s with timeit\n" | ||||||
|   let opts = defcliopts{output_file_=Just outputfile} |   let opts = defcliopts{output_file_=Just outputfile} | ||||||
|   (t0,j) <- timeit ("read "++inputfile) $ either error id <$> readJournalFileWithOpts def inputfile |   (t0,j) <- timeit ("read "++inputfile) $ either error id <$> readJournalFile def inputfile | ||||||
|   (t1,_) <- timeit ("print") $ print' opts j |   (t1,_) <- timeit ("print") $ print' opts j | ||||||
|   (t2,_) <- timeit ("register") $ register opts j |   (t2,_) <- timeit ("register") $ register opts j | ||||||
|   (t3,_) <- timeit ("balance") $ balance  opts j |   (t3,_) <- timeit ("balance") $ balance  opts j | ||||||
| @ -50,9 +50,9 @@ timeit name action = do | |||||||
| benchWithCriterion = do | benchWithCriterion = do | ||||||
|   getCurrentDirectory >>= printf "Benchmarking hledger in %s with criterion\n" |   getCurrentDirectory >>= printf "Benchmarking hledger in %s with criterion\n" | ||||||
|   let opts = defcliopts{output_file_=Just "/dev/null"} |   let opts = defcliopts{output_file_=Just "/dev/null"} | ||||||
|   j <- either error id <$> readJournalFileWithOpts def inputfile |   j <- either error id <$> readJournalFile def inputfile | ||||||
|   Criterion.Main.defaultMainWith defaultConfig $ [ |   Criterion.Main.defaultMainWith defaultConfig $ [ | ||||||
|     bench ("read "++inputfile) $ nfIO $ (either error const <$> readJournalFileWithOpts def inputfile), |     bench ("read "++inputfile) $ nfIO $ (either error const <$> readJournalFile def inputfile), | ||||||
|     bench ("print")            $ nfIO $ print'   opts j, |     bench ("print")            $ nfIO $ print'   opts j, | ||||||
|     bench ("register")         $ nfIO $ register opts j, |     bench ("register")         $ nfIO $ register opts j, | ||||||
|     bench ("balance")          $ nfIO $ balance  opts j, |     bench ("balance")          $ nfIO $ balance  opts j, | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user