From f6ec26e3219413b3de03ac36ccfaebf64cb0a746 Mon Sep 17 00:00:00 2001 From: Dmitry Astapov Date: Tue, 17 Apr 2018 23:13:13 +0100 Subject: [PATCH] lib, app, web, ui: rename readJournalFile[s]WithOpts to readJournalFile, same for tryReader[s]WithOpts --- dev.hs | 13 +-- hledger-api/hledger-api.hs | 2 +- hledger-lib/Hledger/Read.hs | 91 ++++++++------------ hledger-lib/Hledger/Reports/BalanceReport.hs | 2 +- hledger-ui/Hledger/UI/Main.hs | 2 +- hledger-web/Application.hs | 4 +- hledger-web/Handler/EditForm.hs | 2 +- hledger-web/Hledger/Web/Main.hs | 2 +- hledger/Hledger/Cli/Commands.hs | 10 +-- hledger/Hledger/Cli/Commands/Import.hs | 4 +- hledger/Hledger/Cli/Main.hs | 2 +- hledger/Hledger/Cli/Utils.hs | 8 +- hledger/bench/bench.hs | 6 +- 13 files changed, 64 insertions(+), 84 deletions(-) diff --git a/dev.hs b/dev.hs index c14a99737..842d07879 100755 --- a/dev.hs +++ b/dev.hs @@ -13,6 +13,7 @@ import System.TimeIt (timeItT) import Text.Printf import Hledger +import Data.Default (def) -- import Hledger.Utils.Regex (toRegexCI) -- import Hledger.Utils.Debug -- import qualified Hledger.Read.JournalReader as JR @@ -46,18 +47,18 @@ timeit name action = do return (t,a) 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 -- 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 () -- printf "Total: %0.2fs\n" (sum [t0,t1,t2,t3,t4]) -- -- read the input 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 -- let accts = map paccount $ journalPostings j @@ -82,10 +83,10 @@ main = do -- -- ,bench ("readJournal") $ whnfIO $ -- -- either error id <$> - -- -- readJournal Nothing Nothing True Nothing s + -- -- readJournal def Nothing s -- -- ,bench ("readJournal with aliases") $ whnfIO $ -- -- either error id <$> - -- -- readJournal Nothing Nothing True Nothing ( + -- -- readJournal def Nothing ( -- -- unlines [ -- -- "alias /^fb:/=xx \n" -- -- ,"alias /^f1:/=xx \n" @@ -156,7 +157,7 @@ main = do -- benchWithTimeit = do -- getCurrentDirectory >>= printf "Benchmarking hledger in %s with timeit\n" -- 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 -- (t2,_) <- timeit ("register") $ register opts j -- (t3,_) <- timeit ("balance") $ balance opts j diff --git a/hledger-api/hledger-api.hs b/hledger-api/hledger-api.hs index 20d7c532a..d5a27a840 100644 --- a/hledger-api/hledger-api.hs +++ b/hledger-api/hledger-api.hs @@ -91,7 +91,7 @@ main = do let defd = "." 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 h p d f j = do diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index f952a61d0..c4277b156 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -14,8 +14,8 @@ module Hledger.Read ( PrefixedFilePath, defaultJournal, defaultJournalPath, - readJournalFilesWithOpts, - readJournalFileWithOpts, + readJournalFiles, + readJournalFile, requireJournalFileExists, ensureJournalFileExists, splitReaderPrefix, @@ -89,7 +89,7 @@ type PrefixedFilePath = FilePath -- | Read the default journal file specified by the environment, or raise an error. 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. -- 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. 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' = [ "readJournal' parses sample journal" ~: do @@ -156,27 +156,6 @@ tests_readJournal' = [ 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@ -- -- Find the reader named by @mformat@, if provided. @@ -193,25 +172,6 @@ findReader Nothing (Just path) = (prefix,path') = splitReaderPrefix 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. -- 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. -- They do affect included child files though. -- Also the final parse state saved in the Journal does span all files. -readJournalFilesWithOpts :: InputOpts -> [FilePath] -> IO (Either String Journal) -readJournalFilesWithOpts iopts = - (right mconcat1 . sequence <$>) . mapM (readJournalFileWithOpts iopts) +readJournalFiles :: InputOpts -> [FilePath] -> IO (Either String Journal) +readJournalFiles iopts = + (right mconcat1 . sequence <$>) . mapM (readJournalFile iopts) where mconcat1 :: Monoid t => [t] -> t mconcat1 [] = mempty @@ -239,14 +199,14 @@ readJournalFilesWithOpts iopts = -- -- The input options can also configure balance assertion checking, automated posting -- generation, a rules file for converting CSV data, etc. -readJournalFileWithOpts :: InputOpts -> PrefixedFilePath -> IO (Either String Journal) -readJournalFileWithOpts iopts prefixedfile = do +readJournalFile :: InputOpts -> PrefixedFilePath -> IO (Either String Journal) +readJournalFile iopts prefixedfile = do let (mfmt, f) = splitReaderPrefix prefixedfile iopts' = iopts{mformat_=firstJust [mfmt, mformat_ iopts]} requireJournalFileExists f t <- readFileOrStdinPortably f - ej <- readJournalWithOpts iopts' (Just f) t + ej <- readJournal iopts' (Just f) t case ej of Left e -> return $ Left e Right j | new_ iopts -> do @@ -311,15 +271,34 @@ journalFilterSinceLatestDates ds@(d:_) j = (j', ds') j' = j{jtxns=newsamedatets++laterts} ds' = latestDates $ map tdate $ samedatets++laterts -readJournalWithOpts :: InputOpts -> Maybe FilePath -> Text -> IO (Either String Journal) -readJournalWithOpts iopts mfile txt = - tryReadersWithOpts iopts mfile specifiedorallreaders txt +-- | @readJournal iopts mfile 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 specifiedorallreaders = maybe stablereaders (:[]) $ findReader (mformat_ iopts) mfile stablereaders = filter (not.rExperimental) readers -tryReadersWithOpts :: InputOpts -> Maybe FilePath -> [Reader] -> Text -> IO (Either String Journal) -tryReadersWithOpts iopts mpath readers txt = firstSuccessOrFirstError [] readers +-- | @tryReaders iopts readers 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. +-- +-- 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 firstSuccessOrFirstError :: [String] -> [Reader] -> IO (Either String Journal) firstSuccessOrFirstError [] [] = return $ Left "no readers found" @@ -377,7 +356,7 @@ tests_Hledger_Read = TestList $ "journal" ~: do r <- runExceptT $ parseWithState mempty JournalReader.journalp "" 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 ] diff --git a/hledger-lib/Hledger/Reports/BalanceReport.hs b/hledger-lib/Hledger/Reports/BalanceReport.hs index 269aeb657..9e6a732ad 100644 --- a/hledger-lib/Hledger/Reports/BalanceReport.hs +++ b/hledger-lib/Hledger/Reports/BalanceReport.hs @@ -350,7 +350,7 @@ tests_balanceReport = ] ,"accounts report with cost basis" ~: do - j <- (readJournal Nothing Nothing Nothing $ unlines + j <- (readJournal def Nothing $ unlines ["" ,"2008/1/1 test " ," a:b 10h @ $50" diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index 1aea84163..8f019d28f 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/hledger-ui/Hledger/UI/Main.hs @@ -74,7 +74,7 @@ main = do withJournalDoUICommand :: UIOpts -> (UIOpts -> Journal -> IO ()) -> IO () withJournalDoUICommand uopts@UIOpts{cliopts_=copts} cmd = do journalpath <- journalFilePathFromOpts copts - ej <- readJournalFilesWithOpts (inputopts_ copts) journalpath + ej <- readJournalFiles (inputopts_ copts) journalpath let fn = cmd uopts . pivotByOpts copts . anonymiseByOpts copts diff --git a/hledger-web/Application.hs b/hledger-web/Application.hs index cd3e65bc3..a8185e4ee 100644 --- a/hledger-web/Application.hs +++ b/hledger-web/Application.hs @@ -39,7 +39,7 @@ import Handler.SidebarR import Hledger.Web.WebOptions (WebOpts(..), defwebopts) import Hledger.Data (Journal, nulljournal) -import Hledger.Read (readJournalFileWithOpts) +import Hledger.Read (readJournalFile) import Hledger.Utils (error') import Hledger.Cli.CliOptions (defcliopts, journalFilePathFromOpts) @@ -80,7 +80,7 @@ makeFoundation conf opts = do getApplicationDev :: IO (Int, Application) getApplicationDev = do 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) where loader = Yesod.Default.Config.loadConfig (configSettings Development) diff --git a/hledger-web/Handler/EditForm.hs b/hledger-web/Handler/EditForm.hs index a545577c5..6d6807e80 100644 --- a/hledger-web/Handler/EditForm.hs +++ b/hledger-web/Handler/EditForm.hs @@ -61,7 +61,7 @@ -- setMessage "No change" -- redirect JournalR -- else do --- jE <- liftIO $ readJournal Nothing Nothing True (Just journalpath) tnew +-- jE <- liftIO $ readJournal def (Just journalpath) tnew -- either -- (\e -> do -- setMessage $ toHtml e diff --git a/hledger-web/Hledger/Web/Main.hs b/hledger-web/Hledger/Web/Main.hs index 2bfa562f0..fe91c176f 100644 --- a/hledger-web/Hledger/Web/Main.hs +++ b/hledger-web/Hledger/Web/Main.hs @@ -66,7 +66,7 @@ withJournalDo' opts@WebOpts {cliopts_ = cliopts} cmd = do . journalApplyAliases (aliasesFromOpts cliopts) <=< journalApplyValue (reportopts_ cliopts) <=< journalAddForecast cliopts - readJournalFileWithOpts def f >>= either error' fn + readJournalFile def f >>= either error' fn -- | The web command. web :: WebOpts -> Journal -> IO () diff --git a/hledger/Hledger/Cli/Commands.hs b/hledger/Hledger/Cli/Commands.hs index 96dcea160..d3d4a8b39 100644 --- a/hledger/Hledger/Cli/Commands.hs +++ b/hledger/Hledger/Cli/Commands.hs @@ -270,8 +270,8 @@ tests_Hledger_Cli_Commands = TestList [ ,"apply account directive" ~: 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) - j2 <- readJournal Nothing def Nothing str2 >>= either error' (return . ignoresourcepos) + let sameParse str1 str2 = do j1 <- readJournal def Nothing str1 >>= 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} in sameParse ("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 - 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 assertBool "" $ paccount p == "test:from" assertBool "" $ ptype p == VirtualPosting ,"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 assertBool "" $ paccount p == "equity:draw:personal:food" @@ -316,7 +316,7 @@ tests_Hledger_Cli_Commands = TestList [ -- `is` "aa:aa:aaaaaaaaaaaaaa") ,"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 return () diff --git a/hledger/Hledger/Cli/Commands/Import.hs b/hledger/Hledger/Cli/Commands/Import.hs index d4b3da2e4..8d39860dc 100755 --- a/hledger/Hledger/Cli/Commands/Import.hs +++ b/hledger/Hledger/Cli/Commands/Import.hs @@ -44,7 +44,7 @@ importcmd opts@CliOpts{rawopts_=rawopts,inputopts_=iopts} j = do case inputfiles of [] -> error' "please provide one or more input files as arguments" fs -> do - enewj <- readJournalFilesWithOpts iopts' fs + enewj <- readJournalFiles iopts' fs case enewj of Left e -> error' e Right newj -> @@ -57,4 +57,4 @@ importcmd opts@CliOpts{rawopts_=rawopts,inputopts_=iopts} j = do mapM_ (putStr . showTransactionUnelided) newts newts -> do foldM (flip journalAddTransaction opts) j newts -- gets forced somehow.. (how ?) - printf "imported %d new transactions\n" (length newts) \ No newline at end of file + printf "imported %d new transactions\n" (length newts) diff --git a/hledger/Hledger/Cli/Main.hs b/hledger/Hledger/Cli/Main.hs index d80de29a3..ec870fedc 100644 --- a/hledger/Hledger/Cli/Main.hs +++ b/hledger/Hledger/Cli/Main.hs @@ -19,7 +19,7 @@ You can use the command line: or ghci: > $ ghci hledger -> > j <- readJournalFileWithOpts def "examples/sample.journal" +> > j <- readJournalFile def "examples/sample.journal" > > register [] ["income","expenses"] j > 2008/01/01 income income:salary $-1 $-1 > 2008/06/01 gift income:gifts $-1 $-2 diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index 8e62c124c..55721c8ca 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -66,7 +66,7 @@ withJournalDo opts cmd = do -- it's stdin, or it doesn't exist and we are adding. We read it strictly -- to let the add command work. journalpaths <- journalFilePathFromOpts opts - ej <- readJournalFilesWithOpts (inputopts_ opts) journalpaths + ej <- readJournalFiles (inputopts_ opts) journalpaths let f = cmd opts . pivotByOpts opts . anonymiseByOpts opts @@ -152,8 +152,8 @@ writeOutput opts s = do (if f == "-" then putStr else writeFile f) s -- -- | Get a journal from the given string and options, or throw an error. --- readJournalWithOpts :: CliOpts -> String -> IO Journal --- readJournalWithOpts opts s = readJournal Nothing Nothing Nothing s >>= either error' return +-- readJournal :: CliOpts -> String -> IO Journal +-- readJournal opts s = readJournal def Nothing s >>= either error' return -- | Re-read the journal file(s) specified by options and maybe apply some -- transformations (aliases, pivot), or return an error string. @@ -162,7 +162,7 @@ journalReload :: CliOpts -> IO (Either String Journal) journalReload opts = do journalpaths <- journalFilePathFromOpts 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 -- them has changed since last read. (If the file is standard input, diff --git a/hledger/bench/bench.hs b/hledger/bench/bench.hs index 98f5d3b8f..3df512aac 100644 --- a/hledger/bench/bench.hs +++ b/hledger/bench/bench.hs @@ -34,7 +34,7 @@ main = do benchWithTimeit = do getCurrentDirectory >>= printf "Benchmarking hledger in %s with timeit\n" 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 (t2,_) <- timeit ("register") $ register opts j (t3,_) <- timeit ("balance") $ balance opts j @@ -50,9 +50,9 @@ timeit name action = do benchWithCriterion = do getCurrentDirectory >>= printf "Benchmarking hledger in %s with criterion\n" 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 $ [ - 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 ("register") $ nfIO $ register opts j, bench ("balance") $ nfIO $ balance opts j,