lib: auto postings generated before amount inference and balance checks (#729)
This commit is contained in:
		
							parent
							
								
									8633ab2e42
								
							
						
					
					
						commit
						ecf49b1e4b
					
				| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -38,6 +38,7 @@ dependencies: | ||||
| - aeson | ||||
| - bytestring | ||||
| - containers | ||||
| - data-default >=0.5 | ||||
| - Decimal | ||||
| - docopt | ||||
| - either | ||||
|  | ||||
| @ -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 { | ||||
|  | ||||
| @ -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 | ||||
| 
 | ||||
|   ] | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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. | ||||
|  | ||||
| @ -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 () | ||||
|  | ||||
| @ -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) | ||||
|  | ||||
| @ -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 () | ||||
|  | ||||
| @ -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 () | ||||
| 
 | ||||
|  | ||||
| @ -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 () | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user