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

View File

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

View File

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

View File

@ -22,7 +22,6 @@ where
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Control.DeepSeq (NFData) import Control.DeepSeq (NFData)
import Control.Monad.Except (ExceptT)
import Data.Data import Data.Data
import Data.Decimal import Data.Decimal
import Data.Default import Data.Default
@ -329,28 +328,6 @@ type ParsedJournal = Journal
-- The --output-format option selects one of these for output. -- The --output-format option selects one of these for output.
type StorageFormat = String 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 -- | An account, with name, balances and links to parent/subaccounts
-- which let you walk up or down the account tree. -- which let you walk up or down the account tree.
data Account = Account { data Account = Account {

View File

@ -40,6 +40,7 @@ import Control.Applicative ((<|>))
import Control.Arrow (right) import Control.Arrow (right)
import qualified Control.Exception as C import qualified Control.Exception as C
import Control.Monad.Except import Control.Monad.Except
import Data.Default
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Data.Ord import Data.Ord
@ -90,7 +91,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 >>= 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. -- | 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
@ -123,14 +124,13 @@ defaultJournalPath = do
-- (The final parse state saved in the Journal does span all files, however.) -- (The final parse state saved in the Journal does span all files, however.)
-- --
-- As with readJournalFile, -- As with readJournalFile,
-- file paths can optionally have a READER: prefix, -- input ioptions (@iopts@) specify CSV conversion rules file to help convert CSV data,
-- and the @mformat@, @mrulesfile, and @assrt@ arguments are supported -- enable or disable balance assertion checking and automated posting generation.
-- (and these are applied to all files).
-- --
readJournalFiles :: Maybe StorageFormat -> Maybe FilePath -> Bool -> [PrefixedFilePath] -> IO (Either String Journal) readJournalFiles :: Maybe StorageFormat -> InputOpts -> [PrefixedFilePath] -> IO (Either String Journal)
readJournalFiles mformat mrulesfile assrt prefixedfiles = do readJournalFiles mformat iopts prefixedfiles = do
(right mconcat1 . sequence) (right mconcat1 . sequence)
<$> mapM (readJournalFile mformat mrulesfile assrt) prefixedfiles <$> mapM (readJournalFile mformat iopts) prefixedfiles
where mconcat1 :: Monoid t => [t] -> t where mconcat1 :: Monoid t => [t] -> t
mconcat1 [] = mempty mconcat1 [] = mempty
mconcat1 x = foldr1 mappend x mconcat1 x = foldr1 mappend x
@ -146,17 +146,16 @@ readJournalFiles mformat mrulesfile assrt prefixedfiles = do
-- a recognised file name extension (in readJournal); -- a recognised file name extension (in readJournal);
-- if none of these identify a known reader, all built-in readers are tried in turn. -- 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 -> InputOpts -> PrefixedFilePath -> IO (Either String Journal)
-- readJournalFile mformat iopts prefixedfile = do
readJournalFile :: Maybe StorageFormat -> Maybe FilePath -> Bool -> PrefixedFilePath -> IO (Either String Journal)
readJournalFile mformat mrulesfile assrt prefixedfile = do
let let
(mprefixformat, f) = splitReaderPrefix prefixedfile (mprefixformat, f) = splitReaderPrefix prefixedfile
mfmt = mformat <|> mprefixformat mfmt = mformat <|> mprefixformat
requireJournalFileExists f 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, -- | If a filepath is prefixed by one of the reader names and a colon,
-- split that off. Eg "csv:-" -> (Just "csv", "-"). -- 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. -- | 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 Nothing True Nothing t >>= either error' return readJournal' t = readJournal Nothing def Nothing t >>= either error' return
tests_readJournal' = [ tests_readJournal' = [
"readJournal' parses sample journal" ~: do "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 -- 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). -- (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 -> InputOpts -> Maybe FilePath -> Text -> IO (Either String Journal)
-- readJournal mformat iopts mfile txt =
readJournal :: Maybe StorageFormat -> Maybe FilePath -> Bool -> Maybe FilePath -> Text -> IO (Either String Journal)
readJournal mformat mrulesfile assrt mfile txt =
let let
stablereaders = filter (not.rExperimental) readers stablereaders = filter (not.rExperimental) readers
rs = maybe stablereaders (:[]) $ findReader mformat mfile rs = maybe stablereaders (:[]) $ findReader mformat mfile
in in
tryReaders rs mrulesfile assrt mfile txt tryReaders rs iopts mfile txt
-- | @findReader mformat mpath@ -- | @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, -- 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. -- 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 :: [Reader] -> InputOpts -> Maybe FilePath -> Text -> IO (Either String Journal)
tryReaders readers mrulesfile assrt path t = firstSuccessOrFirstError [] readers tryReaders readers iopts path t = 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"
firstSuccessOrFirstError errs (r:rs) = do firstSuccessOrFirstError errs (r:rs) = do
dbg1IO "trying reader" (rFormat r) 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 dbg1IO "reader result" $ either id show result
case result of Right j -> return $ Right j -- success! case result of Right j -> return $ Right j -- success!
Left e -> firstSuccessOrFirstError (errs++[e]) rs -- keep trying 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 [] [] = return $ Left "no readers found"
firstSuccessOrFirstError errs (r:rs) = do firstSuccessOrFirstError errs (r:rs) = do
dbg1IO "trying reader" (rFormat r) 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 dbg1IO "reader result" $ either id show result
case result of Right j -> return $ Right j -- success! case result of Right j -> return $ Right j -- success!
Left e -> firstSuccessOrFirstError (errs++[e]) rs -- keep trying Left e -> firstSuccessOrFirstError (errs++[e]) rs -- keep trying
@ -408,7 +406,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 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 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.Data
import Hledger.Utils 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 -- $setup
@ -63,12 +85,13 @@ data InputOpts = InputOpts {
,new_ :: Bool -- ^ read only new transactions since this file was last read ,new_ :: Bool -- ^ read only new transactions since this file was last read
,new_save_ :: Bool -- ^ save latest new transactions state for next time ,new_save_ :: Bool -- ^ save latest new transactions state for next time
,pivot_ :: String -- ^ use the given field's value as the account name ,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) } deriving (Show, Data) --, Typeable)
instance Default InputOpts where def = definputopts instance Default InputOpts where def = definputopts
definputopts :: InputOpts 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
rawOptsToInputOpts rawopts = InputOpts{ rawOptsToInputOpts rawopts = InputOpts{
@ -81,6 +104,7 @@ rawOptsToInputOpts rawopts = InputOpts{
,new_ = boolopt "new" rawopts ,new_ = boolopt "new" rawopts
,new_save_ = True ,new_save_ = True
,pivot_ = stringopt "pivot" rawopts ,pivot_ = stringopt "pivot" rawopts
,auto_ = boolopt "auto" rawopts
} }
--- * parsing utils --- * 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 | 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. -- path and file content: parse and post-process a Journal, or give an error.
parseAndFinaliseJournal :: ErroringJournalParser IO ParsedJournal -> Bool parseAndFinaliseJournal :: ErroringJournalParser IO ParsedJournal -> InputOpts
-> FilePath -> Text -> ExceptT String IO Journal -> FilePath -> Text -> ExceptT String IO Journal
parseAndFinaliseJournal parser assrt f txt = do parseAndFinaliseJournal parser iopts f txt = do
t <- liftIO getClockTime t <- liftIO getClockTime
y <- liftIO getCurrentYear y <- liftIO getCurrentYear
ep <- runParserT (evalStateT parser nulljournal {jparsedefaultyear=Just y}) f txt ep <- runParserT (evalStateT parser nulljournal {jparsedefaultyear=Just y}) f txt
case ep of 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 Right j -> return j
Left e -> throwError e Left e -> throwError e
Left e -> throwError $ parseErrorPretty e Left e -> throwError $ parseErrorPretty e
parseAndFinaliseJournal' :: JournalParser Identity ParsedJournal -> Bool -> FilePath -> Text -> ExceptT String IO Journal parseAndFinaliseJournal' :: JournalParser Identity ParsedJournal -> InputOpts
parseAndFinaliseJournal' parser assrt f txt = do -> FilePath -> Text -> ExceptT String IO Journal
parseAndFinaliseJournal' parser iopts f txt = do
t <- liftIO getClockTime t <- liftIO getClockTime
y <- liftIO getCurrentYear y <- liftIO getCurrentYear
let ep = runParser (evalStateT parser nulljournal {jparsedefaultyear=Just y}) f txt let ep = runParser (evalStateT parser nulljournal {jparsedefaultyear=Just y}) f txt
case ep of 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 Right j -> return j
Left e -> throwError e Left e -> throwError e
Left e -> throwError $ parseErrorPretty e Left e -> throwError $ parseErrorPretty e

View File

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

View File

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

View File

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

View File

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

View File

@ -6,6 +6,7 @@ module Application
, makeFoundation , makeFoundation
) where ) where
import Data.Default
import Data.IORef import Data.IORef
import Import import Import
import Yesod.Default.Config import Yesod.Default.Config
@ -79,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` readJournalFile Nothing Nothing True f j <- either error' id `fmap` readJournalFile Nothing 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)

View File

@ -23,6 +23,7 @@ import Network.Wai.Handler.Launch (runHostPortUrl)
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
#endif #endif
import Control.Monad import Control.Monad
import Data.Default
import Data.Text (pack) import Data.Text (pack)
import System.Exit (exitSuccess) import System.Exit (exitSuccess)
import System.IO (hFlush, stdout) import System.IO (hFlush, stdout)
@ -65,8 +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
. generateAutomaticPostings (reportopts_ cliopts) readJournalFile Nothing def f >>= either error' fn
readJournalFile Nothing Nothing True f >>= either error' fn
-- | The web command. -- | The web command.
web :: WebOpts -> Journal -> IO () web :: WebOpts -> Journal -> IO ()

View File

@ -37,6 +37,7 @@ module Hledger.Cli.Commands (
where where
import Control.Monad import Control.Monad
import Data.Default
import Data.List import Data.List
import Data.List.Split (splitOn) import Data.List.Split (splitOn)
#if !(MIN_VERSION_base(4,11,0)) #if !(MIN_VERSION_base(4,11,0))
@ -269,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 Nothing True Nothing str1 >>= either error' (return . ignoresourcepos) let sameParse str1 str2 = do j1 <- readJournal Nothing def Nothing str1 >>= either error' (return . ignoresourcepos)
j2 <- readJournal Nothing Nothing True Nothing str2 >>= 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} 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" <>
@ -287,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 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 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 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 let p = head $ tpostings $ head $ jtxns j
assertBool "" $ paccount p == "equity:draw:personal:food" assertBool "" $ paccount p == "equity:draw:personal:food"
@ -315,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 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 tdate (head $ jtxns j) `is` fromGregorian 2009 1 1
return () return ()

View File

@ -57,8 +57,6 @@ import Hledger.Data
import Hledger.Read import Hledger.Read
import Hledger.Reports import Hledger.Reports
import Hledger.Utils import Hledger.Utils
import Hledger.Query (Query(Any))
-- | Parse the user's specified journal file, maybe apply some transformations -- | Parse the user's specified journal file, maybe apply some transformations
-- (aliases, pivot) and run a hledger command on it, or throw an error. -- (aliases, pivot) and run a hledger command on it, or throw an error.
@ -75,7 +73,6 @@ withJournalDo opts cmd = do
. journalApplyAliases (aliasesFromOpts opts) . journalApplyAliases (aliasesFromOpts opts)
<=< journalApplyValue (reportopts_ opts) <=< journalApplyValue (reportopts_ opts)
<=< journalAddForecast opts <=< journalAddForecast opts
. generateAutomaticPostings (reportopts_ opts)
either error' f ej either error' f ej
-- | Apply the pivot transformation on a journal, if option is present. -- | Apply the pivot transformation on a journal, if option is present.
@ -147,15 +144,6 @@ journalAddForecast opts j = do
in in
either error' id $ journalBalanceTransactions assrt j 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. -- | Write some output to stdout or to a file selected by --output-file.
-- If the file exists it will be overwritten. -- If the file exists it will be overwritten.
writeOutput :: CliOpts -> String -> IO () writeOutput :: CliOpts -> String -> IO ()