hledger (empty) → 0.1
raw patch · 26 files changed
+3215/−0 lines, 26 filesdep +HUnitdep +QuickCheckdep +basesetup-changed
Dependencies added: HUnit, QuickCheck, base, containers, directory, haskell98, old-locale, parsec, regex-compat, time
Files
- BalanceCommand.hs +184/−0
- LICENSE +674/−0
- Ledger.hs +36/−0
- Ledger/Account.hs +20/−0
- Ledger/AccountName.hs +101/−0
- Ledger/Amount.hs +110/−0
- Ledger/Commodity.hs +42/−0
- Ledger/Entry.hs +98/−0
- Ledger/Ledger.hs +111/−0
- Ledger/Parse.hs +421/−0
- Ledger/RawLedger.hs +115/−0
- Ledger/RawTransaction.hs +36/−0
- Ledger/TimeLog.hs +63/−0
- Ledger/Transaction.hs +33/−0
- Ledger/Types.hs +103/−0
- Ledger/Utils.hs +158/−0
- Options.hs +120/−0
- PrintCommand.hs +18/−0
- README +29/−0
- RegisterCommand.hs +47/−0
- Setup.hs +4/−0
- Tests.hs +489/−0
- Utils.hs +43/−0
- hledger.cabal +47/−0
- hledger.hs +77/−0
- sample.ledger +36/−0
+ BalanceCommand.hs view
@@ -0,0 +1,184 @@+{-| ++A ledger-compatible @balance@ command. Here's how it should work:++A sample account tree (as in the sample.ledger file):++@+ assets+ cash+ checking+ saving+ expenses+ food+ supplies+ income+ gifts+ salary+ liabilities+ debts+@++The balance command shows top-level accounts by default:++@+ \> ledger balance+ $-1 assets+ $2 expenses+ $-2 income+ $1 liabilities+@++With -s (--showsubs), also show the subaccounts:++@+ $-1 assets+ $-2 cash+ $1 saving+ $2 expenses+ $1 food+ $1 supplies+ $-2 income+ $-1 gifts+ $-1 salary+ $1 liabilities:debts+@++- @checking@ is not shown because it has a zero balance and no interesting+ subaccounts. ++- @liabilities@ is displayed only as a prefix because it has the same balance+ as its single subaccount.++With an account pattern, show only the accounts with matching names:++@+ \> ledger balance o+ $1 expenses:food+ $-2 income+--------------------+ $-1 +@++- The o matched @food@ and @income@, so they are shown.++- Parents of matched accounts are also shown for context (@expenses@).++- This time the grand total is also shown, because it is not zero.++Again, -s adds the subaccounts:++@+\> ledger -s balance o+ $1 expenses:food+ $-2 income+ $-1 gifts+ $-1 salary+--------------------+ $-1 +@++- @food@ has no subaccounts. @income@ has two, so they are shown. ++- We do not add the subaccounts of parents included for context (@expenses@).++Some notes for the implementation:++- a simple balance report shows top-level accounts++- with an account pattern, it shows accounts whose leafname matches, plus their parents++- with the showsubs option, it also shows all subaccounts of the above++- zero-balance leaf accounts are removed++- the resulting account tree is displayed with each account's aggregated+ balance, with boring parents prefixed to the next line++- a boring parent has the same balance as its child and is not explicitly+ matched by the display options.++- the sum of the balances shown is displayed at the end, if it is non-zero++-}++module BalanceCommand+where+import Ledger.Utils+import Ledger.Types+import Ledger.Amount+import Ledger.AccountName+import Ledger.Ledger+import Options+import Utils+++-- | Print a balance report.+balance :: [Opt] -> [String] -> Ledger -> IO ()+balance opts args l = putStr $ showBalanceReport opts args l++-- | Generate balance report output for a ledger, based on options.+showBalanceReport :: [Opt] -> [String] -> Ledger -> String+showBalanceReport opts args l = acctsstr ++ totalstr+ where + acctsstr = concatMap (showAccountTreeWithBalances acctnamestoshow) $ subs treetoshow+ totalstr = if isZeroAmount total + then "" + else printf "--------------------\n%20s\n" $ showAmount total+ showingsubs = ShowSubs `elem` opts+ pats@(apats,dpats) = parseAccountDescriptionArgs args+ maxdepth = if null args && not showingsubs then 1 else 9999+ acctstoshow = balancereportaccts showingsubs apats l+ acctnamestoshow = map aname acctstoshow+ treetoshow = pruneZeroBalanceLeaves $ pruneUnmatchedAccounts $ treeprune maxdepth $ ledgerAccountTree 9999 l+ total = sumAmounts $ map abalance $ nonredundantaccts+ nonredundantaccts = filter (not . hasparentshowing) acctstoshow+ hasparentshowing a = (parentAccountName $ aname a) `elem` acctnamestoshow++ -- select accounts for which we should show balances, based on the options+ balancereportaccts :: Bool -> [String] -> Ledger -> [Account]+ balancereportaccts False [] l = topAccounts l+ balancereportaccts False pats l = accountsMatching pats l+ balancereportaccts True pats l = addsubaccts l $ balancereportaccts False pats l++ -- add (in tree order) any missing subacccounts to a list of accounts+ addsubaccts :: Ledger -> [Account] -> [Account]+ addsubaccts l as = concatMap addsubs as where addsubs = maybe [] flatten . ledgerAccountTreeAt l++ -- remove any accounts from the tree which are not one of the acctstoshow, + -- or one of their parents, or one of their subaccounts when doing --showsubs+ pruneUnmatchedAccounts :: Tree Account -> Tree Account+ pruneUnmatchedAccounts = treefilter matched+ where + matched (Account name _ _)+ | name `elem` acctnamestoshow = True+ | any (name `isAccountNamePrefixOf`) acctnamestoshow = True+ | showingsubs && any (`isAccountNamePrefixOf` name) acctnamestoshow = True+ | otherwise = False++ -- remove zero-balance leaf accounts (recursively)+ pruneZeroBalanceLeaves :: Tree Account -> Tree Account+ pruneZeroBalanceLeaves = treefilter (not . isZeroAmount . abalance)++-- | Show a tree of accounts with balances, for the balance report,+-- eliding boring parent accounts. Requires a list of the account names we+-- are interested in to help with that.+showAccountTreeWithBalances :: [AccountName] -> Tree Account -> String+showAccountTreeWithBalances matchedacctnames = + showAccountTreeWithBalances' matchedacctnames 0 ""+ where+ showAccountTreeWithBalances' :: [AccountName] -> Int -> String -> Tree Account -> String+ showAccountTreeWithBalances' matchedacctnames indentlevel prefix (Node (Account fullname _ bal) subs) =+ if isboringparent then showsubswithprefix else showacct ++ showsubswithindent+ where+ showsubswithprefix = showsubs indentlevel (fullname++":")+ showsubswithindent = showsubs (indentlevel+1) ""+ showsubs i p = concatMap (showAccountTreeWithBalances' matchedacctnames i p) subs+ showacct = showbal ++ " " ++ indent ++ prefix ++ leafname ++ "\n"+ showbal = printf "%20s" $ show bal+ indent = replicate (indentlevel * 2) ' '+ leafname = accountLeafName fullname+ numsubs = length subs+ subbal = abalance $ root $ head subs+ matched = fullname `elem` matchedacctnames+ isboringparent = numsubs >= 1 && (bal == subbal || not matched)
+ LICENSE view
@@ -0,0 +1,674 @@+ GNU GENERAL PUBLIC LICENSE+ Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The GNU General Public License is a free, copyleft license for+software and other kinds of works.++ The licenses for most software and other practical works are designed+to take away your freedom to share and change the works. By contrast,+the GNU General Public License is intended to guarantee your freedom to+share and change all versions of a program--to make sure it remains free+software for all its users. We, the Free Software Foundation, use the+GNU General Public License for most of our software; it applies also to+any other work released this way by its authors. You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+them if you wish), that you receive source code or can get it if you+want it, that you can change the software or use pieces of it in new+free programs, and that you know you can do these things.++ To protect your rights, we need to prevent others from denying you+these rights or asking you to surrender the rights. Therefore, you have+certain responsibilities if you distribute copies of the software, or if+you modify it: responsibilities to respect the freedom of others.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must pass on to the recipients the same+freedoms that you received. You must make sure that they, too, receive+or can get the source code. And you must show them these terms so they+know their rights.++ Developers that use the GNU GPL protect your rights with two steps:+(1) assert copyright on the software, and (2) offer you this License+giving you legal permission to copy, distribute and/or modify it.++ For the developers' and authors' protection, the GPL clearly explains+that there is no warranty for this free software. For both users' and+authors' sake, the GPL requires that modified versions be marked as+changed, so that their problems will not be attributed erroneously to+authors of previous versions.++ Some devices are designed to deny users access to install or run+modified versions of the software inside them, although the manufacturer+can do so. This is fundamentally incompatible with the aim of+protecting users' freedom to change the software. The systematic+pattern of such abuse occurs in the area of products for individuals to+use, which is precisely where it is most unacceptable. Therefore, we+have designed this version of the GPL to prohibit the practice for those+products. If such problems arise substantially in other domains, we+stand ready to extend this provision to those domains in future versions+of the GPL, as needed to protect the freedom of users.++ Finally, every program is threatened constantly by software patents.+States should not allow patents to restrict development and use of+software on general-purpose computers, but in those that do, we wish to+avoid the special danger that patents applied to a free program could+make it effectively proprietary. To prevent this, the GPL assures that+patents cannot be used to render the program non-free.++ The precise terms and conditions for copying, distribution and+modification follow.++ TERMS AND CONDITIONS++ 0. Definitions.++ "This License" refers to version 3 of the GNU General Public License.++ "Copyright" also means copyright-like laws that apply to other kinds of+works, such as semiconductor masks.++ "The Program" refers to any copyrightable work licensed under this+License. Each licensee is addressed as "you". "Licensees" and+"recipients" may be individuals or organizations.++ To "modify" a work means to copy from or adapt all or part of the work+in a fashion requiring copyright permission, other than the making of an+exact copy. The resulting work is called a "modified version" of the+earlier work or a work "based on" the earlier work.++ A "covered work" means either the unmodified Program or a work based+on the Program.++ To "propagate" a work means to do anything with it that, without+permission, would make you directly or secondarily liable for+infringement under applicable copyright law, except executing it on a+computer or modifying a private copy. Propagation includes copying,+distribution (with or without modification), making available to the+public, and in some countries other activities as well.++ To "convey" a work means any kind of propagation that enables other+parties to make or receive copies. Mere interaction with a user through+a computer network, with no transfer of a copy, is not conveying.++ An interactive user interface displays "Appropriate Legal Notices"+to the extent that it includes a convenient and prominently visible+feature that (1) displays an appropriate copyright notice, and (2)+tells the user that there is no warranty for the work (except to the+extent that warranties are provided), that licensees may convey the+work under this License, and how to view a copy of this License. If+the interface presents a list of user commands or options, such as a+menu, a prominent item in the list meets this criterion.++ 1. Source Code.++ The "source code" for a work means the preferred form of the work+for making modifications to it. "Object code" means any non-source+form of a work.++ A "Standard Interface" means an interface that either is an official+standard defined by a recognized standards body, or, in the case of+interfaces specified for a particular programming language, one that+is widely used among developers working in that language.++ The "System Libraries" of an executable work include anything, other+than the work as a whole, that (a) is included in the normal form of+packaging a Major Component, but which is not part of that Major+Component, and (b) serves only to enable use of the work with that+Major Component, or to implement a Standard Interface for which an+implementation is available to the public in source code form. A+"Major Component", in this context, means a major essential component+(kernel, window system, and so on) of the specific operating system+(if any) on which the executable work runs, or a compiler used to+produce the work, or an object code interpreter used to run it.++ The "Corresponding Source" for a work in object code form means all+the source code needed to generate, install, and (for an executable+work) run the object code and to modify the work, including scripts to+control those activities. However, it does not include the work's+System Libraries, or general-purpose tools or generally available free+programs which are used unmodified in performing those activities but+which are not part of the work. For example, Corresponding Source+includes interface definition files associated with source files for+the work, and the source code for shared libraries and dynamically+linked subprograms that the work is specifically designed to require,+such as by intimate data communication or control flow between those+subprograms and other parts of the work.++ The Corresponding Source need not include anything that users+can regenerate automatically from other parts of the Corresponding+Source.++ The Corresponding Source for a work in source code form is that+same work.++ 2. Basic Permissions.++ All rights granted under this License are granted for the term of+copyright on the Program, and are irrevocable provided the stated+conditions are met. This License explicitly affirms your unlimited+permission to run the unmodified Program. The output from running a+covered work is covered by this License only if the output, given its+content, constitutes a covered work. This License acknowledges your+rights of fair use or other equivalent, as provided by copyright law.++ You may make, run and propagate covered works that you do not+convey, without conditions so long as your license otherwise remains+in force. You may convey covered works to others for the sole purpose+of having them make modifications exclusively for you, or provide you+with facilities for running those works, provided that you comply with+the terms of this License in conveying all material for which you do+not control copyright. Those thus making or running the covered works+for you must do so exclusively on your behalf, under your direction+and control, on terms that prohibit them from making any copies of+your copyrighted material outside their relationship with you.++ Conveying under any other circumstances is permitted solely under+the conditions stated below. Sublicensing is not allowed; section 10+makes it unnecessary.++ 3. Protecting Users' Legal Rights From Anti-Circumvention Law.++ No covered work shall be deemed part of an effective technological+measure under any applicable law fulfilling obligations under article+11 of the WIPO copyright treaty adopted on 20 December 1996, or+similar laws prohibiting or restricting circumvention of such+measures.++ When you convey a covered work, you waive any legal power to forbid+circumvention of technological measures to the extent such circumvention+is effected by exercising rights under this License with respect to+the covered work, and you disclaim any intention to limit operation or+modification of the work as a means of enforcing, against the work's+users, your or third parties' legal rights to forbid circumvention of+technological measures.++ 4. Conveying Verbatim Copies.++ You may convey verbatim copies of the Program's source code as you+receive it, in any medium, provided that you conspicuously and+appropriately publish on each copy an appropriate copyright notice;+keep intact all notices stating that this License and any+non-permissive terms added in accord with section 7 apply to the code;+keep intact all notices of the absence of any warranty; and give all+recipients a copy of this License along with the Program.++ You may charge any price or no price for each copy that you convey,+and you may offer support or warranty protection for a fee.++ 5. Conveying Modified Source Versions.++ You may convey a work based on the Program, or the modifications to+produce it from the Program, in the form of source code under the+terms of section 4, provided that you also meet all of these conditions:++ a) The work must carry prominent notices stating that you modified+ it, and giving a relevant date.++ b) The work must carry prominent notices stating that it is+ released under this License and any conditions added under section+ 7. This requirement modifies the requirement in section 4 to+ "keep intact all notices".++ c) You must license the entire work, as a whole, under this+ License to anyone who comes into possession of a copy. This+ License will therefore apply, along with any applicable section 7+ additional terms, to the whole of the work, and all its parts,+ regardless of how they are packaged. This License gives no+ permission to license the work in any other way, but it does not+ invalidate such permission if you have separately received it.++ d) If the work has interactive user interfaces, each must display+ Appropriate Legal Notices; however, if the Program has interactive+ interfaces that do not display Appropriate Legal Notices, your+ work need not make them do so.++ A compilation of a covered work with other separate and independent+works, which are not by their nature extensions of the covered work,+and which are not combined with it such as to form a larger program,+in or on a volume of a storage or distribution medium, is called an+"aggregate" if the compilation and its resulting copyright are not+used to limit the access or legal rights of the compilation's users+beyond what the individual works permit. Inclusion of a covered work+in an aggregate does not cause this License to apply to the other+parts of the aggregate.++ 6. Conveying Non-Source Forms.++ You may convey a covered work in object code form under the terms+of sections 4 and 5, provided that you also convey the+machine-readable Corresponding Source under the terms of this License,+in one of these ways:++ a) Convey the object code in, or embodied in, a physical product+ (including a physical distribution medium), accompanied by the+ Corresponding Source fixed on a durable physical medium+ customarily used for software interchange.++ b) Convey the object code in, or embodied in, a physical product+ (including a physical distribution medium), accompanied by a+ written offer, valid for at least three years and valid for as+ long as you offer spare parts or customer support for that product+ model, to give anyone who possesses the object code either (1) a+ copy of the Corresponding Source for all the software in the+ product that is covered by this License, on a durable physical+ medium customarily used for software interchange, for a price no+ more than your reasonable cost of physically performing this+ conveying of source, or (2) access to copy the+ Corresponding Source from a network server at no charge.++ c) Convey individual copies of the object code with a copy of the+ written offer to provide the Corresponding Source. This+ alternative is allowed only occasionally and noncommercially, and+ only if you received the object code with such an offer, in accord+ with subsection 6b.++ d) Convey the object code by offering access from a designated+ place (gratis or for a charge), and offer equivalent access to the+ Corresponding Source in the same way through the same place at no+ further charge. You need not require recipients to copy the+ Corresponding Source along with the object code. If the place to+ copy the object code is a network server, the Corresponding Source+ may be on a different server (operated by you or a third party)+ that supports equivalent copying facilities, provided you maintain+ clear directions next to the object code saying where to find the+ Corresponding Source. Regardless of what server hosts the+ Corresponding Source, you remain obligated to ensure that it is+ available for as long as needed to satisfy these requirements.++ e) Convey the object code using peer-to-peer transmission, provided+ you inform other peers where the object code and Corresponding+ Source of the work are being offered to the general public at no+ charge under subsection 6d.++ A separable portion of the object code, whose source code is excluded+from the Corresponding Source as a System Library, need not be+included in conveying the object code work.++ A "User Product" is either (1) a "consumer product", which means any+tangible personal property which is normally used for personal, family,+or household purposes, or (2) anything designed or sold for incorporation+into a dwelling. In determining whether a product is a consumer product,+doubtful cases shall be resolved in favor of coverage. For a particular+product received by a particular user, "normally used" refers to a+typical or common use of that class of product, regardless of the status+of the particular user or of the way in which the particular user+actually uses, or expects or is expected to use, the product. A product+is a consumer product regardless of whether the product has substantial+commercial, industrial or non-consumer uses, unless such uses represent+the only significant mode of use of the product.++ "Installation Information" for a User Product means any methods,+procedures, authorization keys, or other information required to install+and execute modified versions of a covered work in that User Product from+a modified version of its Corresponding Source. The information must+suffice to ensure that the continued functioning of the modified object+code is in no case prevented or interfered with solely because+modification has been made.++ If you convey an object code work under this section in, or with, or+specifically for use in, a User Product, and the conveying occurs as+part of a transaction in which the right of possession and use of the+User Product is transferred to the recipient in perpetuity or for a+fixed term (regardless of how the transaction is characterized), the+Corresponding Source conveyed under this section must be accompanied+by the Installation Information. But this requirement does not apply+if neither you nor any third party retains the ability to install+modified object code on the User Product (for example, the work has+been installed in ROM).++ The requirement to provide Installation Information does not include a+requirement to continue to provide support service, warranty, or updates+for a work that has been modified or installed by the recipient, or for+the User Product in which it has been modified or installed. Access to a+network may be denied when the modification itself materially and+adversely affects the operation of the network or violates the rules and+protocols for communication across the network.++ Corresponding Source conveyed, and Installation Information provided,+in accord with this section must be in a format that is publicly+documented (and with an implementation available to the public in+source code form), and must require no special password or key for+unpacking, reading or copying.++ 7. Additional Terms.++ "Additional permissions" are terms that supplement the terms of this+License by making exceptions from one or more of its conditions.+Additional permissions that are applicable to the entire Program shall+be treated as though they were included in this License, to the extent+that they are valid under applicable law. If additional permissions+apply only to part of the Program, that part may be used separately+under those permissions, but the entire Program remains governed by+this License without regard to the additional permissions.++ When you convey a copy of a covered work, you may at your option+remove any additional permissions from that copy, or from any part of+it. (Additional permissions may be written to require their own+removal in certain cases when you modify the work.) You may place+additional permissions on material, added by you to a covered work,+for which you have or can give appropriate copyright permission.++ Notwithstanding any other provision of this License, for material you+add to a covered work, you may (if authorized by the copyright holders of+that material) supplement the terms of this License with terms:++ a) Disclaiming warranty or limiting liability differently from the+ terms of sections 15 and 16 of this License; or++ b) Requiring preservation of specified reasonable legal notices or+ author attributions in that material or in the Appropriate Legal+ Notices displayed by works containing it; or++ c) Prohibiting misrepresentation of the origin of that material, or+ requiring that modified versions of such material be marked in+ reasonable ways as different from the original version; or++ d) Limiting the use for publicity purposes of names of licensors or+ authors of the material; or++ e) Declining to grant rights under trademark law for use of some+ trade names, trademarks, or service marks; or++ f) Requiring indemnification of licensors and authors of that+ material by anyone who conveys the material (or modified versions of+ it) with contractual assumptions of liability to the recipient, for+ any liability that these contractual assumptions directly impose on+ those licensors and authors.++ All other non-permissive additional terms are considered "further+restrictions" within the meaning of section 10. If the Program as you+received it, or any part of it, contains a notice stating that it is+governed by this License along with a term that is a further+restriction, you may remove that term. If a license document contains+a further restriction but permits relicensing or conveying under this+License, you may add to a covered work material governed by the terms+of that license document, provided that the further restriction does+not survive such relicensing or conveying.++ If you add terms to a covered work in accord with this section, you+must place, in the relevant source files, a statement of the+additional terms that apply to those files, or a notice indicating+where to find the applicable terms.++ Additional terms, permissive or non-permissive, may be stated in the+form of a separately written license, or stated as exceptions;+the above requirements apply either way.++ 8. Termination.++ You may not propagate or modify a covered work except as expressly+provided under this License. Any attempt otherwise to propagate or+modify it is void, and will automatically terminate your rights under+this License (including any patent licenses granted under the third+paragraph of section 11).++ However, if you cease all violation of this License, then your+license from a particular copyright holder is reinstated (a)+provisionally, unless and until the copyright holder explicitly and+finally terminates your license, and (b) permanently, if the copyright+holder fails to notify you of the violation by some reasonable means+prior to 60 days after the cessation.++ Moreover, your license from a particular copyright holder is+reinstated permanently if the copyright holder notifies you of the+violation by some reasonable means, this is the first time you have+received notice of violation of this License (for any work) from that+copyright holder, and you cure the violation prior to 30 days after+your receipt of the notice.++ Termination of your rights under this section does not terminate the+licenses of parties who have received copies or rights from you under+this License. If your rights have been terminated and not permanently+reinstated, you do not qualify to receive new licenses for the same+material under section 10.++ 9. Acceptance Not Required for Having Copies.++ You are not required to accept this License in order to receive or+run a copy of the Program. Ancillary propagation of a covered work+occurring solely as a consequence of using peer-to-peer transmission+to receive a copy likewise does not require acceptance. However,+nothing other than this License grants you permission to propagate or+modify any covered work. These actions infringe copyright if you do+not accept this License. Therefore, by modifying or propagating a+covered work, you indicate your acceptance of this License to do so.++ 10. Automatic Licensing of Downstream Recipients.++ Each time you convey a covered work, the recipient automatically+receives a license from the original licensors, to run, modify and+propagate that work, subject to this License. You are not responsible+for enforcing compliance by third parties with this License.++ An "entity transaction" is a transaction transferring control of an+organization, or substantially all assets of one, or subdividing an+organization, or merging organizations. If propagation of a covered+work results from an entity transaction, each party to that+transaction who receives a copy of the work also receives whatever+licenses to the work the party's predecessor in interest had or could+give under the previous paragraph, plus a right to possession of the+Corresponding Source of the work from the predecessor in interest, if+the predecessor has it or can get it with reasonable efforts.++ You may not impose any further restrictions on the exercise of the+rights granted or affirmed under this License. For example, you may+not impose a license fee, royalty, or other charge for exercise of+rights granted under this License, and you may not initiate litigation+(including a cross-claim or counterclaim in a lawsuit) alleging that+any patent claim is infringed by making, using, selling, offering for+sale, or importing the Program or any portion of it.++ 11. Patents.++ A "contributor" is a copyright holder who authorizes use under this+License of the Program or a work on which the Program is based. The+work thus licensed is called the contributor's "contributor version".++ A contributor's "essential patent claims" are all patent claims+owned or controlled by the contributor, whether already acquired or+hereafter acquired, that would be infringed by some manner, permitted+by this License, of making, using, or selling its contributor version,+but do not include claims that would be infringed only as a+consequence of further modification of the contributor version. For+purposes of this definition, "control" includes the right to grant+patent sublicenses in a manner consistent with the requirements of+this License.++ Each contributor grants you a non-exclusive, worldwide, royalty-free+patent license under the contributor's essential patent claims, to+make, use, sell, offer for sale, import and otherwise run, modify and+propagate the contents of its contributor version.++ In the following three paragraphs, a "patent license" is any express+agreement or commitment, however denominated, not to enforce a patent+(such as an express permission to practice a patent or covenant not to+sue for patent infringement). To "grant" such a patent license to a+party means to make such an agreement or commitment not to enforce a+patent against the party.++ If you convey a covered work, knowingly relying on a patent license,+and the Corresponding Source of the work is not available for anyone+to copy, free of charge and under the terms of this License, through a+publicly available network server or other readily accessible means,+then you must either (1) cause the Corresponding Source to be so+available, or (2) arrange to deprive yourself of the benefit of the+patent license for this particular work, or (3) arrange, in a manner+consistent with the requirements of this License, to extend the patent+license to downstream recipients. "Knowingly relying" means you have+actual knowledge that, but for the patent license, your conveying the+covered work in a country, or your recipient's use of the covered work+in a country, would infringe one or more identifiable patents in that+country that you have reason to believe are valid.++ If, pursuant to or in connection with a single transaction or+arrangement, you convey, or propagate by procuring conveyance of, a+covered work, and grant a patent license to some of the parties+receiving the covered work authorizing them to use, propagate, modify+or convey a specific copy of the covered work, then the patent license+you grant is automatically extended to all recipients of the covered+work and works based on it.++ A patent license is "discriminatory" if it does not include within+the scope of its coverage, prohibits the exercise of, or is+conditioned on the non-exercise of one or more of the rights that are+specifically granted under this License. You may not convey a covered+work if you are a party to an arrangement with a third party that is+in the business of distributing software, under which you make payment+to the third party based on the extent of your activity of conveying+the work, and under which the third party grants, to any of the+parties who would receive the covered work from you, a discriminatory+patent license (a) in connection with copies of the covered work+conveyed by you (or copies made from those copies), or (b) primarily+for and in connection with specific products or compilations that+contain the covered work, unless you entered into that arrangement,+or that patent license was granted, prior to 28 March 2007.++ Nothing in this License shall be construed as excluding or limiting+any implied license or other defenses to infringement that may+otherwise be available to you under applicable patent law.++ 12. No Surrender of Others' Freedom.++ If conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot convey a+covered work so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you may+not convey it at all. For example, if you agree to terms that obligate you+to collect a royalty for further conveying from those to whom you convey+the Program, the only way you could satisfy both those terms and this+License would be to refrain entirely from conveying the Program.++ 13. Use with the GNU Affero General Public License.++ Notwithstanding any other provision of this License, you have+permission to link or combine any covered work with a work licensed+under version 3 of the GNU Affero General Public License into a single+combined work, and to convey the resulting work. The terms of this+License will continue to apply to the part which is the covered work,+but the special requirements of the GNU Affero General Public License,+section 13, concerning interaction through a network will apply to the+combination as such.++ 14. Revised Versions of this License.++ The Free Software Foundation may publish revised and/or new versions of+the GNU General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++ Each version is given a distinguishing version number. If the+Program specifies that a certain numbered version of the GNU General+Public License "or any later version" applies to it, you have the+option of following the terms and conditions either of that numbered+version or of any later version published by the Free Software+Foundation. If the Program does not specify a version number of the+GNU General Public License, you may choose any version ever published+by the Free Software Foundation.++ If the Program specifies that a proxy can decide which future+versions of the GNU General Public License can be used, that proxy's+public statement of acceptance of a version permanently authorizes you+to choose that version for the Program.++ Later license versions may give you additional or different+permissions. However, no additional obligations are imposed on any+author or copyright holder as a result of your choosing to follow a+later version.++ 15. Disclaimer of Warranty.++ THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY+APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM+IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++ 16. Limitation of Liability.++ IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF+SUCH DAMAGES.++ 17. Interpretation of Sections 15 and 16.++ If the disclaimer of warranty and limitation of liability provided+above cannot be given local legal effect according to their terms,+reviewing courts shall apply local law that most closely approximates+an absolute waiver of all civil liability in connection with the+Program, unless a warranty or assumption of liability accompanies a+copy of the Program in return for a fee.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+state the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This program is free software: you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation, either version 3 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program. If not, see <http://www.gnu.org/licenses/>.++Also add information on how to contact you by electronic and paper mail.++ If the program does terminal interaction, make it output a short+notice like this when it starts in an interactive mode:++ <program> Copyright (C) <year> <name of author>+ This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, your program's commands+might be different; for a GUI interface, you would use an "about box".++ You should also get your employer (if you work as a programmer) or school,+if any, to sign a "copyright disclaimer" for the program, if necessary.+For more information on this, and how to apply and follow the GNU GPL, see+<http://www.gnu.org/licenses/>.++ The GNU General Public License does not permit incorporating your program+into proprietary programs. If your program is a subroutine library, you+may consider it more useful to permit linking proprietary applications with+the library. If this is what you want to do, use the GNU Lesser General+Public License instead of this License. But first, please read+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+ Ledger.hs view
@@ -0,0 +1,36 @@+{-| ++The Ledger package allows parsing and querying of ledger files.+It generally provides a compatible subset of C++ ledger's functionality.++-}++module Ledger (+ module Ledger.Account,+ module Ledger.AccountName,+ module Ledger.Amount,+ module Ledger.Commodity,+ module Ledger.Entry,+ module Ledger.Ledger,+ module Ledger.Parse,+ module Ledger.RawLedger,+ module Ledger.RawTransaction,+ module Ledger.TimeLog,+ module Ledger.Transaction,+ module Ledger.Types,+ module Ledger.Utils,+ )+where+import Ledger.Account+import Ledger.AccountName+import Ledger.Amount+import Ledger.Commodity+import Ledger.Entry+import Ledger.Ledger+import Ledger.Parse+import Ledger.RawLedger+import Ledger.RawTransaction+import Ledger.TimeLog+import Ledger.Transaction+import Ledger.Types+import Ledger.Utils
+ Ledger/Account.hs view
@@ -0,0 +1,20 @@+{-|++An 'Account' stores an account name, all transactions in the account+(excluding any subaccounts), and the total balance (including any+subaccounts).++-}++module Ledger.Account+where+import Ledger.Utils+import Ledger.Types+import Ledger.Amount+++instance Show Account where+ show (Account a ts b) = printf "Account %s with %d txns and %s balance" a (length ts) (show b)++nullacct = Account "" [] nullamt+
+ Ledger/AccountName.hs view
@@ -0,0 +1,101 @@+{-|++'AccountName's are strings like @assets:cash:petty@.+From a set of these we derive the account hierarchy.++-}++module Ledger.AccountName+where+import Ledger.Utils+import Ledger.Types+++sepchar = ':'++accountNameComponents :: AccountName -> [String]+accountNameComponents = splitAtElement sepchar++accountNameFromComponents :: [String] -> AccountName+accountNameFromComponents = concat . intersperse [sepchar]++accountLeafName :: AccountName -> String+accountLeafName = last . accountNameComponents++accountNameLevel :: AccountName -> Int+accountNameLevel "" = 0+accountNameLevel a = (length $ filter (==sepchar) a) + 1++-- | ["a:b:c","d:e"] -> ["a","a:b","a:b:c","d","d:e"]+expandAccountNames :: [AccountName] -> [AccountName]+expandAccountNames as = nub $ concat $ map expand as+ where expand as = map accountNameFromComponents (tail $ inits $ accountNameComponents as)++-- | ["a:b:c","d:e"] -> ["a","d"]+topAccountNames :: [AccountName] -> [AccountName]+topAccountNames as = [a | a <- expandAccountNames as, accountNameLevel a == 1]++parentAccountName :: AccountName -> AccountName+parentAccountName a = accountNameFromComponents $ init $ accountNameComponents a++parentAccountNames :: AccountName -> [AccountName]+parentAccountNames a = parentAccountNames' $ parentAccountName a+ where+ parentAccountNames' "" = []+ parentAccountNames' a = [a] ++ (parentAccountNames' $ parentAccountName a)++isAccountNamePrefixOf :: AccountName -> AccountName -> Bool+p `isAccountNamePrefixOf` s = ((p ++ [sepchar]) `isPrefixOf` s)++isSubAccountNameOf :: AccountName -> AccountName -> Bool+s `isSubAccountNameOf` p = + (p `isAccountNamePrefixOf` s) && (accountNameLevel s == (accountNameLevel p + 1))++subAccountNamesFrom :: [AccountName] -> AccountName -> [AccountName]+subAccountNamesFrom accts a = filter (`isSubAccountNameOf` a) accts++-- | We could almost get by with just the AccountName manipulations+-- above, but we need smarter structures to eg display the account+-- tree with boring accounts elided. This converts a list of+-- AccountName to a tree (later we will convert that to a tree of+-- 'Account'.)+accountNameTreeFrom_props =+ [+ accountNameTreeFrom ["a"] == Node "top" [Node "a" []],+ accountNameTreeFrom ["a","b"] == Node "top" [Node "a" [], Node "b" []],+ accountNameTreeFrom ["a","a:b"] == Node "top" [Node "a" [Node "a:b" []]],+ accountNameTreeFrom ["a:b"] == Node "top" [Node "a" [Node "a:b" []]]+ ]+accountNameTreeFrom :: [AccountName] -> Tree AccountName+accountNameTreeFrom accts = + Node "top" (accountsFrom (topAccountNames accts))+ where+ accountsFrom :: [AccountName] -> [Tree AccountName]+ accountsFrom [] = []+ accountsFrom as = [Node a (accountsFrom $ subs a) | a <- as]+ subs = (subAccountNamesFrom accts)++-- | Elide an account name to fit in the specified width.+-- From the ledger 2.6 news:+-- +-- @+-- What Ledger now does is that if an account name is too long, it will+-- start abbreviating the first parts of the account name down to two+-- letters in length. If this results in a string that is still too+-- long, the front will be elided -- not the end. For example:+--+-- Expenses:Cash ; OK, not too long+-- Ex:Wednesday:Cash ; "Expenses" was abbreviated to fit+-- Ex:We:Afternoon:Cash ; "Expenses" and "Wednesday" abbreviated+-- ; Expenses:Wednesday:Afternoon:Lunch:Snack:Candy:Chocolate:Cash+-- ..:Af:Lu:Sn:Ca:Ch:Cash ; Abbreviated and elided!+-- @+elideAccountName :: Int -> AccountName -> AccountName+elideAccountName width s = + elideLeft width $ accountNameFromComponents $ elideparts width [] $ accountNameComponents s+ where+ elideparts :: Int -> [String] -> [String] -> [String]+ elideparts width done ss+ | (length $ accountNameFromComponents $ done++ss) <= width = done++ss+ | length ss > 1 = elideparts width (done++[take 2 $ head ss]) (tail ss)+ | otherwise = done++ss
+ Ledger/Amount.hs view
@@ -0,0 +1,110 @@+{-|+An 'Amount' is some quantity of money, shares, or anything else.++A simple amount is a commodity, quantity pair (where commodity can be anything):++@+ $1 + £-50+ EUR 3.44 + GOOG 500+ 1.5h+ 90apples+ 0 +@++A mixed amount (not yet implemented) is one or more simple amounts:++@+ $50, EUR 3, AAPL 500+ 16h, $13.55, oranges 6+@++Commodities may be convertible or not. A mixed amount containing only+convertible commodities can be converted to a simple amount. Arithmetic+examples:++@+ $1 - $5 = $-4+ $1 + EUR 0.76 = $2+ EUR0.76 + $1 = EUR 1.52+ EUR0.76 - $1 = 0+ ($5, 2h) + $1 = ($6, 2h)+ ($50, EUR 3, AAPL 500) + ($13.55, oranges 6) = $67.51, AAPL 500, oranges 6+ ($50, EUR 3) * $-1 = $-53.96+ ($50, AAPL 500) * $-1 = error+@ +-}++module Ledger.Amount+where+import Ledger.Utils+import Ledger.Types+import Ledger.Commodity+++instance Show Amount where show = showAmount++-- | Get the string representation of an amount, based on its commodity's+-- display settings.+showAmount :: Amount -> String+showAmount (Amount (Commodity {symbol=sym,side=side,spaced=spaced,comma=comma,precision=p}) q)+ | side==L = printf "%s%s%s" sym space quantity+ | side==R = printf "%s%s%s" quantity space sym+ where + space = if spaced then " " else ""+ quantity = commad $ printf ("%."++show p++"f") q+ commad = if comma then punctuatethousands else id++-- | Add thousands-separating commas to a decimal number string+punctuatethousands :: String -> String+punctuatethousands s =+ sign ++ (addcommas int) ++ frac+ where + (sign,num) = break isDigit s+ (int,frac) = break (=='.') num+ addcommas = reverse . concat . intersperse "," . triples . reverse+ triples [] = []+ triples l = [take 3 l] ++ (triples $ drop 3 l)++-- | Get the string representation of an amount, rounded, or showing just "0" if it's zero.+showAmountOrZero :: Amount -> String+showAmountOrZero a+ | isZeroAmount a = "0"+ | otherwise = showAmount a++-- | is this amount zero, when displayed with its given precision ?+isZeroAmount :: Amount -> Bool+isZeroAmount a@(Amount c _ ) = nonzerodigits == ""+ where nonzerodigits = filter (`elem` "123456789") $ showAmount a++instance Num Amount where+ abs (Amount c q) = Amount c (abs q)+ signum (Amount c q) = Amount c (signum q)+ fromInteger i = Amount (comm "") (fromInteger i)+ (+) = amountop (+)+ (-) = amountop (-)+ (*) = amountop (*)++-- | Apply a binary arithmetic operator to two amounts, converting to the+-- second one's commodity and adopting the lowest precision. (Using the+-- second commodity means that folds (like sum [Amount]) will preserve the+-- commodity.)+amountop :: (Double -> Double -> Double) -> Amount -> Amount -> Amount+amountop op a@(Amount ac aq) b@(Amount bc bq) = + Amount bc ((quantity $ convertAmountTo bc a) `op` bq)++-- | Convert an amount to the specified commodity using the appropriate+-- exchange rate.+convertAmountTo :: Commodity -> Amount -> Amount+convertAmountTo c2 (Amount c1 q) = Amount c2 (q * conversionRate c1 c2)++-- | Sum a list of amounts. This is still needed because a final zero+-- amount will discard the sum's commodity.+sumAmounts :: [Amount] -> Amount+sumAmounts = sum . filter (not . isZeroAmount)++nullamt = Amount (comm "") 0++-- temporary value for partial entries+autoamt = Amount (Commodity {symbol="AUTO",side=L,spaced=False,comma=False,precision=0,rate=1}) 0
+ Ledger/Commodity.hs view
@@ -0,0 +1,42 @@+{-|++A 'Commodity' is a symbol representing a currency or some other kind of+thing we are tracking, and some settings that tell how to display amounts+of the commodity. For the moment, commodities also include a hard-coded+conversion rate relative to the dollar.++-}+module Ledger.Commodity+where+import qualified Data.Map as Map+import Ledger.Utils+import Ledger.Types+++-- for nullamt, autoamt, etc.+unknown = Commodity {symbol="",side=L,spaced=False,comma=False,precision=0,rate=1}++-- convenient amount and commodity constructors, for tests etc.++dollar = Commodity {symbol="$",side=L,spaced=False,comma=False,precision=2,rate=1}+euro = Commodity {symbol="EUR",side=L,spaced=False,comma=False,precision=2,rate=0.760383}+pound = Commodity {symbol="£",side=L,spaced=False,comma=False,precision=2,rate=0.512527}+hour = Commodity {symbol="h",side=R,spaced=False,comma=False,precision=1,rate=100}++dollars = Amount dollar+euros = Amount euro+pounds = Amount pound+hours = Amount hour++defaultcommodities = [dollar, euro, pound, hour, unknown]++defaultcommoditiesmap :: Map.Map String Commodity+defaultcommoditiesmap = Map.fromList [(symbol c :: String, c :: Commodity) | c <- defaultcommodities]++comm :: String -> Commodity+comm symbol = Map.findWithDefault (error "commodity lookup failed") symbol defaultcommoditiesmap++-- | Find the conversion rate between two commodities.+conversionRate :: Commodity -> Commodity -> Double+conversionRate oldc newc = (rate newc) / (rate oldc)+
+ Ledger/Entry.hs view
@@ -0,0 +1,98 @@+{-|++An 'Entry' represents a regular entry in the ledger file. It contains two+or more 'RawTransaction's whose sum must be zero.++-}++module Ledger.Entry+where+import Ledger.Utils+import Ledger.Types+import Ledger.RawTransaction+import Ledger.Amount+++instance Show Entry where show = showEntry++{-+Helpers for the register report. A register entry is displayed as two+or more lines like this:++@+date description account amount balance+DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA+ aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA+ ... ... ...++datewidth = 10+descwidth = 20+acctwidth = 22+amtwidth = 11+balwidth = 12+@+-}++showEntryDescription e = + (showDate $ edate e) ++ " " ++ (showDescription $ edescription e) ++ " "+showDate d = printf "%-10s" d+showDescription s = printf "%-20s" (elideRight 20 s)++isEntryBalanced :: Entry -> Bool+isEntryBalanced (Entry {etransactions=ts}) = isZeroAmount sum && numcommodities==1+ where+ sum = sumLedgerTransactions ts+ numcommodities = length $ nub $ map (symbol . commodity . tamount) ts++autofillEntry :: Entry -> Entry+autofillEntry e@(Entry {etransactions=ts}) = e{etransactions=autofillTransactions ts}++assertBalancedEntry :: Entry -> Entry+assertBalancedEntry e+ | isEntryBalanced e = e+ | otherwise = error $ "transactions don't balance in:\n" ++ show e++{-|+Helper for the print command which shows cleaned up ledger file+entries, something like:++@+yyyy/mm/dd[ *][ CODE] description......... [ ; comment...............]+ account name 1..................... ...$amount1[ ; comment...............]+ account name 2..................... ..$-amount1[ ; comment...............]++pcodewidth = no limit -- 10+pdescwidth = no limit -- 20+pacctwidth = 35 minimum, no maximum+pamtwidth = 11+pcommentwidth = no limit -- 22+@+-}+showEntry :: Entry -> String+showEntry e = + unlines $ [precedingcomment ++ description] ++ (showtxns $ etransactions e) ++ [""]+ where+ precedingcomment = epreceding_comment_lines e+ description = concat [date, status, code, desc] -- , comment]+ date = showDate $ edate e+ status = if estatus e then " *" else ""+ code = if (length $ ecode e) > 0 then (printf " (%s)" $ ecode e) else ""+ desc = " " ++ edescription e+ comment = if (length $ ecomment e) > 0 then " ; "++(ecomment e) else ""+ showtxns (t1:t2:[]) = [showtxn t1, showtxnnoamt t2]+ showtxns ts = map showtxn ts+ showtxn t = showacct t ++ " " ++ (showamount $ tamount t) ++ (showcomment $ tcomment t)+ showtxnnoamt t = showacct t ++ " " ++ (showcomment $ tcomment t)+ showacct t = " " ++ (showaccountname $ taccount t)+ showamount = printf "%12s" . showAmount+ showaccountname s = printf "%-34s" s+ showcomment s = if (length s) > 0 then " ; "++s else ""++-- modifier & periodic entries++instance Show ModifierEntry where + show e = "= " ++ (valueexpr e) ++ "\n" ++ unlines (map show (m_transactions e))++instance Show PeriodicEntry where + show e = "~ " ++ (periodexpr e) ++ "\n" ++ unlines (map show (p_transactions e))+
+ Ledger/Ledger.hs view
@@ -0,0 +1,111 @@+{-|++A 'Ledger' stores, for efficiency, a 'RawLedger' plus its tree of account+names, a map from account names to 'Account's, and the display precision.+Typically it has also has had the uninteresting 'Entry's filtered out.++-}++module Ledger.Ledger+where+import qualified Data.Map as Map+import Data.Map ((!))+import Ledger.Utils+import Ledger.Types+import Ledger.Amount+import Ledger.AccountName+import Ledger.Transaction+import Ledger.RawLedger+import Ledger.Entry+++instance Show Ledger where+ show l = printf "Ledger with %d entries, %d accounts\n%s"+ ((length $ entries $ rawledger l) ++ (length $ modifier_entries $ rawledger l) ++ (length $ periodic_entries $ rawledger l))+ (length $ accountnames l)+ (showtree $ accountnametree l)++-- | Convert a raw ledger to a more efficient cached type, described above. +cacheLedger :: RawLedger -> Ledger+cacheLedger l = + let + ant = rawLedgerAccountNameTree l+ anames = flatten ant+ ts = rawLedgerTransactions l+ sortedts = sortBy (comparing account) ts+ groupedts = groupBy (\t1 t2 -> account t1 == account t2) sortedts+ txnmap = Map.union + (Map.fromList [(account $ head g, g) | g <- groupedts])+ (Map.fromList [(a,[]) | a <- anames])+ txnsof = (txnmap !)+ subacctsof a = filter (isAccountNamePrefixOf a) anames+ subtxnsof a = concat [txnsof a | a <- [a] ++ subacctsof a]+ balmap = Map.union + (Map.fromList [(a, (sumTransactions $ subtxnsof a)) | a <- anames])+ (Map.fromList [(a,nullamt) | a <- anames])+ amap = Map.fromList [(a, Account a (txnmap ! a) (balmap ! a)) | a <- anames]+ in+ Ledger l ant amap++-- | List a 'Ledger' 's account names.+accountnames :: Ledger -> [AccountName]+accountnames l = drop 1 $ flatten $ accountnametree l++-- | Get the named account from a ledger.+ledgerAccount :: Ledger -> AccountName -> Account+ledgerAccount l a = (accountmap l) ! a++-- | List a ledger's accounts, in tree order+accounts :: Ledger -> [Account]+accounts l = drop 1 $ flatten $ ledgerAccountTree 9999 l++-- | List a ledger's top-level accounts, in tree order+topAccounts :: Ledger -> [Account]+topAccounts l = map root $ branches $ ledgerAccountTree 9999 l++-- | Accounts in ledger whose name matches the pattern, in tree order.+-- We apply ledger's special rules for balance report account matching+-- (see 'matchLedgerPatterns').+accountsMatching :: [String] -> Ledger -> [Account]+accountsMatching pats l = filter (matchLedgerPatterns True pats . aname) $ accounts l++-- | List a ledger account's immediate subaccounts+subAccounts :: Ledger -> Account -> [Account]+subAccounts l a = map (ledgerAccount l) subacctnames+ where+ allnames = accountnames l+ name = aname a+ subacctnames = filter (name `isAccountNamePrefixOf`) allnames++-- | List a ledger's transactions.+--+-- NB this sets the amount precisions to that of the highest-precision+-- amount, to help with report output. It should perhaps be done in the+-- display functions, but those are far removed from the ledger. Keep in+-- mind if doing more arithmetic with these.+ledgerTransactions :: Ledger -> [Transaction]+ledgerTransactions l = rawLedgerTransactions $ rawledger l++-- | Get a ledger's tree of accounts to the specified depth.+ledgerAccountTree :: Int -> Ledger -> Tree Account+ledgerAccountTree depth l = + addDataToAccountNameTree l depthpruned+ where+ nametree = accountnametree l+ depthpruned = treeprune depth nametree++-- that's weird.. why can't this be in Account.hs ?+instance Eq Account where+ (==) (Account n1 t1 b1) (Account n2 t2 b2) = n1 == n2 && t1 == t2 && b1 == b2++-- | Get a ledger's tree of accounts rooted at the specified account.+ledgerAccountTreeAt :: Ledger -> Account -> Maybe (Tree Account)+ledgerAccountTreeAt l acct = subtreeat acct $ ledgerAccountTree 9999 l++-- | Convert a tree of account names into a tree of accounts, using their+-- parent ledger.+addDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account+addDataToAccountNameTree = treemap . ledgerAccount+
+ Ledger/Parse.hs view
@@ -0,0 +1,421 @@+{-|++Parsers for standard ledger and timelog files.++-}++module Ledger.Parse+where+import Text.ParserCombinators.Parsec+import Text.ParserCombinators.Parsec.Char+import Text.ParserCombinators.Parsec.Language+import Text.ParserCombinators.Parsec.Combinator+import qualified Text.ParserCombinators.Parsec.Token as P+import System.IO+import qualified Data.Map as Map+import Ledger.Utils+import Ledger.Types+import Ledger.Amount+import Ledger.Entry+import Ledger.Commodity+import Ledger.TimeLog+++-- utils++parseLedgerFile :: String -> IO (Either ParseError RawLedger)+parseLedgerFile "-" = fmap (parse ledgerfile "-") $ hGetContents stdin+parseLedgerFile f = parseFromFile ledgerfile f+ +printParseError :: (Show a) => a -> IO ()+printParseError e = do putStr "ledger parse error at "; print e++-- set up token parsing, though we're not yet using these much+ledgerLanguageDef = LanguageDef {+ commentStart = ""+ , commentEnd = ""+ , commentLine = ";"+ , nestedComments = False+ , identStart = letter <|> char '_'+ , identLetter = alphaNum <|> oneOf "_':"+ , opStart = opLetter emptyDef+ , opLetter = oneOf "!#$%&*+./<=>?@\\^|-~"+ , reservedOpNames= []+ , reservedNames = []+ , caseSensitive = False+ }+lexer = P.makeTokenParser ledgerLanguageDef+whiteSpace = P.whiteSpace lexer+lexeme = P.lexeme lexer+--symbol = P.symbol lexer+natural = P.natural lexer+parens = P.parens lexer+semi = P.semi lexer+identifier = P.identifier lexer+reserved = P.reserved lexer+reservedOp = P.reservedOp lexer++-- parsers++-- | Parse a RawLedger from either a ledger file or a timelog file.+-- It tries first the timelog parser then the ledger parser; this means+-- parse errors for ledgers are useful while those for timelogs are not.+ledgerfile :: Parser RawLedger+ledgerfile = try ledgerfromtimelog <|> ledger++{-| Parse a ledger file. Here is the ledger grammar from the ledger 2.5 manual:++@+The ledger file format is quite simple, but also very flexible. It supports+many options, though typically the user can ignore most of them. They are+summarized below. The initial character of each line determines what the+line means, and how it should be interpreted. Allowable initial characters+are:++NUMBER A line beginning with a number denotes an entry. It may be followed by any+ number of lines, each beginning with whitespace, to denote the entry’s account+ transactions. The format of the first line is:++ DATE[=EDATE] [*|!] [(CODE)] DESC++ If ‘*’ appears after the date (with optional effective date), it indicates the entry+ is “cleared”, which can mean whatever the user wants it t omean. If ‘!’ appears+ after the date, it indicates d the entry is “pending”; i.e., tentatively cleared from+ the user’s point of view, but not yet actually cleared. If a ‘CODE’ appears in+ parentheses, it may be used to indicate a check number, or the type of the+ transaction. Following these is the payee, or a description of the transaction.+ The format of each following transaction is:++ ACCOUNT AMOUNT [; NOTE]++ The ‘ACCOUNT’ may be surrounded by parentheses if it is a virtual+ transactions, or square brackets if it is a virtual transactions that must+ balance. The ‘AMOUNT’ can be followed by a per-unit transaction cost,+ by specifying ‘ AMOUNT’, or a complete transaction cost with ‘\@ AMOUNT’.+ Lastly, the ‘NOTE’ may specify an actual and/or effective date for the+ transaction by using the syntax ‘[ACTUAL_DATE]’ or ‘[=EFFECTIVE_DATE]’ or+ ‘[ACTUAL_DATE=EFFECtIVE_DATE]’.++= An automated entry. A value expression must appear after the equal sign.+ After this initial line there should be a set of one or more transactions, just as+ if it were normal entry. If the amounts of the transactions have no commodity,+ they will be applied as modifiers to whichever real transaction is matched by+ the value expression.+ +~ A period entry. A period expression must appear after the tilde.+ After this initial line there should be a set of one or more transactions, just as+ if it were normal entry.++! A line beginning with an exclamation mark denotes a command directive. It+ must be immediately followed by the command word. The supported commands+ are:++ ‘!include’+ Include the stated ledger file.+ ‘!account’+ The account name is given is taken to be the parent of all transac-+ tions that follow, until ‘!end’ is seen.+ ‘!end’ Ends an account block.+ +; A line beginning with a colon indicates a comment, and is ignored.+ +Y If a line begins with a capital Y, it denotes the year used for all subsequent+ entries that give a date without a year. The year should appear immediately+ after the Y, for example: ‘Y2004’. This is useful at the beginning of a file, to+ specify the year for that file. If all entries specify a year, however, this command+ has no effect.+ + +P Specifies a historical price for a commodity. These are usually found in a pricing+ history file (see the ‘-Q’ option). The syntax is:++ P DATE SYMBOL PRICE++N SYMBOL Indicates that pricing information is to be ignored for a given symbol, nor will+ quotes ever be downloaded for that symbol. Useful with a home currency, such+ as the dollar ($). It is recommended that these pricing options be set in the price+ database file, which defaults to ‘~/.pricedb’. The syntax for this command is:++ N SYMBOL++ +D AMOUNT Specifies the default commodity to use, by specifying an amount in the expected+ format. The entry command will use this commodity as the default when none+ other can be determined. This command may be used multiple times, to set+ the default flags for different commodities; whichever is seen last is used as the+ default commodity. For example, to set US dollars as the default commodity,+ while also setting the thousands flag and decimal flag for that commodity, use:++ D $1,000.00++C AMOUNT1 = AMOUNT2+ Specifies a commodity conversion, where the first amount is given to be equiv-+ alent to the second amount. The first amount should use the decimal precision+ desired during reporting:++ C 1.00 Kb = 1024 bytes++i, o, b, h+ These four relate to timeclock support, which permits ledger to read timelog+ files. See the timeclock’s documentation for more info on the syntax of its+ timelog files.+@++See "Tests" for sample data.+-}+ledger :: Parser RawLedger+ledger = do+ -- we expect these to come first, unlike ledger+ modifier_entries <- many ledgermodifierentry+ periodic_entries <- many ledgerperiodicentry++ entries <- (many ledgerentry) <?> "entry"+ final_comment_lines <- ledgernondatalines+ eof+ return $ RawLedger modifier_entries periodic_entries entries (unlines final_comment_lines)++ledgernondatalines :: Parser [String]+ledgernondatalines = many (ledgerdirective <|> -- treat as comments+ commentline <|> + blankline)++ledgerdirective :: Parser String+ledgerdirective = char '!' >> restofline <?> "directive"++blankline :: Parser String+blankline =+ do {s <- many1 spacenonewline; newline; return s} <|> + do {newline; return ""} <?> "blank line"++commentline :: Parser String+commentline = do+ char ';' <?> "comment line"+ l <- restofline+ return $ ";" ++ l++ledgercomment :: Parser String+ledgercomment = + try (do+ char ';'+ many spacenonewline+ many (noneOf "\n")+ ) + <|> return "" <?> "comment"++ledgermodifierentry :: Parser ModifierEntry+ledgermodifierentry = do+ char '=' <?> "entry"+ many spacenonewline+ valueexpr <- restofline+ transactions <- ledgertransactions+ return (ModifierEntry valueexpr transactions)++ledgerperiodicentry :: Parser PeriodicEntry+ledgerperiodicentry = do+ char '~' <?> "entry"+ many spacenonewline+ periodexpr <- restofline+ transactions <- ledgertransactions+ return (PeriodicEntry periodexpr transactions)++ledgerentry :: Parser Entry+ledgerentry = do+ preceding <- ledgernondatalines+ date <- ledgerdate <?> "entry"+ status <- ledgerstatus+ code <- ledgercode+-- ledger treats entry comments as part of the description, we will too+-- desc <- many (noneOf ";\n") <?> "description"+-- let description = reverse $ dropWhile (==' ') $ reverse desc+ description <- many (noneOf "\n") <?> "description"+ comment <- ledgercomment+ restofline+ transactions <- ledgertransactions+ return $ assertBalancedEntry $ autofillEntry $ Entry date status code description comment transactions (unlines preceding)++ledgerdate :: Parser String+ledgerdate = do + y <- many1 digit+ char '/'+ m <- many1 digit+ char '/'+ d <- many1 digit+ many1 spacenonewline+ return $ printf "%04s/%02s/%02s" y m d++ledgerstatus :: Parser Bool+ledgerstatus = try (do { char '*'; many1 spacenonewline; return True } ) <|> return False++ledgercode :: Parser String+ledgercode = try (do { char '('; code <- anyChar `manyTill` char ')'; many1 spacenonewline; return code } ) <|> return ""++ledgertransactions :: Parser [RawTransaction]+ledgertransactions = (ledgertransaction <?> "transaction") `manyTill` (do {newline <?> "blank line"; return ()} <|> eof)++ledgertransaction :: Parser RawTransaction+ledgertransaction = do+ many1 spacenonewline+ account <- ledgeraccountname+ amount <- transactionamount+ many spacenonewline+ comment <- ledgercomment+ restofline+ return (RawTransaction account amount comment)++-- | account names may have single spaces inside them, and are terminated by two or more spaces+ledgeraccountname :: Parser String+ledgeraccountname = do+ accountname <- many1 (accountnamechar <|> singlespace)+ return $ striptrailingspace accountname+ where + accountnamechar = alphaNum <|> oneOf ":/_" <?> "account name character"+ singlespace = try (do {spacenonewline; do {notFollowedBy spacenonewline; return ' '}})+ -- couldn't avoid consuming a final space sometimes, harmless+ striptrailingspace s = if last s == ' ' then init s else s++transactionamount :: Parser Amount+transactionamount =+ try (do+ many1 spacenonewline+ a <- try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount <|> return autoamt+ return a+ ) <|> return autoamt++leftsymbolamount :: Parser Amount+leftsymbolamount = do+ sym <- commoditysymbol + sp <- many spacenonewline+ (q,p,comma) <- amountquantity+ let c = Commodity {symbol=sym,side=L,spaced=not $ null sp,comma=comma,precision=p,rate=1}+ return $ Amount c q+ <?> "left-symbol amount"++rightsymbolamount :: Parser Amount+rightsymbolamount = do+ (q,p,comma) <- amountquantity+ sp <- many spacenonewline+ sym <- commoditysymbol+ let c = Commodity {symbol=sym,side=R,spaced=not $ null sp,comma=comma,precision=p,rate=1}+ return $ Amount c q+ <?> "right-symbol amount"++nosymbolamount :: Parser Amount+nosymbolamount = do+ (q,p,comma) <- amountquantity+ let c = Commodity {symbol="",side=L,spaced=False,comma=comma,precision=p,rate=1}+ return $ Amount c q+ <?> "no-symbol amount"++commoditysymbol :: Parser String+commoditysymbol = many1 (noneOf "-.0123456789;\n ") <?> "commodity symbol"++-- gawd.. trying to parse a ledger number without error:++-- | parse a ledger-style numeric quantity and also return the number of+-- digits to the right of the decimal point and whether thousands are+-- separated by comma.+amountquantity :: Parser (Double, Int, Bool)+amountquantity = do+ sign <- optionMaybe $ string "-"+ (intwithcommas,frac) <- numberparts+ let comma = ',' `elem` intwithcommas+ let precision = length frac+ -- read the actual value. We expect this read to never fail.+ let int = filter (/= ',') intwithcommas+ let int' = if null int then "0" else int+ let frac' = if null frac then "0" else frac+ let sign' = fromMaybe "" sign+ let quantity = read $ sign'++int'++"."++frac'+ return (quantity, precision, comma)+ <?> "commodity quantity"++-- | parse the two strings of digits before and after a possible decimal+-- point. The integer part may contain commas, or either part may be+-- empty, or there may be no point.+numberparts :: Parser (String,String)+numberparts = numberpartsstartingwithdigit <|> numberpartsstartingwithpoint++numberpartsstartingwithdigit :: Parser (String,String)+numberpartsstartingwithdigit = do+ let digitorcomma = digit <|> char ','+ first <- digit+ rest <- many digitorcomma+ frac <- try (do {char '.'; many digit >>= return}) <|> return ""+ return (first:rest,frac)+ +numberpartsstartingwithpoint :: Parser (String,String)+numberpartsstartingwithpoint = do+ char '.'+ frac <- many1 digit+ return ("",frac)+ ++spacenonewline :: Parser Char+spacenonewline = satisfy (\c -> c `elem` " \v\f\t")++restofline :: Parser String+restofline = anyChar `manyTill` newline++whiteSpace1 :: Parser ()+whiteSpace1 = do space; whiteSpace+++{-| Parse a timelog file. Here is the timelog grammar, from timeclock.el 2.6:++@+A timelog contains data in the form of a single entry per line.+Each entry has the form:++ CODE YYYY/MM/DD HH:MM:SS [COMMENT]++CODE is one of: b, h, i, o or O. COMMENT is optional when the code is+i, o or O. The meanings of the codes are:++ b Set the current time balance, or \"time debt\". Useful when+ archiving old log data, when a debt must be carried forward.+ The COMMENT here is the number of seconds of debt.++ h Set the required working time for the given day. This must+ be the first entry for that day. The COMMENT in this case is+ the number of hours in this workday. Floating point amounts+ are allowed.++ i Clock in. The COMMENT in this case should be the name of the+ project worked on.++ o Clock out. COMMENT is unnecessary, but can be used to provide+ a description of how the period went, for example.++ O Final clock out. Whatever project was being worked on, it is+ now finished. Useful for creating summary reports.+@++Example:++i 2007/03/10 12:26:00 hledger+o 2007/03/10 17:26:02++-}+timelog :: Parser TimeLog+timelog = do+ entries <- many timelogentry <?> "timelog entry"+ eof+ return $ TimeLog entries++timelogentry :: Parser TimeLogEntry+timelogentry = do+ many (commentline <|> blankline)+ code <- oneOf "bhioO"+ many1 spacenonewline+ date <- ledgerdate+ time <- many $ oneOf "0123456789:"+ let datetime = date ++ " " ++ time+ many spacenonewline+ comment <- restofline+ return $ TimeLogEntry code datetime comment++ledgerfromtimelog :: Parser RawLedger+ledgerfromtimelog = do + tl <- timelog+ return $ ledgerFromTimeLog tl+
+ Ledger/RawLedger.hs view
@@ -0,0 +1,115 @@+{-|++A 'RawLedger' is a parsed ledger file. We call it raw to distinguish from+the cached 'Ledger'.++-}++module Ledger.RawLedger+where+import qualified Data.Map as Map+import Ledger.Utils+import Ledger.Types+import Ledger.AccountName+import Ledger.Entry+import Ledger.Transaction+++negativepatternchar = '-'++instance Show RawLedger where+ show l = printf "RawLedger with %d entries, %d accounts: %s"+ ((length $ entries l) ++ (length $ modifier_entries l) ++ (length $ periodic_entries l))+ (length accounts)+ (show accounts)+ -- ++ (show $ rawLedgerTransactions l)+ where accounts = flatten $ rawLedgerAccountNameTree l++rawLedgerTransactions :: RawLedger -> [Transaction]+rawLedgerTransactions = txns . entries+ where+ txns :: [Entry] -> [Transaction]+ txns es = concat $ map flattenEntry $ zip es (iterate (+1) 1)++rawLedgerAccountNamesUsed :: RawLedger -> [AccountName]+rawLedgerAccountNamesUsed = accountNamesFromTransactions . rawLedgerTransactions++rawLedgerAccountNames :: RawLedger -> [AccountName]+rawLedgerAccountNames = sort . expandAccountNames . rawLedgerAccountNamesUsed++rawLedgerAccountNameTree :: RawLedger -> Tree AccountName+rawLedgerAccountNameTree l = accountNameTreeFrom $ rawLedgerAccountNames l++-- | Remove ledger entries we are not interested in.+-- Keep only those which fall between the begin and end dates, and match+-- the description pattern.+filterRawLedger :: String -> String -> [String] -> RawLedger -> RawLedger+filterRawLedger begin end pats = + filterRawLedgerEntriesByDate begin end .+ filterRawLedgerEntriesByDescription pats++-- | Keep only entries whose description matches the description pattern.+filterRawLedgerEntriesByDescription :: [String] -> RawLedger -> RawLedger+filterRawLedgerEntriesByDescription pats (RawLedger ms ps es f) = + RawLedger ms ps (filter matchdesc es) f+ where+ matchdesc :: Entry -> Bool+ matchdesc = matchLedgerPatterns False pats . edescription++-- | Keep only entries which fall between begin and end dates. +-- We include entries on the begin date and exclude entries on the end+-- date, like ledger. An empty date string means no restriction.+filterRawLedgerEntriesByDate :: String -> String -> RawLedger -> RawLedger+filterRawLedgerEntriesByDate begin end (RawLedger ms ps es f) = + RawLedger ms ps (filter matchdate es) f+ where+ matchdate :: Entry -> Bool+ matchdate e = (begin == "" || entrydate >= begindate) && + (end == "" || entrydate < enddate)+ where + begindate = parsedate begin :: UTCTime+ enddate = parsedate end+ entrydate = parsedate $ edate e+++-- | Check if a set of ledger account/description patterns matches the+-- given account name or entry description, applying ledger's special+-- cases. +-- +-- Patterns are case-insensitive regular expression strings, and those+-- beginning with - are negative patterns. The special case is that+-- account patterns match the full account name except in balance reports+-- when the pattern does not contain : and is a positive pattern, where it+-- matches only the leaf name.+matchLedgerPatterns :: Bool -> [String] -> String -> Bool+matchLedgerPatterns forbalancereport pats str =+ (null positives || any ismatch positives) && (null negatives || (not $ any ismatch negatives))+ where + isnegative = (== negativepatternchar) . head+ (negatives,positives) = partition isnegative pats+ ismatch pat = containsRegex (mkRegexWithOpts pat' True True) matchee+ where + pat' = if isnegative pat then drop 1 pat else pat+ matchee = if forbalancereport && (not $ ':' `elem` pat) && (not $ isnegative pat)+ then accountLeafName str+ else str++-- | Give amounts the display settings of the first one detected in each commodity.+normaliseRawLedgerAmounts :: RawLedger -> RawLedger+normaliseRawLedgerAmounts l@(RawLedger ms ps es f) = RawLedger ms ps es' f+ where + es' = map normaliseEntryAmounts es+ normaliseEntryAmounts (Entry d s c desc comm ts pre) = Entry d s c desc comm ts' pre+ where ts' = map normaliseRawTransactionAmounts ts+ normaliseRawTransactionAmounts (RawTransaction acct a c) = RawTransaction acct a' c+ where a' = normaliseAmount a+ normaliseAmount (Amount c q) = Amount (firstoccurrenceof c) q+ firstcommodities = nubBy samesymbol $ allcommodities+ allcommodities = map (commodity . amount) $ rawLedgerTransactions l+ samesymbol (Commodity {symbol=s1}) (Commodity {symbol=s2}) = s1==s2+ firstoccurrenceof c@(Commodity {symbol=s}) = + fromMaybe+ (error "failed to normalise commodity") -- shouldn't happen+ (find (\(Commodity {symbol=sym}) -> sym==s) firstcommodities)
+ Ledger/RawTransaction.hs view
@@ -0,0 +1,36 @@+{-|++A 'RawTransaction' represents a single transaction line within a ledger+entry. We call it raw to distinguish from the cached 'Transaction'.++-}++module Ledger.RawTransaction+where+import Ledger.Utils+import Ledger.Types+import Ledger.Amount+import Ledger.AccountName+++instance Show RawTransaction where show = showLedgerTransaction++showLedgerTransaction :: RawTransaction -> String+showLedgerTransaction t = (showaccountname $ taccount t) ++ " " ++ (showamount $ tamount t) + where+ showaccountname = printf "%-22s" . elideAccountName 22+ showamount = printf "%12s" . showAmountOrZero++autofillTransactions :: [RawTransaction] -> [RawTransaction]+autofillTransactions ts =+ case (length blanks) of+ 0 -> ts+ 1 -> map balance ts+ otherwise -> error "too many blank transactions in this entry"+ where + (normals, blanks) = partition isnormal ts+ isnormal t = (symbol $ commodity $ tamount t) /= "AUTO"+ balance t = if isnormal t then t else t{tamount = -(sumLedgerTransactions normals)}++sumLedgerTransactions :: [RawTransaction] -> Amount+sumLedgerTransactions = sumAmounts . map tamount
+ Ledger/TimeLog.hs view
@@ -0,0 +1,63 @@+{-|++A 'TimeLog' is a parsed timelog file (see timeclock.el or the command-line+version) containing zero or more 'TimeLogEntry's. It can be converted to a+'RawLedger' for querying.++-}++module Ledger.TimeLog+where+import Ledger.Utils+import Ledger.Types+import Ledger.Commodity+import Ledger.Amount+++instance Show TimeLogEntry where + show t = printf "%s %s %s" (show $ tlcode t) (tldatetime t) (tlcomment t)++instance Show TimeLog where+ show tl = printf "TimeLog with %d entries" $ length $ timelog_entries tl++-- | Convert a time log to a ledger.+ledgerFromTimeLog :: TimeLog -> RawLedger+ledgerFromTimeLog tl = RawLedger [] [] (entriesFromTimeLogEntries $ timelog_entries tl) ""++-- | Convert time log entries to ledger entries.+entriesFromTimeLogEntries :: [TimeLogEntry] -> [Entry]+entriesFromTimeLogEntries [] = []+entriesFromTimeLogEntries [i] = entriesFromTimeLogEntries [i, clockoutFor i]+entriesFromTimeLogEntries (i:o:rest) = [entryFromTimeLogInOut i o] ++ entriesFromTimeLogEntries rest++-- | When there is a trailing clockin entry, provide the missing clockout.+-- An entry for now is what we want but this requires IO so for now use+-- the clockin time, ie don't count the current clocked-in period.+clockoutFor :: TimeLogEntry -> TimeLogEntry+clockoutFor (TimeLogEntry _ t _) = TimeLogEntry 'o' t ""++-- | Convert a timelog clockin and clockout entry to an equivalent ledger+-- entry, representing the time expenditure. Note this entry is not balanced,+-- since we omit the \"assets:time\" transaction for simpler output.+entryFromTimeLogInOut :: TimeLogEntry -> TimeLogEntry -> Entry+entryFromTimeLogInOut i o =+ Entry {+ edate = indate, -- ledger uses outdate+ estatus = True,+ ecode = "",+ edescription = "",+ ecomment = "",+ etransactions = txns,+ epreceding_comment_lines=""+ }+ where+ acctname = tlcomment i+ indate = showdate intime+ outdate = showdate outtime+ showdate = formatTime defaultTimeLocale "%Y/%m/%d"+ intime = parsedatetime $ tldatetime i+ outtime = parsedatetime $ tldatetime o+ amount = hours $ realToFrac (diffUTCTime outtime intime) / 3600+ txns = [RawTransaction acctname amount ""+ --,RawTransaction "assets:time" (-amount) ""+ ]
+ Ledger/Transaction.hs view
@@ -0,0 +1,33 @@+{-|++A 'Transaction' is a 'RawTransaction' with its parent 'Entry' \'s date and+description attached. These are what we actually query when doing reports.++-}++module Ledger.Transaction+where+import Ledger.Utils+import Ledger.Types+import Ledger.Entry+import Ledger.RawTransaction+import Ledger.Amount+++instance Show Transaction where + show (Transaction eno d desc a amt) = unwords [d,desc,a,show amt]++-- | Convert a 'Entry' to two or more 'Transaction's. An id number+-- is attached to the transactions to preserve their grouping - it should+-- be unique per entry.+flattenEntry :: (Entry, Int) -> [Transaction]+flattenEntry (Entry d _ _ desc _ ts _, e) = + [Transaction e d desc (taccount t) (tamount t) | t <- ts]++accountNamesFromTransactions :: [Transaction] -> [AccountName]+accountNamesFromTransactions ts = nub $ map account ts++sumTransactions :: [Transaction] -> Amount+sumTransactions = sum . map amount++nulltxn = Transaction 0 "" "" "" nullamt
+ Ledger/Types.hs view
@@ -0,0 +1,103 @@+{-|++All the main data types, defined here to avoid import cycles.+See the corresponding modules for documentation.++-}++module Ledger.Types +where+import Ledger.Utils+import qualified Data.Map as Map+++type Date = String++type DateTime = String++data Side = L | R deriving (Eq,Show) ++data Commodity = Commodity {+ symbol :: String, -- ^ the commodity's symbol++ -- display preferences for amounts of this commodity+ side :: Side, -- ^ should the symbol appear on the left or the right+ spaced :: Bool, -- ^ should there be a space between symbol and quantity+ comma :: Bool, -- ^ should thousands be comma-separated+ precision :: Int, -- ^ number of decimal places to display++ rate :: Double -- ^ the current (hard-coded) conversion rate against the dollar+ } deriving (Eq,Show)++data Amount = Amount {+ commodity :: Commodity,+ quantity :: Double+ } deriving (Eq)++type AccountName = String++data RawTransaction = RawTransaction {+ taccount :: AccountName,+ tamount :: Amount,+ tcomment :: String+ } deriving (Eq)++-- | a ledger "modifier" entry. Currently ignored.+data ModifierEntry = ModifierEntry {+ valueexpr :: String,+ m_transactions :: [RawTransaction]+ } deriving (Eq)++-- | a ledger "periodic" entry. Currently ignored.+data PeriodicEntry = PeriodicEntry {+ periodexpr :: String,+ p_transactions :: [RawTransaction]+ } deriving (Eq)++data Entry = Entry {+ edate :: Date,+ estatus :: Bool,+ ecode :: String,+ edescription :: String,+ ecomment :: String,+ etransactions :: [RawTransaction],+ epreceding_comment_lines :: String+ } deriving (Eq)++data RawLedger = RawLedger {+ modifier_entries :: [ModifierEntry],+ periodic_entries :: [PeriodicEntry],+ entries :: [Entry],+ final_comment_lines :: String+ } deriving (Eq)++data TimeLogEntry = TimeLogEntry {+ tlcode :: Char,+ tldatetime :: DateTime,+ tlcomment :: String+ } deriving (Eq,Ord)++data TimeLog = TimeLog {+ timelog_entries :: [TimeLogEntry]+ } deriving (Eq)++data Transaction = Transaction {+ entryno :: Int,+ date :: Date,+ description :: String,+ account :: AccountName,+ amount :: Amount+ } deriving (Eq)++data Account = Account {+ aname :: AccountName,+ atransactions :: [Transaction],+ abalance :: Amount+ }++data Ledger = Ledger {+ rawledger :: RawLedger,+ accountnametree :: Tree AccountName,+ accountmap :: Map.Map AccountName Account+ }+
+ Ledger/Utils.hs view
@@ -0,0 +1,158 @@+{-|++Provide a number of standard modules and utilities.++-}++module Ledger.Utils (+module Char,+module Control.Monad,+module Data.List,+--module Data.Map,+module Data.Maybe,+module Data.Ord,+module Data.Time.Clock,+module Data.Time.Format,+module Data.Tree,+module Debug.Trace,+module Ledger.Utils,+module System.Locale,+module Text.Printf,+module Text.Regex,+module Test.HUnit,+)+where+import Char+import Control.Monad+import Data.List+--import qualified Data.Map as Map+import Data.Maybe+import Data.Ord+import Data.Time.Clock (UTCTime, diffUTCTime)+import Data.Time.Format (ParseTime, parseTime, formatTime)+import Data.Tree+import Debug.Trace+import System.Locale (defaultTimeLocale)+import Test.HUnit+import Test.QuickCheck hiding (test, Testable)+import Text.Printf+import Text.Regex+import Text.ParserCombinators.Parsec (parse)+++elideLeft width s =+ case length s > width of+ True -> ".." ++ (reverse $ take (width - 2) $ reverse s)+ False -> s++elideRight width s =+ case length s > width of+ True -> take (width - 2) s ++ ".."+ False -> s++-- regexps++instance Show Regex where show r = "a Regex"++containsRegex :: Regex -> String -> Bool+containsRegex r s = case matchRegex r s of+ Just _ -> True+ otherwise -> False++-- time++-- | Parse a date-time string to a time type, or raise an error.+parsedatetime :: ParseTime t => String -> t+parsedatetime s =+ parsetimewith "%Y/%m/%d %H:%M:%S" s $+ error $ printf "could not parse timestamp \"%s\"" s++-- | Parse a date string to a time type, or raise an error.+parsedate :: ParseTime t => String -> t+parsedate s = + parsetimewith "%Y/%m/%d" s $+ error $ printf "could not parse date \"%s\"" s++-- | Parse a time string to a time type using the provided pattern, or+-- return the default.+parsetimewith :: ParseTime t => String -> String -> t -> t+parsetimewith pat s def = fromMaybe def $ parseTime defaultTimeLocale pat s++-- lists++splitAtElement :: Eq a => a -> [a] -> [[a]]+splitAtElement e l = + case dropWhile (e==) l of+ [] -> []+ l' -> first : splitAtElement e rest+ where+ (first,rest) = break (e==) l'++-- trees++root = rootLabel+subs = subForest+branches = subForest++-- | get the sub-tree rooted at the first (left-most, depth-first) occurrence+-- of the specified node value+subtreeat :: Eq a => a -> Tree a -> Maybe (Tree a)+subtreeat v t+ | root t == v = Just t+ | otherwise = subtreeinforest v $ subs t++-- | get the sub-tree for the specified node value in the first tree in+-- forest in which it occurs.+subtreeinforest :: Eq a => a -> [Tree a] -> Maybe (Tree a)+subtreeinforest v [] = Nothing+subtreeinforest v (t:ts) = case (subtreeat v t) of+ Just t' -> Just t'+ Nothing -> subtreeinforest v ts+ +-- | remove all nodes past a certain depth+treeprune :: Int -> Tree a -> Tree a+treeprune 0 t = Node (root t) []+treeprune d t = Node (root t) (map (treeprune $ d-1) $ branches t)++-- | apply f to all tree nodes+treemap :: (a -> b) -> Tree a -> Tree b+treemap f t = Node (f $ root t) (map (treemap f) $ branches t)++-- | remove all subtrees whose nodes do not fulfill predicate+treefilter :: (a -> Bool) -> Tree a -> Tree a+treefilter f t = Node + (root t) + (map (treefilter f) $ filter (treeany f) $ branches t)+ +-- | is predicate true in any node of tree ?+treeany :: (a -> Bool) -> Tree a -> Bool+treeany f t = (f $ root t) || (any (treeany f) $ branches t)+ +-- treedrop -- remove the leaves which do fulfill predicate. +-- treedropall -- do this repeatedly.++-- | show a compact ascii representation of a tree+showtree :: Show a => Tree a -> String+showtree = unlines . filter (containsRegex (mkRegex "[^ |]")) . lines . drawTree . treemap show++-- | show a compact ascii representation of a forest+showforest :: Show a => Forest a -> String+showforest = concatMap showtree++-- debugging++-- | trace a showable expression+strace a = trace (show a) a++p = putStr++-- testing++assertequal e a = assertEqual "" e a+assertnotequal e a = assertBool "expected inequality, got equality" (e /= a)++-- parsewith :: Parser a+parsewith p ts = parse p "" ts+fromparse = either (\_ -> error "parse error") id++
+ Options.hs view
@@ -0,0 +1,120 @@+module Options +where+import System+import System.Console.GetOpt+import System.Directory+import Ledger.RawLedger (negativepatternchar)++usagehdr = "Usage: hledger [OPTS] balance|print|register [ACCTPATS] [-- DESCPATS]\n\nOptions"++warning++":"+warning = if negativepatternchar=='-' then " (must appear before command)" else " (can appear anywhere)"+usageftr = "\n\+ \Commands (may be abbreviated):\n\+ \balance - show account balances\n\+ \print - show parsed and reformatted ledger entries\n\+ \register - show register transactions\n\+ \\n\+ \Account and description patterns are regular expressions, optionally prefixed\n\+ \with " ++ [negativepatternchar] ++ " to make them negative.\n"+defaultfile = "~/.ledger"+fileenvvar = "LEDGER"+optionorder = if negativepatternchar=='-' then RequireOrder else Permute++-- | Command-line options we accept.+options :: [OptDescr Opt]+options = [+ Option ['f'] ["file"] (ReqArg File "FILE") "ledger file; - means use standard input",+ Option ['b'] ["begin"] (ReqArg Begin "YYYY/MM/DD") "report on entries on or after this date",+ Option ['e'] ["end"] (ReqArg End "YYYY/MM/DD") "report on entries prior to this date",+ Option ['s'] ["showsubs"] (NoArg ShowSubs) "in the balance report, include subaccounts",+ Option ['h'] ["help","usage"] (NoArg Help) "show this help",+ Option ['V'] ["version"] (NoArg Version) "show version"+ ]++-- | An option value from a command-line flag.+data Opt = + File String | + Begin String | + End String | + ShowSubs |+ Help |+ Version+ deriving (Show,Eq)++usage = usageInfo usagehdr options ++ usageftr++version = "hledger version 0.1 alpha\n"++-- | Parse the command-line arguments into ledger options, ledger command+-- name, and ledger command arguments+parseArguments :: IO ([Opt], String, [String])+parseArguments = do+ args <- getArgs+ case (getOpt optionorder options args) of+ (opts,cmd:args,[]) -> return (opts, cmd, args)+ (opts,[],[]) -> return (opts, [], [])+ (_,_,errs) -> ioError (userError (concat errs ++ usage))++-- | Get the ledger file path from options, an environment variable, or a default+ledgerFilePathFromOpts :: [Opt] -> IO String+ledgerFilePathFromOpts opts = do+ envordefault <- getEnv fileenvvar `catch` \_ -> return defaultfile+ paths <- mapM tildeExpand $ [envordefault] ++ (concatMap getfile opts)+ return $ last paths+ where+ getfile (File s) = [s]+ getfile _ = []++-- | Expand ~ in a file path (does not handle ~name).+tildeExpand :: FilePath -> IO FilePath+tildeExpand ('~':[]) = getHomeDirectory+tildeExpand ('~':'/':xs) = getHomeDirectory >>= return . (++ ('/':xs))+--handle ~name, requires -fvia-C or ghc 6.8:+--import System.Posix.User+-- tildeExpand ('~':xs) = do let (user, path) = span (/= '/') xs+-- pw <- getUserEntryForName user+-- return (homeDirectory pw ++ path)+tildeExpand xs = return xs++-- | get the value of the begin date option, or a default+beginDateFromOpts :: [Opt] -> String+beginDateFromOpts opts = + case beginopts of+ (x:_) -> last beginopts+ _ -> defaultdate+ where+ beginopts = concatMap getbegindate opts+ getbegindate (Begin s) = [s]+ getbegindate _ = []+ defaultdate = ""++-- | get the value of the end date option, or a default+endDateFromOpts :: [Opt] -> String+endDateFromOpts opts = + case endopts of+ (x:_) -> last endopts+ _ -> defaultdate+ where+ endopts = concatMap getenddate opts+ getenddate (End s) = [s]+ getenddate _ = []+ defaultdate = ""++-- | Gather any ledger-style account/description pattern arguments into+-- two lists. These are 0 or more account patterns optionally followed by+-- -- and 0 or more description patterns.+parseAccountDescriptionArgs :: [String] -> ([String],[String])+parseAccountDescriptionArgs args = (as, ds')+ where (as, ds) = break (=="--") args+ ds' = dropWhile (=="--") ds++-- testoptions RequireOrder ["foo","-v"]+-- testoptions Permute ["foo","-v"]+-- testoptions (ReturnInOrder Arg) ["foo","-v"]+-- testoptions Permute ["foo","--","-v"]+-- testoptions Permute ["-?o","--name","bar","--na=baz"]+-- testoptions Permute ["--ver","foo"]+testoptions order cmdline = putStr $ + case getOpt order options cmdline of+ (o,n,[] ) -> "options=" ++ show o ++ " args=" ++ show n+ (_,_,errs) -> concat errs ++ usage+
+ PrintCommand.hs view
@@ -0,0 +1,18 @@+{-| ++A ledger-compatible @print@ command.++-}++module PrintCommand+where+import Ledger+import Options+++-- | Print ledger entries in standard format.+print' :: [Opt] -> [String] -> Ledger -> IO ()+print' opts args l = putStr $ showEntries opts args l++showEntries :: [Opt] -> [String] -> Ledger -> String+showEntries opts args l = concatMap showEntry $ entries $ rawledger l
+ README view
@@ -0,0 +1,29 @@+hledger - a ledger-compatible text-based accounting tool.++Copyright (c) 2007-2008 Simon Michael <simon@joyful.com>+Released under GPL version 3 or later.++This is a minimal haskell clone of John Wiegley's ledger+<http://newartisans.com/software/ledger.html>. hledger does basic+register & balance reports, and demonstrates a functional implementation+of ledger.++Installation:++runhaskell Setup.hs configure+runhaskell Setup.hs build+sudo runhaskell Setup.hs install + (or symlink dist/build/hledger/hledger into your path)++Examples:++hledger -f sample.ledger balance+export LEDGER=sample.ledger+hledger -s balance+hledger register+hledger reg cash+hledger reg -- shop++This version of hledger mimics ledger 2.5 closely, +see the ledger manual for more info:+<http://joyful.com/repos/hledger/doc/ledger.html>.
+ RegisterCommand.hs view
@@ -0,0 +1,47 @@+{-| ++A ledger-compatible @register@ command.++-}++module RegisterCommand+where+import Ledger+import Options+++-- | Print a register report.+register :: [Opt] -> [String] -> Ledger -> IO ()+register opts args l = putStr $ showTransactionsWithBalances opts args l++showTransactionsWithBalances :: [Opt] -> [String] -> Ledger -> String+showTransactionsWithBalances opts args l =+ unlines $ showTransactionsWithBalances' ts nulltxn startingbalance+ where+ ts = filter matchtxn $ ledgerTransactions l+ matchtxn (Transaction _ _ desc acct _) = matchLedgerPatterns False apats acct+ apats = fst $ parseAccountDescriptionArgs args+ startingbalance = nullamt+ showTransactionsWithBalances' :: [Transaction] -> Transaction -> Amount -> [String]+ showTransactionsWithBalances' [] _ _ = []+ showTransactionsWithBalances' (t:ts) tprev b =+ (if sameentry t tprev+ then [showTransactionAndBalance t b']+ else [showTransactionDescriptionAndBalance t b'])+ ++ (showTransactionsWithBalances' ts t b')+ where + b' = b + (amount t)+ sameentry (Transaction e1 _ _ _ _) (Transaction e2 _ _ _ _) = e1 == e2++showTransactionDescriptionAndBalance :: Transaction -> Amount -> String+showTransactionDescriptionAndBalance t b =+ (showEntryDescription $ Entry (date t) False "" (description t) "" [] "") + ++ (showLedgerTransaction $ RawTransaction (account t) (amount t) "") ++ (showBalance b)++showTransactionAndBalance :: Transaction -> Amount -> String+showTransactionAndBalance t b =+ (replicate 32 ' ') ++ (showLedgerTransaction $ RawTransaction (account t) (amount t) "") ++ (showBalance b)++showBalance :: Amount -> String+showBalance b = printf " %12s" (showAmountOrZero b)+
+ Setup.hs view
@@ -0,0 +1,4 @@+#!/usr/bin/env runhaskell+import Distribution.Simple++main = defaultMain
+ Tests.hs view
@@ -0,0 +1,489 @@+module Tests+where+import qualified Data.Map as Map+import Text.ParserCombinators.Parsec+import Test.HUnit+import Ledger+import Utils+import Options+import BalanceCommand+import PrintCommand+import RegisterCommand+++runtests = do {putStrLn "Running tests.."; runTestTT $ tconcat [unittests, functests]}++tconcat :: [Test] -> Test+tconcat = foldr (\(TestList as) (TestList bs) -> TestList (as ++ bs)) (TestList []) ++------------------------------------------------------------------------------++unittests = TestList [+ -- remember to indent assertequal arguments, contrary to haskell-mode auto-indent+ "show dollars" ~: show (dollars 1) ~?= "$1.00"+ ,+ "show hours" ~: show (hours 1) ~?= "1.0h"+ ,+ "amount arithmetic" ~: do+ let a1 = dollars 1.23+ let a2 = Amount (comm "$") (-1.23)+ let a3 = Amount (comm "$") (-1.23)+ assertequal (Amount (comm "$") 0) (a1 + a2)+ assertequal (Amount (comm "$") 0) (a1 + a3)+ assertequal (Amount (comm "$") (-2.46)) (a2 + a3)+ assertequal (Amount (comm "$") (-2.46)) (a3 + a3)+ assertequal (Amount (comm "$") (-2.46)) (sum [a2,a3])+ assertequal (Amount (comm "$") (-2.46)) (sum [a3,a3])+ assertequal (Amount (comm "$") 0) (sum [a1,a2,a3,-a3])+ ,+ "ledgertransaction" ~: do+ assertparseequal rawtransaction1 (parsewith ledgertransaction rawtransaction1_str)+ , + "ledgerentry" ~: do+ assertparseequal entry1 (parsewith ledgerentry entry1_str)+ ,+ "autofillEntry" ~: do+ assertequal+ (dollars (-47.18))+ (tamount $ last $ etransactions $ autofillEntry entry1)+ ,+ "punctuatethousands" ~: punctuatethousands "" @?= ""+ ,+ "punctuatethousands" ~: punctuatethousands "1234567.8901" @?= "1,234,567.8901"+ ,+ "punctuatethousands" ~: punctuatethousands "-100" @?= "-100"+ ,+ "expandAccountNames" ~: do+ assertequal+ ["assets","assets:cash","assets:checking","expenses","expenses:vacation"]+ (expandAccountNames ["assets:cash","assets:checking","expenses:vacation"])+ ,+ "ledgerAccountNames" ~: do+ assertequal+ ["assets","assets:cash","assets:checking","assets:saving","equity","equity:opening balances",+ "expenses","expenses:food","expenses:food:dining","expenses:phone","expenses:vacation",+ "liabilities","liabilities:credit cards","liabilities:credit cards:discover"]+ (accountnames ledger7)+ ,+ "cacheLedger" ~: do+ assertequal 15 (length $ Map.keys $ accountmap $ cacheLedger rawledger7)+ ,+ "transactionamount" ~: do+ assertparseequal (dollars 47.18) (parsewith transactionamount " $47.18")+ assertparseequal (Amount (Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0,rate=1}) 1) (parsewith transactionamount " $1.")+ ]++------------------------------------------------------------------------------++functests = TestList [+ balancecommandtests+ ,registercommandtests+ ]++balancecommandtests = TestList [+ "simple balance report" ~: do+ l <- ledgerfromfile "sample.ledger"+ assertequal+ " $-1 assets\n\+ \ $2 expenses\n\+ \ $-2 income\n\+ \ $1 liabilities\n\+ \" --"+ (showBalanceReport [] [] l)+ ,+ "balance report with showsubs" ~: do+ l <- ledgerfromfile "sample.ledger"+ assertequal+ " $-1 assets\n\+ \ $-2 cash\n\+ \ $1 saving\n\+ \ $2 expenses\n\+ \ $1 food\n\+ \ $1 supplies\n\+ \ $-2 income\n\+ \ $-1 gifts\n\+ \ $-1 salary\n\+ \ $1 liabilities:debts\n\+ \" --"+ (showBalanceReport [ShowSubs] [] l)+ ,+ "balance report with account pattern o" ~: do+ l <- ledgerfromfile "sample.ledger"+ assertequal+ " $1 expenses:food\n\+ \ $-2 income\n\+ \--------------------\n\+ \ $-1\n\+ \" --"+ (showBalanceReport [] ["o"] l)+ ,+ "balance report with account pattern o and showsubs" ~: do+ l <- ledgerfromfile "sample.ledger"+ assertequal+ " $1 expenses:food\n\+ \ $-2 income\n\+ \ $-1 gifts\n\+ \ $-1 salary\n\+ \--------------------\n\+ \ $-1\n\+ \" --"+ (showBalanceReport [ShowSubs] ["o"] l)+ ,+ "balance report with account pattern a" ~: do+ l <- ledgerfromfile "sample.ledger"+ assertequal+ " $-1 assets\n\+ \ $-2 cash\n\+ \ $1 saving\n\+ \ $-1 income:salary\n\+ \ $1 liabilities\n\+ \--------------------\n\+ \ $-1\n\+ \" --"+ (showBalanceReport [] ["a"] l)+ ,+ "balance report with account pattern e" ~: do+ l <- ledgerfromfile "sample.ledger"+ assertequal+ " $-1 assets\n\+ \ $2 expenses\n\+ \ $1 supplies\n\+ \ $-2 income\n\+ \ $1 liabilities:debts\n\+ \" --"+ (showBalanceReport [] ["e"] l)+ ,+ "balance report with unmatched parent of two matched subaccounts" ~: + do+ l <- ledgerfromfile "sample.ledger"+ assertequal+ " $-2 assets:cash\n\+ \ $1 assets:saving\n\+ \--------------------\n\+ \ $-1\n\+ \" --"+ (showBalanceReport [] ["cash","saving"] l)+ ,+ "balance report with multi-part account name" ~: + do + l <- ledgerfromfile "sample.ledger"+ assertequal+ " $1 expenses:food\n\+ \--------------------\n\+ \ $1\n\+ \" --"+ $ showBalanceReport [] ["expenses:food"] l+ ,+ "balance report negative account pattern always matches full name" ~: + do + l <- ledgerfromfile "sample.ledger"+ assertequal "" $ showBalanceReport [] ["-e"] l+ ]++registercommandtests = TestList [+ "register does something" ~:+ do + l <- ledgerfromfile "sample.ledger"+ assertnotequal "" $ showTransactionsWithBalances [] [] l+ ]+ +-- | Assert a parsed thing equals some expected thing, or print a parse error.+assertparseequal :: (Show a, Eq a) => a -> (Either ParseError a) -> Assertion+assertparseequal expected parsed = either printParseError (assertequal expected) parsed++------------------------------------------------------------------------------+-- data++rawtransaction1_str = " expenses:food:dining $10.00\n"++rawtransaction1 = RawTransaction "expenses:food:dining" (dollars 10) ""++entry1_str = "\+\2007/01/28 coopportunity\n\+\ expenses:food:groceries $47.18\n\+\ assets:checking\n\+\\n" --"++entry1 =+ (Entry "2007/01/28" False "" "coopportunity" ""+ [RawTransaction "expenses:food:groceries" (dollars 47.18) "", + RawTransaction "assets:checking" (dollars (-47.18)) ""] "")+++entry2_str = "\+\2007/01/27 * joes diner\n\+\ expenses:food:dining $10.00\n\+\ expenses:gifts $10.00\n\+\ assets:checking $-20.00\n\+\\n" --"++entry3_str = "\+\2007/01/01 * opening balance\n\+\ assets:cash $4.82\n\+\ equity:opening balances\n\+\\n\+\2007/01/01 * opening balance\n\+\ assets:cash $4.82\n\+\ equity:opening balances\n\+\\n\+\2007/01/28 coopportunity\n\+\ expenses:food:groceries $47.18\n\+\ assets:checking\n\+\\n" --"++periodic_entry1_str = "\+\~ monthly from 2007/2/2\n\+\ assets:saving $200.00\n\+\ assets:checking\n\+\\n" --"++periodic_entry2_str = "\+\~ monthly from 2007/2/2\n\+\ assets:saving $200.00 ;auto savings\n\+\ assets:checking\n\+\\n" --"++periodic_entry3_str = "\+\~ monthly from 2007/01/01\n\+\ assets:cash $4.82\n\+\ equity:opening balances\n\+\\n\+\~ monthly from 2007/01/01\n\+\ assets:cash $4.82\n\+\ equity:opening balances\n\+\\n" --"++ledger1_str = "\+\\n\+\2007/01/27 * joes diner\n\+\ expenses:food:dining $10.00\n\+\ expenses:gifts $10.00\n\+\ assets:checking $-20.00\n\+\\n\+\\n\+\2007/01/28 coopportunity\n\+\ expenses:food:groceries $47.18\n\+\ assets:checking $-47.18\n\+\\n\+\" --"++ledger2_str = "\+\;comment\n\+\2007/01/27 * joes diner\n\+\ expenses:food:dining $10.00\n\+\ assets:checking $-47.18\n\+\\n" --"++ledger3_str = "\+\2007/01/27 * joes diner\n\+\ expenses:food:dining $10.00\n\+\;intra-entry comment\n\+\ assets:checking $-47.18\n\+\\n" --"++ledger4_str = "\+\!include \"somefile\"\n\+\2007/01/27 * joes diner\n\+\ expenses:food:dining $10.00\n\+\ assets:checking $-47.18\n\+\\n" --"++ledger5_str = ""++ledger6_str = "\+\~ monthly from 2007/1/21\n\+\ expenses:entertainment $16.23 ;netflix\n\+\ assets:checking\n\+\\n\+\; 2007/01/01 * opening balance\n\+\; assets:saving $200.04\n\+\; equity:opening balances \n\+\\n" --"++ledger7_str = "\+\2007/01/01 * opening balance\n\+\ assets:cash $4.82\n\+\ equity:opening balances \n\+\\n\+\2007/01/01 * opening balance\n\+\ income:interest $-4.82\n\+\ equity:opening balances \n\+\\n\+\2007/01/02 * ayres suites\n\+\ expenses:vacation $179.92\n\+\ assets:checking \n\+\\n\+\2007/01/02 * auto transfer to savings\n\+\ assets:saving $200.00\n\+\ assets:checking \n\+\\n\+\2007/01/03 * poquito mas\n\+\ expenses:food:dining $4.82\n\+\ assets:cash \n\+\\n\+\2007/01/03 * verizon\n\+\ expenses:phone $95.11\n\+\ assets:checking \n\+\\n\+\2007/01/03 * discover\n\+\ liabilities:credit cards:discover $80.00\n\+\ assets:checking \n\+\\n\+\2007/01/04 * blue cross\n\+\ expenses:health:insurance $90.00\n\+\ assets:checking \n\+\\n\+\2007/01/05 * village market liquor\n\+\ expenses:food:dining $6.48\n\+\ assets:checking \n\+\\n" --"++rawledger7 = RawLedger+ [] + [] + [+ Entry {+ edate="2007/01/01", + estatus=False, + ecode="*", + edescription="opening balance", + ecomment="",+ etransactions=[+ RawTransaction {+ taccount="assets:cash", + tamount=dollars 4.82,+ tcomment=""+ },+ RawTransaction {+ taccount="equity:opening balances", + tamount=dollars (-4.82),+ tcomment=""+ }+ ],+ epreceding_comment_lines=""+ }+ ,+ Entry {+ edate="2007/02/01", + estatus=False, + ecode="*", + edescription="ayres suites", + ecomment="",+ etransactions=[+ RawTransaction {+ taccount="expenses:vacation", + tamount=dollars 179.92,+ tcomment=""+ },+ RawTransaction {+ taccount="assets:checking", + tamount=dollars (-179.92),+ tcomment=""+ }+ ],+ epreceding_comment_lines=""+ }+ ,+ Entry {+ edate="2007/01/02", + estatus=False, + ecode="*", + edescription="auto transfer to savings", + ecomment="",+ etransactions=[+ RawTransaction {+ taccount="assets:saving", + tamount=dollars 200,+ tcomment=""+ },+ RawTransaction {+ taccount="assets:checking", + tamount=dollars (-200),+ tcomment=""+ }+ ],+ epreceding_comment_lines=""+ }+ ,+ Entry {+ edate="2007/01/03", + estatus=False, + ecode="*", + edescription="poquito mas", + ecomment="",+ etransactions=[+ RawTransaction {+ taccount="expenses:food:dining", + tamount=dollars 4.82,+ tcomment=""+ },+ RawTransaction {+ taccount="assets:cash", + tamount=dollars (-4.82),+ tcomment=""+ }+ ],+ epreceding_comment_lines=""+ }+ ,+ Entry {+ edate="2007/01/03", + estatus=False, + ecode="*", + edescription="verizon", + ecomment="",+ etransactions=[+ RawTransaction {+ taccount="expenses:phone", + tamount=dollars 95.11,+ tcomment=""+ },+ RawTransaction {+ taccount="assets:checking", + tamount=dollars (-95.11),+ tcomment=""+ }+ ],+ epreceding_comment_lines=""+ }+ ,+ Entry {+ edate="2007/01/03", + estatus=False, + ecode="*", + edescription="discover", + ecomment="",+ etransactions=[+ RawTransaction {+ taccount="liabilities:credit cards:discover", + tamount=dollars 80,+ tcomment=""+ },+ RawTransaction {+ taccount="assets:checking", + tamount=dollars (-80),+ tcomment=""+ }+ ],+ epreceding_comment_lines=""+ }+ ]+ ""++ledger7 = cacheLedger rawledger7 ++timelogentry1_str = "i 2007/03/11 16:19:00 hledger\n"+timelogentry1 = TimeLogEntry 'i' "2007/03/11 16:19:00" "hledger"++timelogentry2_str = "o 2007/03/11 16:30:00\n"+timelogentry2 = TimeLogEntry 'o' "2007/03/11 16:30:00" ""++timelog1_str = concat [+ timelogentry1_str,+ timelogentry2_str+ ]+timelog1 = TimeLog [+ timelogentry1,+ timelogentry2+ ]+
+ Utils.hs view
@@ -0,0 +1,43 @@+{-|++Utilities for top-level modules and/or ghci. See also "Ledger.Utils".++-}++module Utils+where+import qualified Data.Map as Map (lookup)+import Options+import Ledger+++-- | get a RawLedger from the given file path+rawledgerfromfile :: FilePath -> IO RawLedger+rawledgerfromfile f = do+ parsed <- parseLedgerFile f+ return $ either (\_ -> RawLedger [] [] [] "") id parsed++-- | get a cached Ledger from the given file path+ledgerfromfile :: FilePath -> IO Ledger+ledgerfromfile f = do+ l <- rawledgerfromfile f+ return $ cacheLedger $ filterRawLedger "" "" [] l++-- | get a RawLedger from the file your LEDGER environment variable+-- variable points to or (WARNING) an empty one if there was a problem.+myrawledger :: IO RawLedger+myrawledger = do+ parsed <- ledgerFilePathFromOpts [] >>= parseLedgerFile+ return $ either (\_ -> RawLedger [] [] [] "") id parsed++-- | get a cached Ledger from the file your LEDGER environment variable+-- variable points to or (WARNING) an empty one if there was a problem.+myledger :: IO Ledger+myledger = do+ l <- myrawledger+ return $ cacheLedger $ filterRawLedger "" "" [] l++-- | get a named account from your ledger file+myaccount :: AccountName -> IO Account+myaccount a = myledger >>= (return . fromMaybe nullacct . Map.lookup a . accountmap)+
+ hledger.cabal view
@@ -0,0 +1,47 @@+Name: hledger+Version: 0.1+Category: Finance+Synopsis: A ledger-compatible text-based accounting tool.+Description: This is a minimal haskell clone of John Wiegley's ledger+ <http://newartisans.com/software/ledger.html>. hledger does basic+ register & balance reporting from a plain text ledger file, and + demonstrates a functional implementation of ledger.+License: GPL+Stability: alpha+Author: Simon Michael <simon@joyful.com>+Maintainer: Simon Michael <simon@joyful.com>+Homepage: http://joyful.com/Ledger#hledger+Tested-With: GHC+Build-Type: Simple+License-File: LICENSE+Extra-Source-Files: README sample.ledger+Extra-Tmp-Files: +Cabal-Version: >= 1.2++Executable hledger+ Build-Depends: base, containers, haskell98, directory, parsec, regex-compat,+ old-locale, time, HUnit, QuickCheck >= 1 && < 2+ Main-Is: hledger.hs+ Other-Modules: + BalanceCommand+ Options+ PrintCommand+ RegisterCommand+ Setup+ Tests+ Utils+ Ledger+ Ledger.Account+ Ledger.AccountName+ Ledger.Amount+ Ledger.Commodity+ Ledger.Entry+ Ledger.RawLedger+ Ledger.Ledger+ Ledger.RawTransaction+ Ledger.Parse+ Ledger.TimeLog+ Ledger.Transaction+ Ledger.Types+ Ledger.Utils+
+ hledger.hs view
@@ -0,0 +1,77 @@+#!/usr/bin/env runhaskell+{-|+hledger - a ledger-compatible text-based accounting tool.++Copyright (c) 2007-2008 Simon Michael <simon@joyful.com>+Released under GPL version 3 or later.++This is a minimal haskell clone of John Wiegley's ledger+<http://newartisans.com/software/ledger.html>. hledger generates+simple ledger-compatible register & balance reports from a plain text+ledger file, and demonstrates a functional implementation of ledger.++You can use the command line:++> $ hledger --help++or ghci:++> $ ghci hledger+> > l <- ledgerfromfile "sample.ledger"+> > balance [] [] l+> $-1 assets+> $2 expenses+> $-2 income+> $1 liabilities:debts+> > register [] ["income","expenses"] l+> 2007/01/01 income income:salary $-1 $-1+> 2007/01/01 gift income:gifts $-1 $-2+> 2007/01/01 eat & shop expenses:food $1 $-1+> expenses:supplies $1 0++-}++module Main (+ module Main,+ module Utils,+ module Options,+ module BalanceCommand,+ module PrintCommand,+ module RegisterCommand,+)+where+import qualified Data.Map as Map (lookup)+import Ledger+import Utils+import Options+import BalanceCommand+import PrintCommand+import RegisterCommand+import Tests+++main :: IO ()+main = do+ (opts, cmd, args) <- parseArguments+ run cmd opts args+ where + run cmd opts args+ | Help `elem` opts = putStr usage+ | Version `elem` opts = putStr version+ | cmd `isPrefixOf` "balance" = parseLedgerAndDo opts args balance+ | cmd `isPrefixOf` "print" = parseLedgerAndDo opts args print'+ | cmd `isPrefixOf` "register" = parseLedgerAndDo opts args register+ | cmd `isPrefixOf` "test" = runtests >> return ()+ | otherwise = putStr usage++-- | parse the user's specified ledger file and do some action with it+-- (or report a parse error). This function makes the whole thing go.+parseLedgerAndDo :: [Opt] -> [String] -> ([Opt] -> [String] -> Ledger -> IO ()) -> IO ()+parseLedgerAndDo opts args cmd = + ledgerFilePathFromOpts opts >>= parseLedgerFile >>= either printParseError runthecommand+ where+ runthecommand = cmd opts args . cacheLedger . normaliseRawLedgerAmounts . filterRawLedger begin end descpats+ begin = beginDateFromOpts opts+ end = endDateFromOpts opts+ descpats = snd $ parseAccountDescriptionArgs args+
+ sample.ledger view
@@ -0,0 +1,36 @@+; A sample ledger file.+;+; Sets up this account tree:+; assets+; cash+; checking+; saving+; expenses+; food+; supplies+; income+; gifts+; salary+; liabilities+; debts++2007/01/01 income+ assets:checking $1+ income:salary++2007/01/01 gift+ assets:checking $1+ income:gifts++2007/01/01 save+ assets:saving $1+ assets:checking++2007/01/01 * eat & shop+ expenses:food $1+ expenses:supplies $1+ assets:cash++2008/1/1 * pay off+ liabilities:debts $1+ assets:checking