lib: auto postings generated before amount inference and balance checks (#729)

This commit is contained in:
Dmitry Astapov 2018-04-16 22:47:04 +01:00 committed by Simon Michael
parent 8633ab2e42
commit ecf49b1e4b
16 changed files with 94 additions and 92 deletions

View File

@ -2,7 +2,7 @@
--
-- see: https://github.com/sol/hpack
--
-- hash: c1aecc57a80b7a88ba2774d93d5b1eedc43d04d6dbae964ce94307b643868534
-- hash: f3ae96bc4a552af6049713498efd77ef61e5ade3bac393e45e47b484335029bd
name: hledger-api
version: 1.9.99
@ -51,6 +51,7 @@ executable hledger-api
, base >=4.8 && <4.12
, bytestring
, containers
, data-default >=0.5
, docopt
, either
, hledger >=1.9.99 && <2.0

View File

@ -17,6 +17,7 @@ import Control.Monad
import Data.Aeson
import qualified Data.ByteString.Lazy.Char8 as BL8
import Data.Decimal
import Data.Default
import qualified Data.Map as M
import Data.Proxy
import Data.String (fromString)
@ -90,7 +91,7 @@ main = do
let
defd = "."
d = getArgWithDefault args defd (longOption "static-dir")
readJournalFile Nothing Nothing True f >>= either error' (serveApi h p d f)
readJournalFile Nothing def f >>= either error' (serveApi h p d f)
serveApi :: String -> Int -> FilePath -> FilePath -> Journal -> IO ()
serveApi h p d f j = do

View File

@ -38,6 +38,7 @@ dependencies:
- aeson
- bytestring
- containers
- data-default >=0.5
- Decimal
- docopt
- either

View File

@ -22,7 +22,6 @@ where
import GHC.Generics (Generic)
import Control.DeepSeq (NFData)
import Control.Monad.Except (ExceptT)
import Data.Data
import Data.Decimal
import Data.Default
@ -329,28 +328,6 @@ type ParsedJournal = Journal
-- The --output-format option selects one of these for output.
type StorageFormat = String
-- | A hledger journal reader is a triple of storage format name, a
-- detector of that format, and a parser from that format to Journal.
data Reader = Reader {
-- The canonical name of the format handled by this reader
rFormat :: StorageFormat
-- The file extensions recognised as containing this format
,rExtensions :: [String]
-- A text parser for this format, accepting an optional rules file,
-- assertion-checking flag, and file path for error messages,
-- producing an exception-raising IO action that returns a journal
-- or error message.
,rParser :: Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal
-- Experimental readers are never tried automatically.
,rExperimental :: Bool
}
instance Show Reader where show r = rFormat r ++ " reader"
-- | An account, with name, balances and links to parent/subaccounts
-- which let you walk up or down the account tree.
data Account = Account {

View File

@ -40,6 +40,7 @@ import Control.Applicative ((<|>))
import Control.Arrow (right)
import qualified Control.Exception as C
import Control.Monad.Except
import Data.Default
import Data.List
import Data.Maybe
import Data.Ord
@ -90,7 +91,7 @@ type PrefixedFilePath = FilePath
-- | Read the default journal file specified by the environment, or raise an error.
defaultJournal :: IO Journal
defaultJournal = defaultJournalPath >>= readJournalFile Nothing Nothing True >>= either error' return
defaultJournal = defaultJournalPath >>= readJournalFile Nothing def >>= either error' return
-- | Get the default journal file path specified by the environment.
-- Like ledger, we look first for the LEDGER_FILE environment
@ -123,14 +124,13 @@ defaultJournalPath = do
-- (The final parse state saved in the Journal does span all files, however.)
--
-- As with readJournalFile,
-- file paths can optionally have a READER: prefix,
-- and the @mformat@, @mrulesfile, and @assrt@ arguments are supported
-- (and these are applied to all files).
-- input ioptions (@iopts@) specify CSV conversion rules file to help convert CSV data,
-- enable or disable balance assertion checking and automated posting generation.
--
readJournalFiles :: Maybe StorageFormat -> Maybe FilePath -> Bool -> [PrefixedFilePath] -> IO (Either String Journal)
readJournalFiles mformat mrulesfile assrt prefixedfiles = do
readJournalFiles :: Maybe StorageFormat -> InputOpts -> [PrefixedFilePath] -> IO (Either String Journal)
readJournalFiles mformat iopts prefixedfiles = do
(right mconcat1 . sequence)
<$> mapM (readJournalFile mformat mrulesfile assrt) prefixedfiles
<$> mapM (readJournalFile mformat iopts) prefixedfiles
where mconcat1 :: Monoid t => [t] -> t
mconcat1 [] = mempty
mconcat1 x = foldr1 mappend x
@ -146,17 +146,16 @@ readJournalFiles mformat mrulesfile assrt prefixedfiles = do
-- a recognised file name extension (in readJournal);
-- if none of these identify a known reader, all built-in readers are tried in turn.
--
-- A CSV conversion rules file (@mrulesfiles@) can be specified to help convert CSV data.
-- Input ioptions (@iopts@) specify CSV conversion rules file to help convert CSV data,
-- enable or disable balance assertion checking and automated posting generation.
--
-- Optionally, any balance assertions in the journal can be checked (@assrt@).
--
readJournalFile :: Maybe StorageFormat -> Maybe FilePath -> Bool -> PrefixedFilePath -> IO (Either String Journal)
readJournalFile mformat mrulesfile assrt prefixedfile = do
readJournalFile :: Maybe StorageFormat -> InputOpts -> PrefixedFilePath -> IO (Either String Journal)
readJournalFile mformat iopts prefixedfile = do
let
(mprefixformat, f) = splitReaderPrefix prefixedfile
mfmt = mformat <|> mprefixformat
requireJournalFileExists f
readFileOrStdinPortably f >>= readJournal mfmt mrulesfile assrt (Just f)
readFileOrStdinPortably f >>= readJournal mfmt iopts (Just f)
-- | If a filepath is prefixed by one of the reader names and a colon,
-- split that off. Eg "csv:-" -> (Just "csv", "-").
@ -195,7 +194,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 Nothing True Nothing t >>= either error' return
readJournal' t = readJournal Nothing def Nothing t >>= either error' return
tests_readJournal' = [
"readJournal' parses sample journal" ~: do
@ -213,17 +212,16 @@ tests_readJournal' = [
-- 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).
--
-- A CSV conversion rules file (@mrulesfiles@) can be specified to help convert CSV data.
-- Input ioptions (@iopts@) specify CSV conversion rules file to help convert CSV data,
-- enable or disable balance assertion checking and automated posting generation.
--
-- Optionally, any balance assertions in the journal can be checked (@assrt@).
--
readJournal :: Maybe StorageFormat -> Maybe FilePath -> Bool -> Maybe FilePath -> Text -> IO (Either String Journal)
readJournal mformat mrulesfile assrt mfile txt =
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 mrulesfile assrt mfile txt
tryReaders rs iopts mfile txt
-- | @findReader mformat mpath@
--
@ -245,14 +243,14 @@ findReader Nothing (Just path) =
--
-- 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] -> Maybe FilePath -> Bool -> Maybe FilePath -> Text -> IO (Either String Journal)
tryReaders readers mrulesfile assrt path t = firstSuccessOrFirstError [] readers
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) mrulesfile assrt path') t
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
@ -356,7 +354,7 @@ tryReadersWithOpts iopts mpath readers txt = firstSuccessOrFirstError [] readers
firstSuccessOrFirstError [] [] = return $ Left "no readers found"
firstSuccessOrFirstError errs (r:rs) = do
dbg1IO "trying reader" (rFormat r)
result <- (runExceptT . (rParser r) (mrules_file_ iopts) (not $ ignore_assertions_ iopts) path) txt
result <- (runExceptT . (rParser r) iopts path) txt
dbg1IO "reader result" $ either id show result
case result of Right j -> return $ Right j -- success!
Left e -> firstSuccessOrFirstError (errs++[e]) rs -- keep trying
@ -408,7 +406,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 Nothing True Nothing "" -- don't know how to get it from journal
jE <- readJournal Nothing 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
]

View File

@ -47,6 +47,28 @@ import Text.Megaparsec.Compat
import Hledger.Data
import Hledger.Utils
import qualified Hledger.Query as Q (Query(Any))
-- | A hledger journal reader is a triple of storage format name, a
-- detector of that format, and a parser from that format to Journal.
data Reader = Reader {
-- The canonical name of the format handled by this reader
rFormat :: StorageFormat
-- The file extensions recognised as containing this format
,rExtensions :: [String]
-- A text parser for this format, accepting input options, file
-- path for error messages and file contents, producing an exception-raising IO
-- action that returns a journal or error message.
,rParser :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
-- Experimental readers are never tried automatically.
,rExperimental :: Bool
}
instance Show Reader where show r = rFormat r ++ " reader"
-- $setup
@ -63,12 +85,13 @@ data InputOpts = InputOpts {
,new_ :: Bool -- ^ read only new transactions since this file was last read
,new_save_ :: Bool -- ^ save latest new transactions state for next time
,pivot_ :: String -- ^ use the given field's value as the account name
,auto_ :: Bool -- ^ generate automatic postings when journal is parsed
} deriving (Show, Data) --, Typeable)
instance Default InputOpts where def = definputopts
definputopts :: InputOpts
definputopts = InputOpts def def def def def def True def
definputopts = InputOpts def def def def def def True def def
rawOptsToInputOpts :: RawOpts -> InputOpts
rawOptsToInputOpts rawopts = InputOpts{
@ -81,6 +104,7 @@ rawOptsToInputOpts rawopts = InputOpts{
,new_ = boolopt "new" rawopts
,new_save_ = True
,pivot_ = stringopt "pivot" rawopts
,auto_ = boolopt "auto" rawopts
}
--- * parsing utils
@ -115,27 +139,40 @@ journalSourcePos p p' = JournalSourcePos (sourceName p) (fromIntegral . unPos $
| otherwise = unPos $ sourceLine p' -- might be at end of file withat last new-line
-- | Given a megaparsec ParsedJournal parser, balance assertion flag, file
-- | Generate Automatic postings and add them to the current journal.
generateAutomaticPostings :: Journal -> Journal
generateAutomaticPostings j = j { jtxns = map modifier $ jtxns j }
where
modifier = foldr (flip (.) . runModifierTransaction') id mtxns
runModifierTransaction' = fmap txnTieKnot . runModifierTransaction Q.Any
mtxns = jmodifiertxns j
-- | Given a megaparsec ParsedJournal parser, input options, file
-- path and file content: parse and post-process a Journal, or give an error.
parseAndFinaliseJournal :: ErroringJournalParser IO ParsedJournal -> Bool
-> FilePath -> Text -> ExceptT String IO Journal
parseAndFinaliseJournal parser assrt f txt = do
parseAndFinaliseJournal :: ErroringJournalParser IO ParsedJournal -> InputOpts
-> FilePath -> Text -> ExceptT String IO Journal
parseAndFinaliseJournal parser iopts f txt = do
t <- liftIO getClockTime
y <- liftIO getCurrentYear
ep <- runParserT (evalStateT parser nulljournal {jparsedefaultyear=Just y}) f txt
case ep of
Right pj -> case journalFinalise t f txt assrt pj of
Right pj ->
let pj' = if auto_ iopts then generateAutomaticPostings pj else pj in
case journalFinalise t f txt (not $ ignore_assertions_ iopts) pj' of
Right j -> return j
Left e -> throwError e
Left e -> throwError $ parseErrorPretty e
parseAndFinaliseJournal' :: JournalParser Identity ParsedJournal -> Bool -> FilePath -> Text -> ExceptT String IO Journal
parseAndFinaliseJournal' parser assrt f txt = do
parseAndFinaliseJournal' :: JournalParser Identity ParsedJournal -> InputOpts
-> FilePath -> Text -> ExceptT String IO Journal
parseAndFinaliseJournal' parser iopts f txt = do
t <- liftIO getClockTime
y <- liftIO getCurrentYear
let ep = runParser (evalStateT parser nulljournal {jparsedefaultyear=Just y}) f txt
case ep of
Right pj -> case journalFinalise t f txt assrt pj of
Right pj ->
let pj' = if auto_ iopts then generateAutomaticPostings pj else pj in
case journalFinalise t f txt (not $ ignore_assertions_ iopts) pj' of
Right j -> return j
Left e -> throwError e
Left e -> throwError $ parseErrorPretty e

View File

@ -60,7 +60,7 @@ import Text.Printf (printf)
import Hledger.Data
import Hledger.Utils.UTF8IOCompat (getContents)
import Hledger.Utils
import Hledger.Read.Common (amountp, statusp, genericSourcePos)
import Hledger.Read.Common (Reader(..),InputOpts(..),amountp, statusp, genericSourcePos)
reader :: Reader
@ -73,8 +73,9 @@ reader = Reader
-- | Parse and post-process a "Journal" from CSV data, or give an error.
-- XXX currently ignores the string and reads from the file path
parse :: Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal
parse rulesfile _ f t = do
parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
parse iopts f t = do
let rulesfile = mrules_file_ iopts
r <- liftIO $ readJournalFromCsv rulesfile f t
case r of Left e -> throwError e
Right j -> return $ journalNumberAndTieTransactions j

View File

@ -119,8 +119,8 @@ reader = Reader
-- | Parse and post-process a "Journal" from hledger's journal file
-- format, or give an error.
parse :: Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal
parse _ = parseAndFinaliseJournal journalp
parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
parse = parseAndFinaliseJournal journalp
--- * parsers
--- ** journal

View File

@ -79,8 +79,8 @@ reader = Reader
-- | Parse and post-process a "Journal" from timeclock.el's timeclock
-- format, saving the provided file path and the current time, or give an
-- error.
parse :: Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal
parse _ = parseAndFinaliseJournal timeclockfilep
parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
parse = parseAndFinaliseJournal timeclockfilep
timeclockfilep :: ErroringJournalParser IO ParsedJournal
timeclockfilep = do many timeclockitemp

View File

@ -65,8 +65,8 @@ reader = Reader
}
-- | Parse and post-process a "Journal" from the timedot format, or give an error.
parse :: Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal
parse _ = parseAndFinaliseJournal timedotfilep
parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
parse = parseAndFinaliseJournal timedotfilep
timedotfilep :: JournalParser m ParsedJournal
timedotfilep = do many timedotfileitemp

View File

@ -115,7 +115,6 @@ data ReportOpts = ReportOpts {
-- normally positive for a more conventional display.
,color_ :: Bool
,forecast_ :: Bool
,auto_ :: Bool
} deriving (Show, Data, Typeable)
instance Default ReportOpts where def = defreportopts
@ -148,7 +147,6 @@ defreportopts = ReportOpts
def
def
def
def
rawOptsToReportOpts :: RawOpts -> IO ReportOpts
rawOptsToReportOpts rawopts = checkReportOpts <$> do
@ -181,7 +179,6 @@ rawOptsToReportOpts rawopts = checkReportOpts <$> do
,pretty_tables_ = boolopt "pretty-tables" rawopts'
,color_ = color
,forecast_ = boolopt "forecast" rawopts'
,auto_ = boolopt "auto" rawopts'
}
-- | Do extra validation of raw option values, raising an error if there's a problem.

View File

@ -81,7 +81,6 @@ withJournalDoUICommand uopts@UIOpts{cliopts_=copts} cmd = do
. journalApplyAliases (aliasesFromOpts copts)
<=< journalApplyValue (reportopts_ copts)
<=< journalAddForecast copts
. generateAutomaticPostings (reportopts_ copts)
either error' fn ej
runBrickUi :: UIOpts -> Journal -> IO ()

View File

@ -6,6 +6,7 @@ module Application
, makeFoundation
) where
import Data.Default
import Data.IORef
import Import
import Yesod.Default.Config
@ -79,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` readJournalFile Nothing Nothing True f
j <- either error' id `fmap` readJournalFile Nothing def f
defaultDevelApp loader (makeApplication defwebopts j)
where
loader = Yesod.Default.Config.loadConfig (configSettings Development)

View File

@ -23,6 +23,7 @@ import Network.Wai.Handler.Launch (runHostPortUrl)
import Control.Applicative ((<$>))
#endif
import Control.Monad
import Data.Default
import Data.Text (pack)
import System.Exit (exitSuccess)
import System.IO (hFlush, stdout)
@ -65,8 +66,7 @@ withJournalDo' opts@WebOpts {cliopts_ = cliopts} cmd = do
. journalApplyAliases (aliasesFromOpts cliopts)
<=< journalApplyValue (reportopts_ cliopts)
<=< journalAddForecast cliopts
. generateAutomaticPostings (reportopts_ cliopts)
readJournalFile Nothing Nothing True f >>= either error' fn
readJournalFile Nothing def f >>= either error' fn
-- | The web command.
web :: WebOpts -> Journal -> IO ()

View File

@ -37,6 +37,7 @@ module Hledger.Cli.Commands (
where
import Control.Monad
import Data.Default
import Data.List
import Data.List.Split (splitOn)
#if !(MIN_VERSION_base(4,11,0))
@ -269,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 Nothing True Nothing str1 >>= either error' (return . ignoresourcepos)
j2 <- readJournal Nothing Nothing True Nothing str2 >>= either error' (return . ignoresourcepos)
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)
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" <>
@ -287,13 +288,13 @@ tests_Hledger_Cli_Commands = TestList [
)
,"apply account directive should preserve \"virtual\" posting type" ~: do
j <- readJournal Nothing Nothing True Nothing "apply account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return
j <- readJournal Nothing 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 Nothing True Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" >>= either error' return
j <- readJournal Nothing 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"
@ -315,7 +316,7 @@ tests_Hledger_Cli_Commands = TestList [
-- `is` "aa:aa:aaaaaaaaaaaaaa")
,"default year" ~: do
j <- readJournal Nothing Nothing True Nothing defaultyear_journal_txt >>= either error' return
j <- readJournal Nothing def Nothing defaultyear_journal_txt >>= either error' return
tdate (head $ jtxns j) `is` fromGregorian 2009 1 1
return ()

View File

@ -57,8 +57,6 @@ import Hledger.Data
import Hledger.Read
import Hledger.Reports
import Hledger.Utils
import Hledger.Query (Query(Any))
-- | Parse the user's specified journal file, maybe apply some transformations
-- (aliases, pivot) and run a hledger command on it, or throw an error.
@ -75,7 +73,6 @@ withJournalDo opts cmd = do
. journalApplyAliases (aliasesFromOpts opts)
<=< journalApplyValue (reportopts_ opts)
<=< journalAddForecast opts
. generateAutomaticPostings (reportopts_ opts)
either error' f ej
-- | Apply the pivot transformation on a journal, if option is present.
@ -147,15 +144,6 @@ journalAddForecast opts j = do
in
either error' id $ journalBalanceTransactions assrt j
-- | Generate Automatic postings and add them to the current journal.
generateAutomaticPostings :: ReportOpts -> Journal -> Journal
generateAutomaticPostings ropts j =
if auto_ ropts then j { jtxns = map modifier $ jtxns j } else j
where
modifier = foldr (flip (.) . runModifierTransaction') id mtxns
runModifierTransaction' = fmap txnTieKnot . runModifierTransaction Any
mtxns = jmodifiertxns j
-- | Write some output to stdout or to a file selected by --output-file.
-- If the file exists it will be overwritten.
writeOutput :: CliOpts -> String -> IO ()