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 | -- 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 | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -38,6 +38,7 @@ dependencies: | |||||||
| - aeson | - aeson | ||||||
| - bytestring | - bytestring | ||||||
| - containers | - containers | ||||||
|  | - data-default >=0.5 | ||||||
| - Decimal | - Decimal | ||||||
| - docopt | - docopt | ||||||
| - either | - either | ||||||
|  | |||||||
| @ -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 { | ||||||
|  | |||||||
| @ -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 | ||||||
| 
 | 
 | ||||||
|   ] |   ] | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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. | ||||||
|  | |||||||
| @ -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 () | ||||||
|  | |||||||
| @ -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) | ||||||
|  | |||||||
| @ -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 () | ||||||
|  | |||||||
| @ -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 () | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -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 () | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user