penny 0.30.0.2 → 0.32.0.0
raw patch · 37 files changed
+1361/−1222 lines, 37 filesdep +anonymous-sumsdep ~QuickCheckdep ~basedep ~bytestring
Dependencies added: anonymous-sums
Dependency ranges changed: QuickCheck, base, bytestring, cereal, containers, either, matchers, old-locale, parsec, prednote, pretty-show, rainbow, random, semigroups, split, text, time, transformers
Files
- README +0/−43
- README.md +67/−0
- bin/penny-diff.hs +2/−191
- bin/penny-reconcile.hs +2/−72
- bin/penny-reprint.hs +2/−48
- bin/penny-selloff.hs +2/−614
- doc/examples/more-file-format-details.pny +14/−13
- known-working-dependencies.txt +67/−0
- lib/Penny.hs +5/−5
- lib/Penny/Brenner.hs +1/−1
- lib/Penny/Brenner/Clear.hs +1/−1
- lib/Penny/Brenner/Info.hs +1/−1
- lib/Penny/Brenner/Merge.hs +1/−1
- lib/Penny/Brenner/Types.hs +1/−1
- lib/Penny/Cabin/Balance/Convert/Chunker.hs +1/−1
- lib/Penny/Cabin/Balance/Convert/ChunkerPct.hs +1/−1
- lib/Penny/Cabin/Balance/MultiCommodity/Chunker.hs +1/−1
- lib/Penny/Cabin/Posts/Growers.hs +1/−1
- lib/Penny/Cabin/Row.hs +1/−1
- lib/Penny/Copper.hs +1/−1
- lib/Penny/Copper/Interface.hs +1/−1
- lib/Penny/Copper/Parsec.hs +1/−1
- lib/Penny/Copper/Render.hs +1/−1
- lib/Penny/Denver.hs +6/−0
- lib/Penny/Denver/Diff.hs +195/−0
- lib/Penny/Denver/Reconcile.hs +76/−0
- lib/Penny/Denver/Reprint.hs +52/−0
- lib/Penny/Denver/Selloff.hs +618/−0
- lib/Penny/Lincoln/Bits/Qty.hs +68/−26
- lib/Penny/Steel.hs +4/−0
- lib/Penny/Steel/Sums.hs +0/−71
- lib/Penny/Wheat.hs +1/−1
- lib/Penny/Zinc.hs +1/−1
- penny.cabal +142/−116
- tests/Copper/Gen/Parsers.hs +1/−1
- tests/Lincoln.hs +20/−4
- tests/penny-test.hs +2/−2
− README
@@ -1,43 +0,0 @@-Welcome to Penny, double-entry accounting.--Penny's web pages are at:--http://massysett.github.com/penny-http://hackage.haskell.org/package/penny-http://github.com/massysett/penny--Versions that contain at least one odd number are development-versions. They are not posted to Hackage. I try to keep the master-branch in compilable shape. However, development versions may not pass-all tests, and in particular they may have out of date or incomplete-documentation.--Releases consist of code of reasonable quality. All of the groups in-their release numbers are even.--Penny is licensed under the MIT license, see the LICENSE file.--To install the latest release, "cabal install penny" should work. To-also build test executables, run "cabal install -ftest penny". That-will give you two additional executables: penny-test, which when run-will test a bunch of QuickCheck properties, and penny-gibberish, which-prints a random, but valid, ledger file.--To install the manual pages and the documentation, run "sh-install-docs". It will install the manual pages to $PREFIX/share/man-and the other documentation to $PREFIX/share/doc/penny. By default-$PREFIX is /usr/local; you can change this by editing the-install-docs file and changing the "PREFIX" variable.--To remove the manual pages and the documentation, run "sh-install-docs remove."--The first thing you will want to look at is the manual page-penny-basics(7). Then you will want to examine the starter.pny file-in the examples directory, which will show you how to write a ledger-file. penny-suite(7) will then direct you to other documentation that-may interest you.--Though I do use this program to maintain all my financial records, it-is still relatively new and no one but me has tested it. Use at your-own risk.
+ README.md view
@@ -0,0 +1,67 @@+Welcome to Penny, double-entry accounting.++Penny's web pages are at:++http://massysett.github.com/penny++http://hackage.haskell.org/package/penny++http://github.com/massysett/penny++Versions that contain at least one odd number are development+versions. They are not posted to Hackage. I try to keep the master+branch in compilable shape. However, development versions may not pass+all tests, and in particular they may have out of date or incomplete+documentation.++Releases consist of code of reasonable quality. All of the groups in+their release numbers are even.++Penny is licensed under the MIT license, see the LICENSE file.++To install the latest release, "cabal install penny" should work. To+also build test executables, run "cabal install -ftest penny". That+will give you two additional executables: penny-test, which when run+will test a bunch of QuickCheck properties, and penny-gibberish, which+prints a random, but valid, ledger file.++To install the manual pages and the documentation, run "sh+install-docs". It will install the manual pages to $PREFIX/share/man+and the other documentation to $PREFIX/share/doc/penny. By default+$PREFIX is /usr/local; you can change this by editing the+install-docs file and changing the "PREFIX" variable.++To remove the manual pages and the documentation, run "sh+install-docs remove."++The first thing you will want to look at is the manual page+penny-basics(7). Then you will want to examine the starter.pny file+in the examples directory, which will show you how to write a ledger+file. penny-suite(7) will then direct you to other documentation that+may interest you.++Though I do use this program to maintain all my financial records, it+is still relatively new and no one but me has tested it. Use at your+own risk.++Dependencies+------------++cabal install will take care of all Haskell dependencies for you;+however, there are also at least two C libraries you will need to+install as Penny depends on other Haskell libraries that use these C+libraries. You will need to make sure you have the "development"+package installed if you use many Linux distributions; a few+distributors, such as Arch, Slackware, and Gentoo, generally don't+ship separate "development" packages so that won't apply to you.+The C libraries are:++* pcre - http://www.pcre.org/ - on Debian GNU/Linux systems this+ package is called `libpcre3-dev`++* curses - on GNU systems this is known as ncurses,+ http://www.gnu.org/software/ncurses/ Perhaps other, non-GNU curses+ implementations will work as well; I do not know. On Debian+ GNU/Linux systems, install `libncurses5-dev`.++[](https://travis-ci.org/massysett/penny)
bin/penny-diff.hs view
@@ -1,195 +1,6 @@ module Main where -import Control.Arrow (first, second)-import Data.Maybe (fromJust)-import Data.List (deleteFirstsBy)-import qualified System.Console.MultiArg as M-import qualified Penny.Liberty as Ly-import qualified Penny.Lincoln as L-import Penny.Lincoln ((==~))-import qualified Penny.Copper as C-import qualified Penny.Copper.Render as CR-import qualified Penny.Steel.Sums as S-import Data.Maybe (mapMaybe)-import qualified Data.Text as X-import qualified Data.Text.IO as TIO-import qualified System.Exit as E-import qualified System.IO as IO--import qualified Paths_penny as PPB+import qualified Penny.Denver.Diff main :: IO ()-main = runPennyDiff--help :: String -> String-help pn = unlines- [ "usage: " ++ pn ++ " [-12] FILE1 FILE2"- , "Shows items that exist in FILE1 but not in FILE2,"- , "as well as items that exist in FILE2 but not in FILE1."- , "Options:"- , "-1 Show only items that exist in FILE1 but not in FILE2"- , "-2 Show only items that exist in FILE2 but not in FILE1"- , ""- , "--help, -h - show this help and exit"- , "--version Show version and exit"- ]--data Args = ArgFile File | Filename String- deriving (Eq, Show)--data DiffsToShow = File1Only | File2Only | BothFiles--optFile1 :: M.OptSpec Args-optFile1 = M.OptSpec [] "1" (M.NoArg (ArgFile File1))--optFile2 :: M.OptSpec Args-optFile2 = M.OptSpec [] "2" (M.NoArg (ArgFile File2))--allOpts :: [M.OptSpec Args]-allOpts = [ optFile1 , optFile2 ]--data File = File1 | File2- deriving (Eq, Show)---- | All possible items, but excluding blank lines.-type NonBlankItem =- S.S3 L.Transaction L.PricePoint C.Comment--removeMeta- :: L.Transaction- -> (L.TopLineCore, L.Ents L.PostingCore)-removeMeta- = first L.tlCore- . second (fmap L.pdCore)- . L.unTransaction--clonedNonBlankItem :: NonBlankItem -> NonBlankItem -> Bool-clonedNonBlankItem nb1 nb2 = case (nb1, nb2) of- (S.S3a t1, S.S3a t2) -> removeMeta t1 ==~ removeMeta t2- (S.S3b p1, S.S3b p2) -> p1 ==~ p2- (S.S3c c1, S.S3c c2) -> c1 == c2- _ -> False--toNonBlankItem :: C.LedgerItem -> Maybe NonBlankItem-toNonBlankItem = S.caseS4 (Just . S.S3a) (Just . S.S3b) (Just . S.S3c)- (const Nothing)--showLineNum :: File -> Int -> X.Text-showLineNum f i = X.pack ("\n" ++ arrow ++ " " ++ show i ++ "\n")- where- arrow = case f of- File1 -> "<=="- File2 -> "==>"----- | Renders a transaction, along with a line showing what file it--- came from and its line number. If there is a TransactionMemo, shows--- the line number for the top line for that; otherwise, shows the--- line number for the TopLine.-renderTransaction- :: File- -> L.Transaction- -> Maybe X.Text-renderTransaction f t = fmap addHeader $ CR.transaction Nothing (noMeta t)- where- lin = case L.tMemo . L.tlCore . fst . L.unTransaction $ t of- Nothing -> L.unTopLineLine . L.tTopLineLine . fromJust- . L.tlFileMeta . fst . L.unTransaction $ t- Just _ -> L.unTopMemoLine . fromJust . L.tTopMemoLine . fromJust- . L.tlFileMeta . fst . L.unTransaction $ t- addHeader x = (showLineNum f lin) `X.append` x- noMeta txn = let (tl, es) = L.unTransaction txn- in (L.tlCore tl, fmap L.pdCore es)--renderPrice :: File -> L.PricePoint -> Maybe X.Text-renderPrice f p = fmap addHeader $ CR.price p- where- lin = L.unPriceLine . fromJust . L.priceLine $ p- addHeader x = (showLineNum f lin) `X.append` x--renderNonBlankItem- :: File- -> NonBlankItem- -> Maybe X.Text-renderNonBlankItem f =- S.caseS3 (renderTransaction f) (renderPrice f) CR.comment--runPennyDiff :: IO ()-runPennyDiff = do- (f1, f2, dts) <- parseCommandLine- l1 <- C.open [f1]- l2 <- C.open [f2]- let (r1, r2) = doDiffs l1 l2- showDiffs dts (r1, r2)- case (r1, r2) of- ([], []) -> E.exitSuccess- _ -> E.exitWith (E.ExitFailure 1)--showDiffs- :: DiffsToShow- -> ([NonBlankItem], [NonBlankItem])- -> IO ()-showDiffs dts (l1, l2) =- case dts of- File1Only -> showFile1- File2Only -> showFile2- BothFiles -> showFile1 >> showFile2- where- showFile1 = showNonBlankItems File1 l1- showFile2 = showNonBlankItems File2 l2--failure :: String -> IO a-failure s = IO.hPutStrLn IO.stderr s- >> E.exitWith (E.ExitFailure 2)--showNonBlankItems- :: File- -> [NonBlankItem]- -> IO ()-showNonBlankItems f ls =- mapM_ (showNonBlankItem f) ls--showNonBlankItem- :: File- -> NonBlankItem- -> IO ()-showNonBlankItem f nbi = maybe e TIO.putStr- (renderNonBlankItem f nbi)- where- e = failure $ "could not render item: " ++ show nbi----- | Returns a pair p, where fst p is the items that appear in file1--- but not in file2, and snd p is items that appear in file2 but not--- in file1.-doDiffs- :: [C.LedgerItem]- -> [C.LedgerItem]- -> ([NonBlankItem], [NonBlankItem])-doDiffs l1 l2 = (r1, r2)- where- mkNbList = mapMaybe toNonBlankItem- (nb1, nb2) = (mkNbList l1, mkNbList l2)- df = deleteFirstsBy clonedNonBlankItem- (r1, r2) = (nb1 `df` nb2, nb2 `df` nb1)---- | Returns a tuple with the first filename, the second filename, and--- an indication of which differences to show.-parseCommandLine :: IO (String, String, DiffsToShow)-parseCommandLine = do- as <- M.simpleHelpVersion help (Ly.version PPB.version)- allOpts M.Intersperse- (return . Filename)- let toFilename a = case a of- Filename s -> Just s- _ -> Nothing- (fn1, fn2) <- case mapMaybe toFilename as of- x:y:[] -> return (x, y)- _ -> failure "penny-diff: error: you must supply two filenames."- let getDiffs- | ((ArgFile File1) `elem` as)- && ((ArgFile File2) `elem` as) = BothFiles- | ((ArgFile File1) `elem` as) = File1Only- | ((ArgFile File2) `elem` as) = File2Only- | otherwise = BothFiles- return (fn1, fn2, getDiffs)+main = Penny.Denver.Diff.main
bin/penny-reconcile.hs view
@@ -1,76 +1,6 @@ module Main where -import Data.Either (partitionEithers)-import Data.Maybe (fromMaybe, fromJust)-import qualified Data.Text as X-import Control.Monad (guard)-import qualified Penny.Copper as C-import qualified Penny.Lincoln as L-import qualified Penny.Liberty as Ly-import qualified Penny.Steel.Sums as S-import qualified System.Console.MultiArg as MA-import qualified Paths_penny as PPB----- | Changes a posting to mark it reconciled, if it was already marked--- as cleared.-changePosting :: L.PostingData -> L.PostingData-changePosting p = fromMaybe p $ do- let c = L.pdCore p- fl <- L.pFlag c- guard (L.unFlag fl == X.singleton 'C')- let fl' = L.Flag . X.singleton $ 'R'- c' = c { L.pFlag = Just fl' }- return p { L.pdCore = c' }---- | Changes a TopLine to mark it as reconciled, if it was already--- marked as cleared.-changeTopLine :: L.TopLineData -> L.TopLineData-changeTopLine t = fromMaybe t $ do- let c = L.tlCore t- fl <- L.tFlag c- guard (L.unFlag fl == X.singleton 'C')- let fl' = L.Flag . X.singleton $ 'R'- c' = c { L.tFlag = Just fl' }- return t { L.tlCore = c' }--changeTransaction :: L.Transaction -> L.Transaction-changeTransaction (L.Transaction (tl, es)) =- L.Transaction (changeTopLine tl, fmap changePosting es)--help :: String -> String-help pn = unlines- [ "usage: " ++ pn ++ " [options] FILE..."- , "Finds all transactions and postings bearing a \"C\" flag"- , "and changes them to a \"R\" flag in the listed FILEs."- , "If no FILE, or if FILE is -, read standard input."- , ""- , "Output is printed to standard output. Input files are not"- , "changed."- , ""- , "Options:"- , " --output FILENAME, -o FILENAME"- , " send output to FILENAME rather than standard output"- , " (multiple -o options are allowed; use \"-\" for standard"- , " output)"- , " -h, --help - Show help and exit."- , " --version - Show version and exit"- ]--type Printer = X.Text -> IO ()-type PosArg = String-type Arg = Either Printer PosArg--allOpts :: [MA.OptSpec Arg]-allOpts = [ fmap Left Ly.output ]+import qualified Penny.Denver.Reconcile main :: IO ()-main = do- as <- MA.simpleHelpVersion help (Ly.version PPB.version)- allOpts MA.Intersperse (return . Right)- let (printers, posArgs) = partitionEithers as- led <- C.open posArgs- let led' = map (S.mapS4 changeTransaction id id id) led- rend = fromJust $ mapM (C.item Nothing) (map C.stripMeta led')- let txt = X.concat rend in txt `seq` (Ly.processOutput printers txt)-+main = Penny.Denver.Reconcile.main
bin/penny-reprint.hs view
@@ -1,52 +1,6 @@ module Main where -import Data.Either (partitionEithers)-import qualified Penny.Copper as C-import qualified Penny.Copper.Render as R-import qualified Penny.Liberty as Ly-import qualified Data.Text as X-import qualified System.Console.MultiArg as MA--import qualified Paths_penny as PPB--help :: String -> String-help pn = unlines- [ "usage: " ++ pn ++ " FILE..."- , "Tidies the formatting of a Penny ledger file."- , "All memos, comments, and blank lines are preserved,"- , "and the order of the transactions and postings is not changed."- , "However, the whitespace that separates different elements"- , "of a posting will change in order to tidy things up."- , ""- , "If no FILE, or if FILE is \"-\", read stanard input."- , "Result is printed to standard output."- , ""- , "Options:"- , " --output FILENAME, -o FILENAME"- , " send output to FILENAME rather than standard output"- , " (multiple -o options are allowed; use \"-\" for standard"- , " output)"- , " --help, -h - show help and exit"- , " --version - show version and exit"- ]--type Printer = X.Text -> IO ()-type PosArg = String--type Arg = Either Printer PosArg--allOpts :: [MA.OptSpec Arg]-allOpts = [ fmap Left Ly.output ]+import qualified Penny.Denver.Reprint main :: IO ()-main = do- as <- MA.simpleHelpVersion help (Ly.version PPB.version)- allOpts MA.Intersperse- (return . Right)- let (printers, posArgs) = partitionEithers as- l <- C.open posArgs- case mapM (R.item Nothing) (map C.stripMeta l) of- Nothing -> error "could not render final ledger."- Just x ->- let txt = X.concat x- in txt `seq` (Ly.processOutput printers txt)+main = Penny.Denver.Reprint.main
bin/penny-selloff.hs view
@@ -1,618 +1,6 @@--- | penny-selloff---- Steps---- * In IO monad: read values given on command line.---- * Parse command line. Fails if command line fails to parse.---- * If help is requested, show help and exit successfully.---- * In IO monad: read text of files given on command line. Fails if--- there is an IO failure.---- * Parse files given on command line. Fails if files fail to parse.---- * Calculate balances of all accounts. Remove zero balances. This--- step never fails.---- * Find Proceeds account specified on command line. Split it into a--- group name (the second sub-account) and a selloff label (the third--- sub-account). Obtain the SelloffStockAmt, which is the debit--- balance, and the SelloffCurrencyAmt, which is the credit--- balance. Fails if the Proceeds account does not have exactly three--- sub-accounts, or if the account does not have a balance with--- exactly one debit balance and exactly one credit balance. Returns a--- record with the group name, the selloff label, the selloff currency--- amount, and the selloff stock amount. (Remember, an amount is a Qty--- and a Commodity.)---- * Filter account balances to find all Basis accounts with a--- matching group name. Only accounts that have Basis as the first--- sub-account AND a matching group name as the second sub-account are--- further analyzed; all other accounts are discarded. Returns a list--- of matching accounts, but only with a list of remaining--- sub-accounts after the first and second sub-accounts, and the--- balances of these accounts. This computation does not fail.---- * For each basis account, parse out the purchase information. This--- consists of a DateTime, which is the time of the purchase; the Qty--- of stock purchased; and the Qty of currency paid for the--- stock. Returns this information in a record. Fails if the basis--- account does not have exactly two commodities in its balance, or if--- there is not a credit balance matching the stock commodity, or if--- there is not a debit balance matching the currency commodity, or if--- the basis account has more than one remaining sub-account; or if--- the DateTime cannot be parsed.---- * For each basis account, compute the basis realization--- information. First sort the basis accounts with the earliest--- accounts coming first. Then for each account calculate how many--- shares to debit and how much currency to credit. Do this in a--- stateful transforming function that will transform the purchase--- information into a pair with basis realization information and--- purchase information. The state contains the number of shares--- remaining that need to have their basis realized, and the total--- cost of realized shares.---- To calculate each basis realization, compare the number of shares--- purchased with the number still remaining to be realized. If the--- number purchased is less than or equal to the number remaining to--- be realized, return a basis realization that realizes all the--- shares purchased. If the number of shares purchased is more than--- the number still remaining to be realized, then realize all the--- shares that still need to be realized, and credit the cost--- proportionally. If there are no shares remaining to be realized,--- return no realization information at all.---- Returns a list of pairs of basis realizations and purchase--- information; purchases that have no basis realizations are--- discarded. Also returns the total cost of shares sold. Fails if--- there are still shares that have not had their basis realized--- (i.e. the number of shares in the Proceeds account is greater than--- the number of shares in the selloff group.)---- * Compute the capital gain or loss. Take the difference between the--- selloff currency quantity and the cost of shares sold. If the--- selloff currency quantity is greater, there is a capital--- gain. Record credits to an Income:Capital Gain account. If the cost--- of shares sold is greater, there is a capital loss. Record debits--- to an Expenses:Capital Loss account. To calculate the gain or loss--- per purchase transaction, use the allocate function in the Qty--- module. The target total is the total capital gain or loss, and--- each allocation is the number of shares purchased in each--- account. Returns a list of quantities (one for each capital gain or--- loss, which corresponds to each purchase account) and an indication--- of whether there was a capital gain or loss (this need only be--- reported once.) Fails if the allocation fails.---- * Create output transaction. This never fails (if it does, it is a--- programmer error; just apply error.)---- * In IO monad: Print output transaction.- module Main (main) where -import Control.Arrow (first)-import Control.Applicative ((<$>), (<*>), pure)-import Control.Monad (when)-import qualified Control.Monad.Trans.Either as Ei-import qualified Control.Monad.Trans.State as St-import Control.Monad.Trans.Class (lift)-import Data.List (find)-import Data.Maybe (isJust, mapMaybe, catMaybes, fromMaybe)-import Data.Text (pack)-import qualified Data.Text as X-import qualified Data.Text.IO as TIO-import qualified Penny.Lincoln.Balance as Bal-import qualified Penny.Steel.Sums as S-import qualified Penny.Cabin.Balance.Util as BU-import Penny.Cabin.Options (ShowZeroBalances(..))-import qualified Penny.Copper as Cop-import qualified Penny.Copper.Parsec as CP-import qualified Penny.Copper.Render as CR-import qualified Penny.Liberty as Ly-import qualified Penny.Lincoln as L-import qualified Data.Map as M-import qualified System.Console.MultiArg as MA-import qualified Text.Parsec as Parsec-import qualified Paths_penny as PPB-import qualified Penny as P--type Err = Either Error--data Error- = ParseFail MA.Error- | NoInputArgs- | ProceedsParseFailed Parsec.ParseError- | NoSelloffAccount- | NotThreeSelloffSubAccounts- | BadSelloffBalance- | BadPurchaseBalance- | BadPurchaseDate Parsec.ParseError- | NotThreePurchaseSubAccounts [L.SubAccount]- | BasisAllocationFailed- | ZeroCostSharesSold- | InsufficientSharePurchases- | NoPurchaseInformation- | SaleDateParseFailed Parsec.ParseError- deriving Show--data ProceedsAcct = ProceedsAcct { _unProceedsAcct :: L.Account }- deriving Show--newtype InputFilename = InputFilename { _unInputFilename :: String }- deriving (Eq, Show)--data ParseResult = ParseResult ProceedsAcct [Cop.LedgerItem]--parseCommandLine :: IO ParseResult-parseCommandLine = do- as <- MA.simpleHelpVersion help (Ly.version PPB.version)- [] MA.Intersperse return- x:xs <- case as of- [] -> fail (show NoInputArgs)- r -> return r- a <- either (fail . show . ProceedsParseFailed) return- $ Parsec.parse CP.lvl1Acct "" (pack x)- l <- Cop.open xs- return $ ParseResult (ProceedsAcct a) l---help :: String -> String-help pn = unlines- [ "usage: " ++ pn ++ " PROCEEDS_ACCOUNT FILE..."- , "calculate capital gains and losses from commodity sales."- , "Options:"- , " -h, --help - show this help and exit."- , " --version - show version and exit."- ]--calcBalances :: [Cop.LedgerItem] -> [(L.Account, L.Balance)]-calcBalances- = BU.flatten- . BU.balances (ShowZeroBalances False)- . map (\p -> ((), p))- . concatMap L.transactionToPostings- . mapMaybe (S.caseS4 Just (const Nothing) (const Nothing)- (const Nothing))--newtype Group = Group { unGroup :: L.SubAccount }- deriving (Show, Eq)--newtype SaleDate = SaleDate { unSaleDate :: L.DateTime }- deriving (Show, Eq)--newtype SelloffStock = SelloffStock { unSelloffStock :: L.Amount L.Qty }- deriving (Show, Eq)--newtype SelloffCurrency- = SelloffCurrency { unSelloffCurrency :: L.Amount L.Qty }- deriving (Show, Eq)--data SelloffInfo = SelloffInfo- { siGroup :: Group- , siSaleDate :: SaleDate- , siStock :: SelloffStock- , siCurrency :: SelloffCurrency- } deriving Show--selloffInfo- :: ProceedsAcct -> [(L.Account, L.Balance)] -> Err SelloffInfo-selloffInfo (ProceedsAcct pa) bals = do- bal <- fmap snd- . maybe (Left NoSelloffAccount) Right- . find ((== pa) . fst)- $ bals- (g, d) <- case L.unAccount pa of- _ : s2 : s3 : [] -> return (s2, s3)- _ -> Left NotThreeSelloffSubAccounts- (sStock, sCurr) <- selloffStockCurr bal- date <- fmap SaleDate- . either (Left . SaleDateParseFailed) Right- . Parsec.parse CP.dateTime ""- $ (L.text d)- return $ SelloffInfo (Group g) date sStock sCurr--selloffStockCurr :: L.Balance -> Err (SelloffStock, SelloffCurrency)-selloffStockCurr bal = do- let m = L.unBalance bal- when (M.size m /= 2) $ Left BadSelloffBalance- let toPair (cy, bl) = case bl of- Bal.Zero -> Nothing- Bal.NonZero col -> Just (cy, col)- ps = mapMaybe toPair . M.toList $ m- findBal dc = maybe (Left BadSelloffBalance) Right- . find ((== dc) . Bal.colDrCr . snd)- $ ps- (cyStock, (Bal.Column _ qtyStock)) <- findBal L.Debit- (cyCurr, (Bal.Column _ qtyCurr)) <- findBal L.Credit- let sellStock = SelloffStock- (L.Amount qtyStock cyStock)- sellCurr = SelloffCurrency- (L.Amount qtyCurr cyCurr)- return (sellStock, sellCurr)---basis :: L.SubAccount-basis = L.SubAccount . pack $ "Basis"--findBasisAccounts- :: Group- -> [(L.Account, L.Balance)]- -> [([L.SubAccount], L.Balance)]-findBasisAccounts (Group g) = mapMaybe f- where- f ((L.Account a), b) = case a of- s0 : s1 : s2 : ss -> if (s0 == basis) && (s1 == g)- then Just (s2:ss, b) else Nothing- _ -> Nothing---data PurchaseDate = PurchaseDate { unPurchaseDate :: L.DateTime }- deriving Show--data PurchaseStockQty- = PurchaseStockQty { unPurchaseStockQty :: L.Qty }- deriving (Eq, Show)--data PurchaseCurrencyQty- = PurchaseCurrencyQty { unPurchaseCurrencyQty :: L.Qty }- deriving (Eq, Show)--data PurchaseInfo = PurchaseInfo- { piDate :: PurchaseDate- , piStockQty :: PurchaseStockQty- , piCurrencyQty :: PurchaseCurrencyQty- } deriving Show--purchaseInfo- :: SelloffStock- -> SelloffCurrency- -> ([L.SubAccount], L.Balance)- -> Err PurchaseInfo-purchaseInfo sStock sCurr (ss, bal) = do- dateSub <- case ss of- s1:[] -> return s1- _ -> Left $ NotThreePurchaseSubAccounts ss- date <- either (Left . BadPurchaseDate) Right- . Parsec.parse CP.dateTime ""- . L.text- $ dateSub- (stockQty, currQty) <- purchaseQtys sStock sCurr bal- return $ PurchaseInfo (PurchaseDate date) stockQty currQty--purchaseQtys- :: SelloffStock- -> SelloffCurrency- -> L.Balance- -> Err (PurchaseStockQty, PurchaseCurrencyQty)-purchaseQtys (SelloffStock sStock) (SelloffCurrency sCurr) bal = do- let m = L.unBalance bal- when (M.size m /= 2) $ Left BadPurchaseBalance- let toPair (cy, bl) = case bl of- Bal.Zero -> Nothing- Bal.NonZero col -> Just (cy, col)- ps = mapMaybe toPair . M.toList $ m- findBal dc = maybe (Left BadPurchaseBalance) Right- . find ((== dc) . Bal.colDrCr . snd)- $ ps- (cyStock, (Bal.Column _ qtyStock)) <- findBal L.Credit- (cyCurr, (Bal.Column _ qtyCurr)) <- findBal L.Debit- when (cyStock /= L.commodity sStock) $ Left BadPurchaseBalance- when (cyCurr /= L.commodity sCurr) $ Left BadPurchaseBalance- return (PurchaseStockQty qtyStock, PurchaseCurrencyQty qtyCurr)---newtype RealizedStockQty- = RealizedStockQty { unRealizedStockQty :: L.Qty }- deriving (Eq, Show)--newtype RealizedCurrencyQty- = RealizedCurrencyQty { unRealizedCurrencyQty :: L.Qty }- deriving (Eq, Show)--newtype CostSharesSold- = CostSharesSold { unCostSharesSold :: L.Qty }- deriving (Eq, Show)--newtype StillToRealize- = StillToRealize { _unStillToRealize :: L.Qty }- deriving (Eq, Show)--data BasisRealiztn = BasisRealiztn- { brStockQty :: RealizedStockQty- , brCurrencyQty :: RealizedCurrencyQty- } deriving Show---- | Realize an individual purchase account's basis. Fails if the--- basis cannot be allocated.-stRealizeBasis- :: PurchaseInfo- -> Ei.EitherT Error- (St.State (Maybe CostSharesSold, Maybe StillToRealize))- (Maybe (PurchaseInfo, BasisRealiztn))-stRealizeBasis p = do- mayTr <- lift $ St.gets snd- case mayTr of- Nothing -> return Nothing- Just (StillToRealize tr) -> do- let sq = unPurchaseStockQty . piStockQty $ p- pcq = unPurchaseCurrencyQty . piCurrencyQty $ p- mayCss <- lift $ St.gets fst- case L.difference tr sq of-- L.LeftBiggerBy tr' -> do- let br = BasisRealiztn (RealizedStockQty sq)- (RealizedCurrencyQty pcq)- css' = case mayCss of- Nothing -> CostSharesSold pcq- Just (CostSharesSold css) ->- CostSharesSold (L.add pcq css)- lift $ St.put (Just css', Just (StillToRealize tr'))- return (Just (p, br))-- L.RightBiggerBy unsoldStockQty -> do- let alloced = L.allocate pcq (sq, [unsoldStockQty])- basisSold = case alloced of- (x, (_ : [])) -> x- _ -> error "stRealizeBasis: error"- let css' = case mayCss of- Nothing -> CostSharesSold basisSold- Just (CostSharesSold css) ->- CostSharesSold (L.add basisSold css)- br = BasisRealiztn (RealizedStockQty tr)- (RealizedCurrencyQty basisSold)- lift $ St.put (Just css', Nothing)- return (Just (p, br))-- L.Equal -> do- let br = BasisRealiztn (RealizedStockQty sq)- (RealizedCurrencyQty pcq)- css' = case mayCss of- Nothing -> CostSharesSold pcq- Just (CostSharesSold css) ->- CostSharesSold (L.add css pcq)- lift $ St.put (Just css', Nothing)- return (Just (p, br))--realizeBases- :: SelloffStock- -> [PurchaseInfo]- -> Err ([(PurchaseInfo, BasisRealiztn)], CostSharesSold)-realizeBases sellStck ps = do- let stReal = Just . StillToRealize . L.qty- . unSelloffStock $ sellStck- (exRs, (mayCss, mayTr)) = St.runState- (Ei.runEitherT (mapM stRealizeBasis ps))- (Nothing, stReal)- rs <- exRs- when (isJust mayTr) $ Left InsufficientSharePurchases- css <- maybe (Left ZeroCostSharesSold) Right mayCss- return (catMaybes rs, css)--newtype CapitalChange = CapitalChange { unCapitalChange :: L.Qty }- deriving Show--data WithCapitalChanges- = WithCapitalChanges [(PurchaseInfo, BasisRealiztn, CapitalChange)]- GainOrLoss- | NoChange [(PurchaseInfo, BasisRealiztn)]- deriving Show--data GainOrLoss = Gain | Loss deriving (Eq, Show)--capitalChange- :: CostSharesSold- -> SelloffCurrency- -> [(PurchaseInfo, BasisRealiztn)]- -> Err WithCapitalChanges-capitalChange css sc ls =- let sellCurrQty = L.qty . unSelloffCurrency $ sc- costQty = unCostSharesSold css- mayGainLoss =- case L.difference sellCurrQty costQty of- L.LeftBiggerBy q -> Just (q, Gain)- L.RightBiggerBy q -> Just (q, Loss)- L.Equal -> Nothing- in case mayGainLoss of- Nothing -> return . NoChange $ ls- Just (qt, gl) -> do- nePurchs <- maybe (Left NoPurchaseInformation) Right- . uncons $ ls- let qtys = mapNE (unPurchaseCurrencyQty . piCurrencyQty . fst)- nePurchs- alloced = L.allocate qt qtys- let mkCapChange (p, br) q = (p, br, CapitalChange q)- r = flattenNE $ zipNE mkCapChange nePurchs alloced- return $ WithCapitalChanges r gl--mapNE :: (a -> b) -> (a, [a]) -> (b, [b])-mapNE f (a, as) = (f a, map f as)--flattenNE :: (a, [a]) -> [a]-flattenNE (a, as) = a:as--uncons :: [a] -> Maybe (a, [a])-uncons as = case as of- [] -> Nothing- x:xs -> Just (x, xs)--zipNE :: (a -> b -> c) -> (a, [a]) -> (b, [b]) -> (c, [c])-zipNE f (a, as) (b, bs) = (f a b, zipWith f as bs)--memo :: SaleDate -> L.Memo-memo (SaleDate sd) =- let dTxt = CR.dateTime sd- txt = pack "transaction created by penny-selloff for sale on "- `X.append` dTxt- in L.Memo [txt]--payee :: L.Payee-payee = L.Payee . pack $ "Realize gain or loss"--topLine :: SaleDate -> L.TopLineData-topLine sd =- let core = (L.emptyTopLineCore (unSaleDate sd))- { L.tPayee = Just payee- , L.tMemo = Just . memo $ sd- }- in L.TopLineData { L.tlCore = core- , L.tlFileMeta = Nothing- , L.tlGlobal = Nothing }--basisOffsets- :: SelloffInfo- -> PurchaseDate- -> BasisRealiztn- -> ((L.Entry L.Qty, L.PostingData), (L.Entry L.Qty, L.PostingData))-basisOffsets s pd p = (po enDr, po enCr)- where- ac = L.Account [basis, grp, dt]- grp = unGroup . siGroup $ s- dt = dateToSubAcct . unPurchaseDate $ pd- enDr = L.Entry L.Debit- (L.Amount (unRealizedStockQty . brStockQty $ p)- (L.commodity . unSelloffStock . siStock $ s))- enCr = L.Entry L.Credit- (L.Amount (unRealizedCurrencyQty . brCurrencyQty $ p)- (L.commodity . unSelloffCurrency . siCurrency $ s))- po en = (en, emptyPostingData ac)--emptyPostingData :: L.Account -> L.PostingData-emptyPostingData a =- let core = (L.emptyPostingCore a)- { L.pSide = Just L.CommodityOnLeft- , L.pSpaceBetween = Just L.SpaceBetween- }- in L.PostingData { L.pdCore = core- , L.pdFileMeta = Nothing- , L.pdGlobal = Nothing- }--dateToSubAcct :: L.DateTime -> L.SubAccount-dateToSubAcct = L.SubAccount . CR.dateTime--income :: L.SubAccount-income = L.SubAccount . pack $ "Income"--capGain :: L.SubAccount-capGain = L.SubAccount . pack $ "Capital Gain"--expense :: L.SubAccount-expense = L.SubAccount . pack $ "Expenses"--capLoss :: L.SubAccount-capLoss = L.SubAccount . pack $ "Capital Loss"--capChangeAcct- :: GainOrLoss- -> SelloffInfo- -> PurchaseInfo- -> L.Account-capChangeAcct gl si p = L.Account $ case gl of- Gain -> [income, capGain, grp, sd, pd]- Loss -> [expense, capLoss, grp, sd, pd]- where- grp = unGroup . siGroup $ si- sd = dateToSubAcct . unSaleDate . siSaleDate $ si- pd = dateToSubAcct . unPurchaseDate . piDate $ p--capChangeEntry- :: GainOrLoss- -> SelloffCurrency- -> CapitalChange- -> L.Entry L.Qty-capChangeEntry gl sc cc = L.Entry dc (L.Amount qt cy)- where- dc = case gl of- Gain -> L.Credit- Loss -> L.Debit- cy = L.commodity . unSelloffCurrency $ sc- qt = unCapitalChange cc--capChangePstg- :: SelloffInfo- -> GainOrLoss- -> CapitalChange- -> PurchaseInfo- -> (L.Entry L.Qty, L.PostingData)-capChangePstg si gl cc p = (en, emptyPostingData ac)- where- ac = capChangeAcct gl si p- en = capChangeEntry gl (siCurrency si) cc--proceeds :: L.SubAccount-proceeds = L.SubAccount . pack $ "Proceeds"--proceedsPstgs- :: SelloffInfo- -> ((L.Entry L.Qty, L.PostingData), (L.Entry L.Qty, L.PostingData))-proceedsPstgs si = (po dr, po cr)- where- po en = (en, emptyPostingData ac)- ac = L.Account [proceeds, gr, dt]- gr = unGroup . siGroup $ si- dt = dateToSubAcct . unSaleDate . siSaleDate $ si- dr = L.Entry L.Debit (unSelloffCurrency . siCurrency $ si)- cr = L.Entry L.Credit (unSelloffStock . siStock $ si)---mkTxn- :: SelloffInfo- -> WithCapitalChanges- -> L.Transaction-mkTxn si wcc = fromMaybe err exTxn- where- err = error "mkTxn: making transaction failed"- exTxn = (\topl es -> L.Transaction (topl, es))- <$> pure tl <*> L.ents entInputs- tl = topLine . siSaleDate $ si- (p1, p2) = proceedsPstgs si- ps = case wcc of- NoChange infoRlzns -> concatMap f infoRlzns- where- f (p, br) =- let (b1, b2) = basisOffsets si (piDate p) br- in [b1, b2]- WithCapitalChanges trips gl -> concatMap f trips- where- f (p, br, cc) = [b1, b2, c]- where- (b1, b2) = basisOffsets si (piDate p) br- c = capChangePstg si gl cc p- entInputs = map (first (Just . Right)) (p1:p2:ps)--makeOutput- :: ProceedsAcct- -> [Cop.LedgerItem]- -> Err X.Text-makeOutput pa ldgr = do- let bals = calcBalances ldgr- formatter = P.getQtyFormat defaultRadGroup ldgr- si <- selloffInfo pa bals- let basisAccts = findBasisAccounts (siGroup si) bals- purchInfos <- mapM (purchaseInfo (siStock si) (siCurrency si))- basisAccts- (purchBases, css) <- realizeBases (siStock si) purchInfos- wcc <- capitalChange css (siCurrency si) purchBases- return- . (`X.snoc` '\n')- . fromMaybe (error "makeOutput: transaction did not render")- . (CR.transaction (Just formatter))- . (\t -> let (tl, es) = L.unTransaction t- in (L.tlCore tl, fmap L.pdCore es))- . mkTxn si- $ wcc-+import qualified Penny.Denver.Selloff main :: IO ()-main = parseCommandLine >>= handleParseResult---handleParseResult :: ParseResult -> IO ()-handleParseResult (ParseResult pa ldgr) =- either (error . show) TIO.putStr . makeOutput pa $ ldgr--defaultRadGroup :: S.S3 L.Radix L.PeriodGrp L.CommaGrp-defaultRadGroup = S.S3a L.Period+main = Penny.Denver.Selloff.main
doc/examples/more-file-format-details.pny view
@@ -60,16 +60,16 @@ # quantities. ########################################-## - USE UNICODE+## - USE UTF-8 -# Use a Unicode file format when you save your data. Penny works with-# UTF-8, which is the de-facto standard Unicode encoding on Unix-# systems. If you do not want to bother with Unicode, it's best to use-# just the ASCII subset of Unicode. Using a non-Unicode encoding might-# work, but I have not tested that. Also, if you want to put digit-# grouping characters in your penny file, Unicode is your only option,-# as the Unicode thin space (U+2009) is the only digit grouping-# character you can use.+# Use a the UTF-8 Unicode file format when you save your data. UTF-8+# which is the de-facto standard Unicode encoding on Unix systems. If+# you do not want to bother with Unicode, it's best to use just the+# ASCII subset of Unicode. Since a valid ASCII file is also a valid+# UTF-8 file, you will be fine. Using a non-Unicode encoding might+# work, but I have not tested that. Also, using a non-UTF8 Unicode+# encoding might work too, but I have not tested that either. The+# best thing to do is use UTF-8. # If you have no idea what all this encoding stuff is about, the first # thing to remember is that there is no such thing as plain text. Read@@ -97,7 +97,7 @@ # the DD. # All dates and times are considered to be UTC. If you provide a time,-# you may optionall specify the time zone offset by using a leading+# you may optionally specify the time zone offset by using a leading # plus or a leading minus. # Here are some sample postings with various dates and times.@@ -121,12 +121,13 @@ # Usually you can write information in your ledger file without using # characters to indicate which field is which. However, sometimes if # you want to use slightly more unusual characters, you have to-# surround that field with characters. The canonical guide to what you-# must do is in the bin/doc/ledger-grammar.org file. Here are the highlights:+# surround that field with characters. Right now all the exact rules+# are available only by examining the source code (sorry). Here are+# the highlights: # Accounts can be unquoted if the very first character of the account # is a letter (capital or lower-case, A-Z or a-z) or any character-# above Unicode code point 127 (e.g. ñ, or é, or í, or...). In+# above Unicode code point 127 (e.g. ñ, or é, or í.). In # addition every other character may be nearly any character except a # space or an asterisk. Otherwise, you must surround your account with # curly braces. Example:
+ known-working-dependencies.txt view
@@ -0,0 +1,67 @@+These packages were known to work with Penny 0.32.0.0. These are+all the packages you will need, including for building the tests.++/var/lib/ghc/package.conf.d:+ Cabal-1.16.0+ array-0.4.0.1+ base-4.6.0.1+ bin-package-db-0.0.0.0+ binary-0.5.1.1+ bytestring-0.10.0.2+ containers-0.5.0.0+ deepseq-1.3.0.1+ directory-1.2.0.1+ filepath-1.3.0.1+ (ghc-7.6.3)+ ghc-prim-0.3.0.0+ (haskell2010-1.1.1.0)+ (haskell98-2.0.0.2)+ hoopl-3.9.0.0+ hpc-0.6.0.0+ integer-gmp-0.5.0.0+ old-locale-1.0.0.5+ old-time-1.1.0.1+ pretty-1.1.1.0+ process-1.1.0.2+ rts-1.0+ template-haskell-2.8.0.0+ time-1.4.0.1+ unix-2.6.0.1++/home/massysett/penny/.cabal-sandbox/x86_64-linux-ghc-7.6.3-packages.conf.d:+ MonadRandom-0.1.13+ QuickCheck-2.6+ action-permutations-0.0.0.0+ anonymous-sums-0.2.0.0+ base-unicode-symbols-0.2.2.4+ cereal-0.4.0.1+ comonad-4.0+ contravariant-0.4.4+ distributive-0.4+ either-4.1.1+ hashable-1.2.1.0+ haskell-lexer-1.0+ matchers-0.14.0.0+ monad-control-0.3.2.3+ mtl-2.1.2+ multiarg-0.24.0.0+ nats-0.1.2+ ofx-0.4.0.0+ parsec-3.1.5+ penny-0.32.0.0+ prednote-0.18.0.0+ pretty-show-1.6.7+ rainbow-0.6.0.0+ random-1.0.1.1+ random-shuffle-0.0.4+ semigroupoids-4.0+ semigroups-0.12.2+ split-0.2.2+ tagged-0.7+ terminfo-0.4.0.0+ text-1.1.0.0+ transformers-0.3.0.0+ transformers-base-0.4.1+ transformers-compat-0.1.1.1+ unordered-containers-0.2.3.3+
lib/Penny.hs view
@@ -78,14 +78,14 @@ -- "Penny.Steel" - independent utilities. Depends on no other -- Penny components. --- -- "Penny.Wheat" - tools to use with- -- "Penny.Steel.Prednote". Depends on Steel, Lincoln, and Copper.+ -- "Penny.Wheat" - helping you build your own programs to check+ -- your ledger. Depends on Steel, Lincoln, and Copper. -- -- "Penny.Zinc" - the Penny command-line interface. Depends on -- Cabin, Copper, Liberty, and Lincoln. -- -- The dependencies are represented as a dot file in- -- bin/doc/dependencies.dot in the Penny git repository.+ -- @doc\/dependencies.dot@ in the Penny git repository. ) where import Data.Ord (comparing)@@ -109,8 +109,8 @@ import qualified Penny.Cabin.Posts.Meta as M import qualified Penny.Cabin.Scheme as E import qualified Penny.Copper as Cop-import Penny.Steel.Sums-import qualified Penny.Steel.Sums as Su+import Data.Sums+import qualified Data.Sums as Su import qualified Penny.Lincoln as L import qualified Data.Prednote.Expressions as Exp import qualified Penny.Zinc as Z
lib/Penny/Brenner.hs view
@@ -34,7 +34,7 @@ import qualified Penny.Brenner.Merge as M import qualified Penny.Brenner.OFX as O import qualified Penny.Brenner.Print as P-import qualified Penny.Steel.Sums as Su+import qualified Data.Sums as Su import qualified System.Console.MultiArg as MA import System.Environment (getProgName) import qualified System.Exit as Exit
lib/Penny/Brenner/Clear.hs view
@@ -11,7 +11,7 @@ import qualified System.Console.MultiArg as MA import qualified Penny.Lincoln as L import qualified Penny.Liberty as Ly-import qualified Penny.Steel.Sums as S+import qualified Data.Sums as S import qualified Control.Monad.Trans.State as St import qualified Control.Monad.Trans.Maybe as MT import Control.Monad.Trans.Class (lift)
lib/Penny/Brenner/Info.hs view
@@ -6,7 +6,7 @@ import qualified Data.Text.IO as TIO import Data.Monoid ((<>)) import qualified Penny.Lincoln as L-import qualified Penny.Steel.Sums as S+import qualified Data.Sums as S import qualified System.Console.MultiArg as MA help :: String -> String
lib/Penny/Brenner/Merge.hs view
@@ -16,7 +16,7 @@ import qualified Penny.Lincoln.Queries as Q import qualified Penny.Brenner.Types as Y import qualified Penny.Brenner.Util as U-import qualified Penny.Steel.Sums as S+import qualified Data.Sums as S type NoAuto = Bool
lib/Penny/Brenner/Types.hs view
@@ -34,7 +34,7 @@ import Data.Text (Text, pack, unpack) import qualified Data.Text.Encoding as E import qualified Data.Serialize as S-import qualified Penny.Steel.Sums as Su+import qualified Data.Sums as Su import qualified System.Console.MultiArg as MA -- | The type of all Brenner MultiArg modes.
lib/Penny/Cabin/Balance/Convert/Chunker.hs view
@@ -60,7 +60,7 @@ -> Columns PreSpec -> Columns R.Width maxWidthPerColumn w p = f <$> w <*> p where- f old new = max old (R.Width . X.length . Rb._text . bits $ new)+ f old new = max old (R.Width . X.length . Rb.text . bits $ new) -- | Changes a single set of Columns to a set of ColumnSpec of the -- given width.
lib/Penny/Cabin/Balance/Convert/ChunkerPct.hs view
@@ -61,7 +61,7 @@ -> Columns PreSpec -> Columns R.Width maxWidthPerColumn w p = f <$> w <*> p where- f old new = max old (R.Width . X.length . Rb._text . bits $ new)+ f old new = max old (R.Width . X.length . Rb.text . bits $ new) -- | Changes a single set of Columns to a set of ColumnSpec of the -- given width.
lib/Penny/Cabin/Balance/MultiCommodity/Chunker.hs view
@@ -63,7 +63,7 @@ -> Columns R.Width maxWidthPerColumn w p = f <$> w <*> p where f old new = max old ( safeMaximum (R.Width 0)- . map (R.Width . X.length . Rb._text)+ . map (R.Width . X.length . Rb.text) . bits $ new) safeMaximum d ls = if null ls then d else maximum ls
lib/Penny/Cabin/Posts/Growers.hs view
@@ -63,7 +63,7 @@ widestLine (PreSpec _ _ bs) = case bs of [] -> 0- xs -> maximum . map (X.length . Rb._text) $ xs+ xs -> maximum . map (X.length . Rb.text) $ xs data PreSpec = PreSpec { _justification :: R.Justification
lib/Penny/Cabin/Row.hs view
@@ -77,7 +77,7 @@ -> JustifiedCell justify (Width w) j l eo chgrs pc = JustifiedCell (left, right) where- origWidth = X.length . R._text $ pc+ origWidth = X.length . R.text $ pc pad = E.getEvenOddLabelValue l eo chgrs . R.Chunk mempty $ t t = X.replicate (max 0 (w - origWidth)) (X.singleton ' ') (left, right) = case j of
lib/Penny/Copper.hs view
@@ -90,7 +90,7 @@ import Control.Arrow (second) import qualified Data.Traversable as Tr import qualified Penny.Copper.Parsec as CP-import qualified Penny.Steel.Sums as S+import qualified Data.Sums as S import Penny.Copper.Interface import qualified Penny.Copper.Interface as I
lib/Penny/Copper/Interface.hs view
@@ -2,7 +2,7 @@ import qualified Penny.Lincoln as L import qualified Data.Text as X-import qualified Penny.Steel.Sums as S+import qualified Data.Sums as S data ParsedTopLine = ParsedTopLine { ptlDateTime :: L.DateTime
lib/Penny/Copper/Parsec.hs view
@@ -15,7 +15,7 @@ import Control.Monad (replicateM, when) import Data.List.NonEmpty (NonEmpty((:|))) import qualified Penny.Lincoln as L-import qualified Penny.Steel.Sums as S+import qualified Data.Sums as S import Data.Maybe (fromMaybe) import Data.Text (Text, pack) import qualified Data.Text as X
lib/Penny/Copper/Render.hs view
@@ -16,7 +16,7 @@ import qualified Data.Time as Time import qualified Penny.Copper.Interface as I import qualified Penny.Lincoln as L-import qualified Penny.Steel.Sums as S+import qualified Data.Sums as S -- * Helpers
+ lib/Penny/Denver.hs view
@@ -0,0 +1,6 @@+-- | Independent executables+--+-- Code for standalone executables is here. Modules in Denver may+-- depend on any other module in Penny. No module outside of Denver+-- has any dependencies on any Denver module.+module Penny.Denver where
+ lib/Penny/Denver/Diff.hs view
@@ -0,0 +1,195 @@+module Penny.Denver.Diff (main) where++import Control.Arrow (first, second)+import Data.Maybe (fromJust)+import Data.List (deleteFirstsBy)+import qualified System.Console.MultiArg as M+import qualified Penny.Liberty as Ly+import qualified Penny.Lincoln as L+import Penny.Lincoln ((==~))+import qualified Penny.Copper as C+import qualified Penny.Copper.Render as CR+import qualified Data.Sums as S+import Data.Maybe (mapMaybe)+import qualified Data.Text as X+import qualified Data.Text.IO as TIO+import qualified System.Exit as E+import qualified System.IO as IO++import qualified Paths_penny as PPB++main :: IO ()+main = runPennyDiff++help :: String -> String+help pn = unlines+ [ "usage: " ++ pn ++ " [-12] FILE1 FILE2"+ , "Shows items that exist in FILE1 but not in FILE2,"+ , "as well as items that exist in FILE2 but not in FILE1."+ , "Options:"+ , "-1 Show only items that exist in FILE1 but not in FILE2"+ , "-2 Show only items that exist in FILE2 but not in FILE1"+ , ""+ , "--help, -h - show this help and exit"+ , "--version Show version and exit"+ ]++data Args = ArgFile File | Filename String+ deriving (Eq, Show)++data DiffsToShow = File1Only | File2Only | BothFiles++optFile1 :: M.OptSpec Args+optFile1 = M.OptSpec [] "1" (M.NoArg (ArgFile File1))++optFile2 :: M.OptSpec Args+optFile2 = M.OptSpec [] "2" (M.NoArg (ArgFile File2))++allOpts :: [M.OptSpec Args]+allOpts = [ optFile1 , optFile2 ]++data File = File1 | File2+ deriving (Eq, Show)++-- | All possible items, but excluding blank lines.+type NonBlankItem =+ S.S3 L.Transaction L.PricePoint C.Comment++removeMeta+ :: L.Transaction+ -> (L.TopLineCore, L.Ents L.PostingCore)+removeMeta+ = first L.tlCore+ . second (fmap L.pdCore)+ . L.unTransaction++clonedNonBlankItem :: NonBlankItem -> NonBlankItem -> Bool+clonedNonBlankItem nb1 nb2 = case (nb1, nb2) of+ (S.S3a t1, S.S3a t2) -> removeMeta t1 ==~ removeMeta t2+ (S.S3b p1, S.S3b p2) -> p1 ==~ p2+ (S.S3c c1, S.S3c c2) -> c1 == c2+ _ -> False++toNonBlankItem :: C.LedgerItem -> Maybe NonBlankItem+toNonBlankItem = S.caseS4 (Just . S.S3a) (Just . S.S3b) (Just . S.S3c)+ (const Nothing)++showLineNum :: File -> Int -> X.Text+showLineNum f i = X.pack ("\n" ++ arrow ++ " " ++ show i ++ "\n")+ where+ arrow = case f of+ File1 -> "<=="+ File2 -> "==>"+++-- | Renders a transaction, along with a line showing what file it+-- came from and its line number. If there is a TransactionMemo, shows+-- the line number for the top line for that; otherwise, shows the+-- line number for the TopLine.+renderTransaction+ :: File+ -> L.Transaction+ -> Maybe X.Text+renderTransaction f t = fmap addHeader $ CR.transaction Nothing (noMeta t)+ where+ lin = case L.tMemo . L.tlCore . fst . L.unTransaction $ t of+ Nothing -> L.unTopLineLine . L.tTopLineLine . fromJust+ . L.tlFileMeta . fst . L.unTransaction $ t+ Just _ -> L.unTopMemoLine . fromJust . L.tTopMemoLine . fromJust+ . L.tlFileMeta . fst . L.unTransaction $ t+ addHeader x = (showLineNum f lin) `X.append` x+ noMeta txn = let (tl, es) = L.unTransaction txn+ in (L.tlCore tl, fmap L.pdCore es)++renderPrice :: File -> L.PricePoint -> Maybe X.Text+renderPrice f p = fmap addHeader $ CR.price p+ where+ lin = L.unPriceLine . fromJust . L.priceLine $ p+ addHeader x = (showLineNum f lin) `X.append` x++renderNonBlankItem+ :: File+ -> NonBlankItem+ -> Maybe X.Text+renderNonBlankItem f =+ S.caseS3 (renderTransaction f) (renderPrice f) CR.comment++runPennyDiff :: IO ()+runPennyDiff = do+ (f1, f2, dts) <- parseCommandLine+ l1 <- C.open [f1]+ l2 <- C.open [f2]+ let (r1, r2) = doDiffs l1 l2+ showDiffs dts (r1, r2)+ case (r1, r2) of+ ([], []) -> E.exitSuccess+ _ -> E.exitWith (E.ExitFailure 1)++showDiffs+ :: DiffsToShow+ -> ([NonBlankItem], [NonBlankItem])+ -> IO ()+showDiffs dts (l1, l2) =+ case dts of+ File1Only -> showFile1+ File2Only -> showFile2+ BothFiles -> showFile1 >> showFile2+ where+ showFile1 = showNonBlankItems File1 l1+ showFile2 = showNonBlankItems File2 l2++failure :: String -> IO a+failure s = IO.hPutStrLn IO.stderr s+ >> E.exitWith (E.ExitFailure 2)++showNonBlankItems+ :: File+ -> [NonBlankItem]+ -> IO ()+showNonBlankItems f ls =+ mapM_ (showNonBlankItem f) ls++showNonBlankItem+ :: File+ -> NonBlankItem+ -> IO ()+showNonBlankItem f nbi = maybe e TIO.putStr+ (renderNonBlankItem f nbi)+ where+ e = failure $ "could not render item: " ++ show nbi+++-- | Returns a pair p, where fst p is the items that appear in file1+-- but not in file2, and snd p is items that appear in file2 but not+-- in file1.+doDiffs+ :: [C.LedgerItem]+ -> [C.LedgerItem]+ -> ([NonBlankItem], [NonBlankItem])+doDiffs l1 l2 = (r1, r2)+ where+ mkNbList = mapMaybe toNonBlankItem+ (nb1, nb2) = (mkNbList l1, mkNbList l2)+ df = deleteFirstsBy clonedNonBlankItem+ (r1, r2) = (nb1 `df` nb2, nb2 `df` nb1)++-- | Returns a tuple with the first filename, the second filename, and+-- an indication of which differences to show.+parseCommandLine :: IO (String, String, DiffsToShow)+parseCommandLine = do+ as <- M.simpleHelpVersion help (Ly.version PPB.version)+ allOpts M.Intersperse+ (return . Filename)+ let toFilename a = case a of+ Filename s -> Just s+ _ -> Nothing+ (fn1, fn2) <- case mapMaybe toFilename as of+ x:y:[] -> return (x, y)+ _ -> failure "penny-diff: error: you must supply two filenames."+ let getDiffs+ | ((ArgFile File1) `elem` as)+ && ((ArgFile File2) `elem` as) = BothFiles+ | ((ArgFile File1) `elem` as) = File1Only+ | ((ArgFile File2) `elem` as) = File2Only+ | otherwise = BothFiles+ return (fn1, fn2, getDiffs)
+ lib/Penny/Denver/Reconcile.hs view
@@ -0,0 +1,76 @@+module Penny.Denver.Reconcile (main) where++import Data.Either (partitionEithers)+import Data.Maybe (fromMaybe, fromJust)+import qualified Data.Text as X+import Control.Monad (guard)+import qualified Penny.Copper as C+import qualified Penny.Lincoln as L+import qualified Penny.Liberty as Ly+import qualified Data.Sums as S+import qualified System.Console.MultiArg as MA+import qualified Paths_penny as PPB+++-- | Changes a posting to mark it reconciled, if it was already marked+-- as cleared.+changePosting :: L.PostingData -> L.PostingData+changePosting p = fromMaybe p $ do+ let c = L.pdCore p+ fl <- L.pFlag c+ guard (L.unFlag fl == X.singleton 'C')+ let fl' = L.Flag . X.singleton $ 'R'+ c' = c { L.pFlag = Just fl' }+ return p { L.pdCore = c' }++-- | Changes a TopLine to mark it as reconciled, if it was already+-- marked as cleared.+changeTopLine :: L.TopLineData -> L.TopLineData+changeTopLine t = fromMaybe t $ do+ let c = L.tlCore t+ fl <- L.tFlag c+ guard (L.unFlag fl == X.singleton 'C')+ let fl' = L.Flag . X.singleton $ 'R'+ c' = c { L.tFlag = Just fl' }+ return t { L.tlCore = c' }++changeTransaction :: L.Transaction -> L.Transaction+changeTransaction (L.Transaction (tl, es)) =+ L.Transaction (changeTopLine tl, fmap changePosting es)++help :: String -> String+help pn = unlines+ [ "usage: " ++ pn ++ " [options] FILE..."+ , "Finds all transactions and postings bearing a \"C\" flag"+ , "and changes them to a \"R\" flag in the listed FILEs."+ , "If no FILE, or if FILE is -, read standard input."+ , ""+ , "Output is printed to standard output. Input files are not"+ , "changed."+ , ""+ , "Options:"+ , " --output FILENAME, -o FILENAME"+ , " send output to FILENAME rather than standard output"+ , " (multiple -o options are allowed; use \"-\" for standard"+ , " output)"+ , " -h, --help - Show help and exit."+ , " --version - Show version and exit"+ ]++type Printer = X.Text -> IO ()+type PosArg = String+type Arg = Either Printer PosArg++allOpts :: [MA.OptSpec Arg]+allOpts = [ fmap Left Ly.output ]++main :: IO ()+main = do+ as <- MA.simpleHelpVersion help (Ly.version PPB.version)+ allOpts MA.Intersperse (return . Right)+ let (printers, posArgs) = partitionEithers as+ led <- C.open posArgs+ let led' = map (S.mapS4 changeTransaction id id id) led+ rend = fromJust $ mapM (C.item Nothing) (map C.stripMeta led')+ let txt = X.concat rend in txt `seq` (Ly.processOutput printers txt)+
+ lib/Penny/Denver/Reprint.hs view
@@ -0,0 +1,52 @@+module Penny.Denver.Reprint (main) where++import Data.Either (partitionEithers)+import qualified Penny.Copper as C+import qualified Penny.Copper.Render as R+import qualified Penny.Liberty as Ly+import qualified Data.Text as X+import qualified System.Console.MultiArg as MA++import qualified Paths_penny as PPB++help :: String -> String+help pn = unlines+ [ "usage: " ++ pn ++ " FILE..."+ , "Tidies the formatting of a Penny ledger file."+ , "All memos, comments, and blank lines are preserved,"+ , "and the order of the transactions and postings is not changed."+ , "However, the whitespace that separates different elements"+ , "of a posting will change in order to tidy things up."+ , ""+ , "If no FILE, or if FILE is \"-\", read stanard input."+ , "Result is printed to standard output."+ , ""+ , "Options:"+ , " --output FILENAME, -o FILENAME"+ , " send output to FILENAME rather than standard output"+ , " (multiple -o options are allowed; use \"-\" for standard"+ , " output)"+ , " --help, -h - show help and exit"+ , " --version - show version and exit"+ ]++type Printer = X.Text -> IO ()+type PosArg = String++type Arg = Either Printer PosArg++allOpts :: [MA.OptSpec Arg]+allOpts = [ fmap Left Ly.output ]++main :: IO ()+main = do+ as <- MA.simpleHelpVersion help (Ly.version PPB.version)+ allOpts MA.Intersperse+ (return . Right)+ let (printers, posArgs) = partitionEithers as+ l <- C.open posArgs+ case mapM (R.item Nothing) (map C.stripMeta l) of+ Nothing -> error "could not render final ledger."+ Just x ->+ let txt = X.concat x+ in txt `seq` (Ly.processOutput printers txt)
+ lib/Penny/Denver/Selloff.hs view
@@ -0,0 +1,618 @@+-- | The selloff binary++module Penny.Denver.Selloff (main) where++import Control.Arrow (first)+import Control.Applicative ((<$>), (<*>), pure)+import Control.Monad (when)+import qualified Control.Monad.Trans.Either as Ei+import qualified Control.Monad.Trans.State as St+import Control.Monad.Trans.Class (lift)+import Data.List (find)+import Data.Maybe (isJust, mapMaybe, catMaybes, fromMaybe)+import Data.Text (pack)+import qualified Data.Text as X+import qualified Data.Text.IO as TIO+import qualified Penny.Lincoln.Balance as Bal+import qualified Data.Sums as S+import qualified Penny.Cabin.Balance.Util as BU+import Penny.Cabin.Options (ShowZeroBalances(..))+import qualified Penny.Copper as Cop+import qualified Penny.Copper.Parsec as CP+import qualified Penny.Copper.Render as CR+import qualified Penny.Liberty as Ly+import qualified Penny.Lincoln as L+import qualified Data.Map as M+import qualified System.Console.MultiArg as MA+import qualified Text.Parsec as Parsec+import qualified Paths_penny as PPB+import qualified Penny as P++-- Steps++-- * In IO monad: read values given on command line.++-- * Parse command line. Fails if command line fails to parse.++-- * If help is requested, show help and exit successfully.++-- * In IO monad: read text of files given on command line. Fails if+-- there is an IO failure.++-- * Parse files given on command line. Fails if files fail to parse.++-- * Calculate balances of all accounts. Remove zero balances. This+-- step never fails.++-- * Find Proceeds account specified on command line. Split it into a+-- group name (the second sub-account) and a selloff label (the third+-- sub-account). Obtain the SelloffStockAmt, which is the debit+-- balance, and the SelloffCurrencyAmt, which is the credit+-- balance. Fails if the Proceeds account does not have exactly three+-- sub-accounts, or if the account does not have a balance with+-- exactly one debit balance and exactly one credit balance. Returns a+-- record with the group name, the selloff label, the selloff currency+-- amount, and the selloff stock amount. (Remember, an amount is a Qty+-- and a Commodity.)++-- * Filter account balances to find all Basis accounts with a+-- matching group name. Only accounts that have Basis as the first+-- sub-account AND a matching group name as the second sub-account are+-- further analyzed; all other accounts are discarded. Returns a list+-- of matching accounts, but only with a list of remaining+-- sub-accounts after the first and second sub-accounts, and the+-- balances of these accounts. This computation does not fail.++-- * For each basis account, parse out the purchase information. This+-- consists of a DateTime, which is the time of the purchase; the Qty+-- of stock purchased; and the Qty of currency paid for the+-- stock. Returns this information in a record. Fails if the basis+-- account does not have exactly two commodities in its balance, or if+-- there is not a credit balance matching the stock commodity, or if+-- there is not a debit balance matching the currency commodity, or if+-- the basis account has more than one remaining sub-account; or if+-- the DateTime cannot be parsed.++-- * For each basis account, compute the basis realization+-- information. First sort the basis accounts with the earliest+-- accounts coming first. Then for each account calculate how many+-- shares to debit and how much currency to credit. Do this in a+-- stateful transforming function that will transform the purchase+-- information into a pair with basis realization information and+-- purchase information. The state contains the number of shares+-- remaining that need to have their basis realized, and the total+-- cost of realized shares.++-- To calculate each basis realization, compare the number of shares+-- purchased with the number still remaining to be realized. If the+-- number purchased is less than or equal to the number remaining to+-- be realized, return a basis realization that realizes all the+-- shares purchased. If the number of shares purchased is more than+-- the number still remaining to be realized, then realize all the+-- shares that still need to be realized, and credit the cost+-- proportionally. If there are no shares remaining to be realized,+-- return no realization information at all.++-- Returns a list of pairs of basis realizations and purchase+-- information; purchases that have no basis realizations are+-- discarded. Also returns the total cost of shares sold. Fails if+-- there are still shares that have not had their basis realized+-- (i.e. the number of shares in the Proceeds account is greater than+-- the number of shares in the selloff group.)++-- * Compute the capital gain or loss. Take the difference between the+-- selloff currency quantity and the cost of shares sold. If the+-- selloff currency quantity is greater, there is a capital+-- gain. Record credits to an Income:Capital Gain account. If the cost+-- of shares sold is greater, there is a capital loss. Record debits+-- to an Expenses:Capital Loss account. To calculate the gain or loss+-- per purchase transaction, use the allocate function in the Qty+-- module. The target total is the total capital gain or loss, and+-- each allocation is the number of shares purchased in each+-- account. Returns a list of quantities (one for each capital gain or+-- loss, which corresponds to each purchase account) and an indication+-- of whether there was a capital gain or loss (this need only be+-- reported once.) Fails if the allocation fails.++-- * Create output transaction. This never fails (if it does, it is a+-- programmer error; just apply error.)++-- * In IO monad: Print output transaction.++type Err = Either Error++data Error+ = ParseFail MA.Error+ | NoInputArgs+ | ProceedsParseFailed Parsec.ParseError+ | NoSelloffAccount+ | NotThreeSelloffSubAccounts+ | BadSelloffBalance+ | BadPurchaseBalance+ | BadPurchaseDate Parsec.ParseError+ | NotThreePurchaseSubAccounts [L.SubAccount]+ | BasisAllocationFailed+ | ZeroCostSharesSold+ | InsufficientSharePurchases+ | NoPurchaseInformation+ | SaleDateParseFailed Parsec.ParseError+ deriving Show++data ProceedsAcct = ProceedsAcct { _unProceedsAcct :: L.Account }+ deriving Show++newtype InputFilename = InputFilename { _unInputFilename :: String }+ deriving (Eq, Show)++data ParseResult = ParseResult ProceedsAcct [Cop.LedgerItem]++parseCommandLine :: IO ParseResult+parseCommandLine = do+ as <- MA.simpleHelpVersion help (Ly.version PPB.version)+ [] MA.Intersperse return+ x:xs <- case as of+ [] -> fail (show NoInputArgs)+ r -> return r+ a <- either (fail . show . ProceedsParseFailed) return+ $ Parsec.parse CP.lvl1Acct "" (pack x)+ l <- Cop.open xs+ return $ ParseResult (ProceedsAcct a) l+++help :: String -> String+help pn = unlines+ [ "usage: " ++ pn ++ " PROCEEDS_ACCOUNT FILE..."+ , "calculate capital gains and losses from commodity sales."+ , "Options:"+ , " -h, --help - show this help and exit."+ , " --version - show version and exit."+ ]++calcBalances :: [Cop.LedgerItem] -> [(L.Account, L.Balance)]+calcBalances+ = BU.flatten+ . BU.balances (ShowZeroBalances False)+ . map (\p -> ((), p))+ . concatMap L.transactionToPostings+ . mapMaybe (S.caseS4 Just (const Nothing) (const Nothing)+ (const Nothing))++newtype Group = Group { unGroup :: L.SubAccount }+ deriving (Show, Eq)++newtype SaleDate = SaleDate { unSaleDate :: L.DateTime }+ deriving (Show, Eq)++newtype SelloffStock = SelloffStock { unSelloffStock :: L.Amount L.Qty }+ deriving (Show, Eq)++newtype SelloffCurrency+ = SelloffCurrency { unSelloffCurrency :: L.Amount L.Qty }+ deriving (Show, Eq)++data SelloffInfo = SelloffInfo+ { siGroup :: Group+ , siSaleDate :: SaleDate+ , siStock :: SelloffStock+ , siCurrency :: SelloffCurrency+ } deriving Show++selloffInfo+ :: ProceedsAcct -> [(L.Account, L.Balance)] -> Err SelloffInfo+selloffInfo (ProceedsAcct pa) bals = do+ bal <- fmap snd+ . maybe (Left NoSelloffAccount) Right+ . find ((== pa) . fst)+ $ bals+ (g, d) <- case L.unAccount pa of+ _ : s2 : s3 : [] -> return (s2, s3)+ _ -> Left NotThreeSelloffSubAccounts+ (sStock, sCurr) <- selloffStockCurr bal+ date <- fmap SaleDate+ . either (Left . SaleDateParseFailed) Right+ . Parsec.parse CP.dateTime ""+ $ (L.text d)+ return $ SelloffInfo (Group g) date sStock sCurr++selloffStockCurr :: L.Balance -> Err (SelloffStock, SelloffCurrency)+selloffStockCurr bal = do+ let m = L.unBalance bal+ when (M.size m /= 2) $ Left BadSelloffBalance+ let toPair (cy, bl) = case bl of+ Bal.Zero -> Nothing+ Bal.NonZero col -> Just (cy, col)+ ps = mapMaybe toPair . M.toList $ m+ findBal dc = maybe (Left BadSelloffBalance) Right+ . find ((== dc) . Bal.colDrCr . snd)+ $ ps+ (cyStock, (Bal.Column _ qtyStock)) <- findBal L.Debit+ (cyCurr, (Bal.Column _ qtyCurr)) <- findBal L.Credit+ let sellStock = SelloffStock+ (L.Amount qtyStock cyStock)+ sellCurr = SelloffCurrency+ (L.Amount qtyCurr cyCurr)+ return (sellStock, sellCurr)+++basis :: L.SubAccount+basis = L.SubAccount . pack $ "Basis"++findBasisAccounts+ :: Group+ -> [(L.Account, L.Balance)]+ -> [([L.SubAccount], L.Balance)]+findBasisAccounts (Group g) = mapMaybe f+ where+ f ((L.Account a), b) = case a of+ s0 : s1 : s2 : ss -> if (s0 == basis) && (s1 == g)+ then Just (s2:ss, b) else Nothing+ _ -> Nothing+++data PurchaseDate = PurchaseDate { unPurchaseDate :: L.DateTime }+ deriving Show++data PurchaseStockQty+ = PurchaseStockQty { unPurchaseStockQty :: L.Qty }+ deriving (Eq, Show)++data PurchaseCurrencyQty+ = PurchaseCurrencyQty { unPurchaseCurrencyQty :: L.Qty }+ deriving (Eq, Show)++data PurchaseInfo = PurchaseInfo+ { piDate :: PurchaseDate+ , piStockQty :: PurchaseStockQty+ , piCurrencyQty :: PurchaseCurrencyQty+ } deriving Show++purchaseInfo+ :: SelloffStock+ -> SelloffCurrency+ -> ([L.SubAccount], L.Balance)+ -> Err PurchaseInfo+purchaseInfo sStock sCurr (ss, bal) = do+ dateSub <- case ss of+ s1:[] -> return s1+ _ -> Left $ NotThreePurchaseSubAccounts ss+ date <- either (Left . BadPurchaseDate) Right+ . Parsec.parse CP.dateTime ""+ . L.text+ $ dateSub+ (stockQty, currQty) <- purchaseQtys sStock sCurr bal+ return $ PurchaseInfo (PurchaseDate date) stockQty currQty++purchaseQtys+ :: SelloffStock+ -> SelloffCurrency+ -> L.Balance+ -> Err (PurchaseStockQty, PurchaseCurrencyQty)+purchaseQtys (SelloffStock sStock) (SelloffCurrency sCurr) bal = do+ let m = L.unBalance bal+ when (M.size m /= 2) $ Left BadPurchaseBalance+ let toPair (cy, bl) = case bl of+ Bal.Zero -> Nothing+ Bal.NonZero col -> Just (cy, col)+ ps = mapMaybe toPair . M.toList $ m+ findBal dc = maybe (Left BadPurchaseBalance) Right+ . find ((== dc) . Bal.colDrCr . snd)+ $ ps+ (cyStock, (Bal.Column _ qtyStock)) <- findBal L.Credit+ (cyCurr, (Bal.Column _ qtyCurr)) <- findBal L.Debit+ when (cyStock /= L.commodity sStock) $ Left BadPurchaseBalance+ when (cyCurr /= L.commodity sCurr) $ Left BadPurchaseBalance+ return (PurchaseStockQty qtyStock, PurchaseCurrencyQty qtyCurr)+++newtype RealizedStockQty+ = RealizedStockQty { unRealizedStockQty :: L.Qty }+ deriving (Eq, Show)++newtype RealizedCurrencyQty+ = RealizedCurrencyQty { unRealizedCurrencyQty :: L.Qty }+ deriving (Eq, Show)++newtype CostSharesSold+ = CostSharesSold { unCostSharesSold :: L.Qty }+ deriving (Eq, Show)++newtype StillToRealize+ = StillToRealize { _unStillToRealize :: L.Qty }+ deriving (Eq, Show)++data BasisRealiztn = BasisRealiztn+ { brStockQty :: RealizedStockQty+ , brCurrencyQty :: RealizedCurrencyQty+ } deriving Show++-- | Realize an individual purchase account's basis. Fails if the+-- basis cannot be allocated.+stRealizeBasis+ :: PurchaseInfo+ -> Ei.EitherT Error+ (St.State (Maybe CostSharesSold, Maybe StillToRealize))+ (Maybe (PurchaseInfo, BasisRealiztn))+stRealizeBasis p = do+ mayTr <- lift $ St.gets snd+ case mayTr of+ Nothing -> return Nothing+ Just (StillToRealize tr) -> do+ let sq = unPurchaseStockQty . piStockQty $ p+ pcq = unPurchaseCurrencyQty . piCurrencyQty $ p+ mayCss <- lift $ St.gets fst+ case L.difference tr sq of++ L.LeftBiggerBy tr' -> do+ let br = BasisRealiztn (RealizedStockQty sq)+ (RealizedCurrencyQty pcq)+ css' = case mayCss of+ Nothing -> CostSharesSold pcq+ Just (CostSharesSold css) ->+ CostSharesSold (L.add pcq css)+ lift $ St.put (Just css', Just (StillToRealize tr'))+ return (Just (p, br))++ L.RightBiggerBy unsoldStockQty -> do+ let alloced = L.allocate pcq (sq, [unsoldStockQty])+ basisSold = case alloced of+ (x, (_ : [])) -> x+ _ -> error "stRealizeBasis: error"+ let css' = case mayCss of+ Nothing -> CostSharesSold basisSold+ Just (CostSharesSold css) ->+ CostSharesSold (L.add basisSold css)+ br = BasisRealiztn (RealizedStockQty tr)+ (RealizedCurrencyQty basisSold)+ lift $ St.put (Just css', Nothing)+ return (Just (p, br))++ L.Equal -> do+ let br = BasisRealiztn (RealizedStockQty sq)+ (RealizedCurrencyQty pcq)+ css' = case mayCss of+ Nothing -> CostSharesSold pcq+ Just (CostSharesSold css) ->+ CostSharesSold (L.add css pcq)+ lift $ St.put (Just css', Nothing)+ return (Just (p, br))++realizeBases+ :: SelloffStock+ -> [PurchaseInfo]+ -> Err ([(PurchaseInfo, BasisRealiztn)], CostSharesSold)+realizeBases sellStck ps = do+ let stReal = Just . StillToRealize . L.qty+ . unSelloffStock $ sellStck+ (exRs, (mayCss, mayTr)) = St.runState+ (Ei.runEitherT (mapM stRealizeBasis ps))+ (Nothing, stReal)+ rs <- exRs+ when (isJust mayTr) $ Left InsufficientSharePurchases+ css <- maybe (Left ZeroCostSharesSold) Right mayCss+ return (catMaybes rs, css)++newtype CapitalChange = CapitalChange { unCapitalChange :: L.Qty }+ deriving Show++data WithCapitalChanges+ = WithCapitalChanges [(PurchaseInfo, BasisRealiztn, CapitalChange)]+ GainOrLoss+ | NoChange [(PurchaseInfo, BasisRealiztn)]+ deriving Show++data GainOrLoss = Gain | Loss deriving (Eq, Show)++capitalChange+ :: CostSharesSold+ -> SelloffCurrency+ -> [(PurchaseInfo, BasisRealiztn)]+ -> Err WithCapitalChanges+capitalChange css sc ls =+ let sellCurrQty = L.qty . unSelloffCurrency $ sc+ costQty = unCostSharesSold css+ mayGainLoss =+ case L.difference sellCurrQty costQty of+ L.LeftBiggerBy q -> Just (q, Gain)+ L.RightBiggerBy q -> Just (q, Loss)+ L.Equal -> Nothing+ in case mayGainLoss of+ Nothing -> return . NoChange $ ls+ Just (qt, gl) -> do+ nePurchs <- maybe (Left NoPurchaseInformation) Right+ . uncons $ ls+ let qtys = mapNE (unPurchaseCurrencyQty . piCurrencyQty . fst)+ nePurchs+ alloced = L.allocate qt qtys+ let mkCapChange (p, br) q = (p, br, CapitalChange q)+ r = flattenNE $ zipNE mkCapChange nePurchs alloced+ return $ WithCapitalChanges r gl++mapNE :: (a -> b) -> (a, [a]) -> (b, [b])+mapNE f (a, as) = (f a, map f as)++flattenNE :: (a, [a]) -> [a]+flattenNE (a, as) = a:as++uncons :: [a] -> Maybe (a, [a])+uncons as = case as of+ [] -> Nothing+ x:xs -> Just (x, xs)++zipNE :: (a -> b -> c) -> (a, [a]) -> (b, [b]) -> (c, [c])+zipNE f (a, as) (b, bs) = (f a b, zipWith f as bs)++memo :: SaleDate -> L.Memo+memo (SaleDate sd) =+ let dTxt = CR.dateTime sd+ txt = pack "transaction created by penny-selloff for sale on "+ `X.append` dTxt+ in L.Memo [txt]++payee :: L.Payee+payee = L.Payee . pack $ "Realize gain or loss"++topLine :: SaleDate -> L.TopLineData+topLine sd =+ let core = (L.emptyTopLineCore (unSaleDate sd))+ { L.tPayee = Just payee+ , L.tMemo = Just . memo $ sd+ }+ in L.TopLineData { L.tlCore = core+ , L.tlFileMeta = Nothing+ , L.tlGlobal = Nothing }++basisOffsets+ :: SelloffInfo+ -> PurchaseDate+ -> BasisRealiztn+ -> ((L.Entry L.Qty, L.PostingData), (L.Entry L.Qty, L.PostingData))+basisOffsets s pd p = (po enDr, po enCr)+ where+ ac = L.Account [basis, grp, dt]+ grp = unGroup . siGroup $ s+ dt = dateToSubAcct . unPurchaseDate $ pd+ enDr = L.Entry L.Debit+ (L.Amount (unRealizedStockQty . brStockQty $ p)+ (L.commodity . unSelloffStock . siStock $ s))+ enCr = L.Entry L.Credit+ (L.Amount (unRealizedCurrencyQty . brCurrencyQty $ p)+ (L.commodity . unSelloffCurrency . siCurrency $ s))+ po en = (en, emptyPostingData ac)++emptyPostingData :: L.Account -> L.PostingData+emptyPostingData a =+ let core = (L.emptyPostingCore a)+ { L.pSide = Just L.CommodityOnLeft+ , L.pSpaceBetween = Just L.SpaceBetween+ }+ in L.PostingData { L.pdCore = core+ , L.pdFileMeta = Nothing+ , L.pdGlobal = Nothing+ }++dateToSubAcct :: L.DateTime -> L.SubAccount+dateToSubAcct = L.SubAccount . CR.dateTime++income :: L.SubAccount+income = L.SubAccount . pack $ "Income"++capGain :: L.SubAccount+capGain = L.SubAccount . pack $ "Capital Gain"++expense :: L.SubAccount+expense = L.SubAccount . pack $ "Expenses"++capLoss :: L.SubAccount+capLoss = L.SubAccount . pack $ "Capital Loss"++capChangeAcct+ :: GainOrLoss+ -> SelloffInfo+ -> PurchaseInfo+ -> L.Account+capChangeAcct gl si p = L.Account $ case gl of+ Gain -> [income, capGain, grp, sd, pd]+ Loss -> [expense, capLoss, grp, sd, pd]+ where+ grp = unGroup . siGroup $ si+ sd = dateToSubAcct . unSaleDate . siSaleDate $ si+ pd = dateToSubAcct . unPurchaseDate . piDate $ p++capChangeEntry+ :: GainOrLoss+ -> SelloffCurrency+ -> CapitalChange+ -> L.Entry L.Qty+capChangeEntry gl sc cc = L.Entry dc (L.Amount qt cy)+ where+ dc = case gl of+ Gain -> L.Credit+ Loss -> L.Debit+ cy = L.commodity . unSelloffCurrency $ sc+ qt = unCapitalChange cc++capChangePstg+ :: SelloffInfo+ -> GainOrLoss+ -> CapitalChange+ -> PurchaseInfo+ -> (L.Entry L.Qty, L.PostingData)+capChangePstg si gl cc p = (en, emptyPostingData ac)+ where+ ac = capChangeAcct gl si p+ en = capChangeEntry gl (siCurrency si) cc++proceeds :: L.SubAccount+proceeds = L.SubAccount . pack $ "Proceeds"++proceedsPstgs+ :: SelloffInfo+ -> ((L.Entry L.Qty, L.PostingData), (L.Entry L.Qty, L.PostingData))+proceedsPstgs si = (po dr, po cr)+ where+ po en = (en, emptyPostingData ac)+ ac = L.Account [proceeds, gr, dt]+ gr = unGroup . siGroup $ si+ dt = dateToSubAcct . unSaleDate . siSaleDate $ si+ dr = L.Entry L.Debit (unSelloffCurrency . siCurrency $ si)+ cr = L.Entry L.Credit (unSelloffStock . siStock $ si)+++mkTxn+ :: SelloffInfo+ -> WithCapitalChanges+ -> L.Transaction+mkTxn si wcc = fromMaybe err exTxn+ where+ err = error "mkTxn: making transaction failed"+ exTxn = (\topl es -> L.Transaction (topl, es))+ <$> pure tl <*> L.ents entInputs+ tl = topLine . siSaleDate $ si+ (p1, p2) = proceedsPstgs si+ ps = case wcc of+ NoChange infoRlzns -> concatMap f infoRlzns+ where+ f (p, br) =+ let (b1, b2) = basisOffsets si (piDate p) br+ in [b1, b2]+ WithCapitalChanges trips gl -> concatMap f trips+ where+ f (p, br, cc) = [b1, b2, c]+ where+ (b1, b2) = basisOffsets si (piDate p) br+ c = capChangePstg si gl cc p+ entInputs = map (first (Just . Right)) (p1:p2:ps)++makeOutput+ :: ProceedsAcct+ -> [Cop.LedgerItem]+ -> Err X.Text+makeOutput pa ldgr = do+ let bals = calcBalances ldgr+ formatter = P.getQtyFormat defaultRadGroup ldgr+ si <- selloffInfo pa bals+ let basisAccts = findBasisAccounts (siGroup si) bals+ purchInfos <- mapM (purchaseInfo (siStock si) (siCurrency si))+ basisAccts+ (purchBases, css) <- realizeBases (siStock si) purchInfos+ wcc <- capitalChange css (siCurrency si) purchBases+ return+ . (`X.snoc` '\n')+ . fromMaybe (error "makeOutput: transaction did not render")+ . (CR.transaction (Just formatter))+ . (\t -> let (tl, es) = L.unTransaction t+ in (L.tlCore tl, fmap L.pdCore es))+ . mkTxn si+ $ wcc+++main :: IO ()+main = parseCommandLine >>= handleParseResult+++handleParseResult :: ParseResult -> IO ()+handleParseResult (ParseResult pa ldgr) =+ either (error . show) TIO.putStr . makeOutput pa $ ldgr++defaultRadGroup :: S.S3 L.Radix L.PeriodGrp L.CommaGrp+defaultRadGroup = S.S3a L.Period
lib/Penny/Lincoln/Bits/Qty.hs view
@@ -1,7 +1,45 @@ {-# LANGUAGE OverloadedStrings #-}+ -- | Penny quantities. A quantity is simply a count (possibly -- fractional) of something. It does not have a commodity or a -- Debit/Credit.+--+-- Quantities are always greater than zero, even if infinitesimally so.+--+-- There are two main types in this module: a quantity representation,+-- or 'QtyRep', and a quantity, or 'Qty'. To understand the+-- difference, consider these numbers:+--+-- > 1364.25+-- > 1,364.25+-- > 1 364.25+-- > 1.364,25+-- > 1364,25+--+-- These are all different ways to represent the same quantity. Each+-- is a different quantity representation, or 'QtyRep'. A 'QtyRep'+-- stores information about each digit, each digit grouping character+-- (which may be a comma, thin space, or period) and the radix point,+-- if present (which may be a period or a comma.)+--+-- A 'QtyRep' can be converted to a 'Qty' with 'toQty'. A 'Qty' is a+-- quantity stripped of attributes related to its representation. No+-- floating point types are in a 'Qty'; internally, a 'Qty' consists+-- of an integral significand and an integer representing the number+-- of decimal places. Though each 'QtyRep' is convertible to one and+-- only one 'Qty', a single 'Qty' can correspond to several 'QtyRep'.+-- For example, each of the quantity representations shown above would+-- return identical 'Qty' after being converted with 'toQty'.+--+-- You can only perform arithmetic using 'Qty', not 'QtyRep'. You can+-- add or multiply 'Qty', which yields the result you would expect.+-- You cannot perform ordinary subtraction on 'Qty', as this might+-- yield a result which is less than or equal to zero; remember that+-- 'Qty' and 'QtyRep' are always greater than zero, even if+-- infinitesimally so. Instead, 'difference' will tell you if there+-- is a difference between two 'Qty' and, if so, which is greater and+-- by how much.+ module Penny.Lincoln.Bits.Qty ( -- * Quantity representations@@ -40,7 +78,7 @@ , showQtyRep , bestRadGroup - -- * Other stuff+ -- * Qty , Qty , HasQty(..) , signif@@ -49,12 +87,16 @@ , newQty , Signif , Places++ -- ** Arithmetic , add , mult , divide , Difference(LeftBiggerBy, RightBiggerBy, Equal) , difference , allocate++ -- * Integer allocations , TotSeats , PartyVotes , SeatsWon@@ -79,7 +121,7 @@ import Data.Monoid ((<>)) import qualified Penny.Lincoln.Equivalent as Ev import Penny.Lincoln.Equivalent (Equivalent(..))-import qualified Penny.Steel.Sums as S+import qualified Data.Sums as S data Digit = D0 | D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9 deriving (Eq, Ord, Show, Enum, Bounded)@@ -104,6 +146,8 @@ -- ^ Period deriving (Eq, Show, Ord, Enum, Bounded) +-- | Converting a type that represents a digit grouping character to+-- the underlying character itself. class Grouper a where groupChar :: a -> Char @@ -189,6 +233,9 @@ { unWholeOrFrac :: Either (WholeOnly a) (WholeFrac a) } deriving (Eq, Show, Ord) +type WholeOrFracResult a = Either (WholeOrFrac DigitList)+ (WholeOrFrac (GroupedDigits a))+ wholeOrFrac :: GroupedDigits a -- ^ What's before the radix point@@ -196,8 +243,7 @@ -> Maybe (GroupedDigits a) -- ^ What's after the radix point (if anything) - -> Maybe (Either (WholeOrFrac DigitList)- (WholeOrFrac (GroupedDigits a)))+ -> Maybe (WholeOrFracResult a) wholeOrFrac g@(GroupedDigits l1 lr) mayAft = case mayAft of Nothing -> case lr of [] -> fmap (Left . WholeOrFrac . Left) $ wholeOnly l1@@ -210,9 +256,6 @@ data Radix = Period | Comma deriving (Eq, Show, Ord, Enum, Bounded) -type WholeOrFracResult a = Either (WholeOrFrac DigitList)- (WholeOrFrac (GroupedDigits a))- wholeOrFracToQtyRep :: Either (WholeOrFracResult PeriodGrp) (WholeOrFracResult CommaGrp) -> QtyRep@@ -526,27 +569,23 @@ -- debit whose quantity is zero? Does it require a balancing credit -- that is also zero? And how can you have a debit of zero anyway? ----- I can imagine situations where a quantity of zero might be useful;--- for instance maybe you want to specifically indicate that a--- particular posting in a transaction did not happen (for instance,--- that a paycheck deduction did not take place). I think the better--- way to handle that though would be through an addition to--- Debit\/Credit - maybe Debit\/Credit\/Zero. Barring the addition of--- that, though, the best way to indicate a situation such as this--- would be through transaction memos.--- -- /WARNING/ - before doing comparisons or equality tests -- -- The Eq instance is derived. Therefore q1 == q2 only if q1 and q2--- have both the same significand and the same exponent. You may instead--- want 'equivalent'. Similarly, the Ord instance is derived. It--- compares based on the integral value of the significand and of the--- exponent. You may instead want 'compareQty', which compares after--- equalizing the exponents.-data Qty = Qty { signif :: !Integer- , places :: !Integer- } deriving (Eq, Show, Ord)+-- have both the same significand and the same number of places. You+-- may instead want 'equivalent'. Similarly, the Ord instance is+-- derived. It compares based on the integral value of the significand+-- and of the exponent. You may instead want 'compareQty', which+-- compares after equalizing the exponents.+data Qty = Qty+ { signif :: !Integer+ -- ^ The significand. + , places :: !Integer+ -- ^ The number of decimal places. For instance, in @1.500@, the+ -- significand is 1500 and the number of places is 3.+ } deriving (Eq, Show, Ord)+ instance Ev.Equivalent Qty where equivalent x y = x' == y' where@@ -563,6 +602,8 @@ qtyOne = Qty 1 0 +-- | Ensures that the significand is greater than zero and the number+-- of decimal places is at least zero. newQty :: Signif -> Places -> Maybe Qty newQty m p | m > 0 && p >= 0 = Just $ Qty m p@@ -578,8 +619,8 @@ (q1', q2') = equalizeExponents q1 q2 --- | Adjust the exponents on two Qty so they are equivalent--- before, but now have the same exponent.+-- | Adjust the exponents on two Qty so they are equivalent to what+-- they were before, but now have the same exponent. equalizeExponents :: Qty -> Qty -> (Qty, Qty) equalizeExponents x y = (x', y') where@@ -630,6 +671,7 @@ +-- | Multiplication mult :: Qty -> Qty -> Qty mult (Qty xm xe) (Qty ym ye) = Qty (xm * ym) (xe + ye)
lib/Penny/Steel.hs view
@@ -1,3 +1,7 @@ -- | Steel - independent Penny utilities+--+-- Currently there are no modules in Steel, as they have been+-- shipped off in separate packages such as anonymous-sums and+-- prednote; however, Steel remains if needed in the future. module Penny.Steel where
− lib/Penny/Steel/Sums.hs
@@ -1,71 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}---- | Anonymous sum types.--module Penny.Steel.Sums where--data S3 a b c- = S3a a- | S3b b- | S3c c- deriving (Eq, Ord, Show)--data S4 a b c d- = S4a a- | S4b b- | S4c c- | S4d d- deriving (Eq, Ord, Show)--partitionS3 :: [S3 a b c] -> ([a], [b], [c])-partitionS3 = foldr f ([], [], [])- where- f i (as, bs, cs) = case i of- S3a a -> (a:as, bs, cs)- S3b b -> (as, b:bs, cs)- S3c c -> (as, bs, c:cs)--partitionS4 :: [S4 a b c d] -> ([a], [b], [c], [d])-partitionS4 = foldr f ([], [], [], [])- where- f i (as, bs, cs, ds) = case i of- S4a a -> (a:as, bs, cs, ds)- S4b b -> (as, b:bs, cs, ds)- S4c c -> (as, bs, c:cs, ds)- S4d d -> (as, bs, cs, d:ds)--caseS3 :: (a -> d) -> (b -> d) -> (c -> d) -> S3 a b c -> d-caseS3 fa fb fc s3 = case s3 of- S3a a -> fa a- S3b b -> fb b- S3c c -> fc c--caseS4 :: (a -> e) -> (b -> e) -> (c -> e) -> (d -> e) -> S4 a b c d -> e-caseS4 fa fb fc fd s4 = case s4 of- S4a a -> fa a- S4b b -> fb b- S4c c -> fc c- S4d d -> fd d--mapS3 :: (a -> a1) -> (b -> b1) -> (c -> c1) -> S3 a b c -> S3 a1 b1 c1-mapS3 fa fb fc = caseS3 (S3a . fa) (S3b . fb) (S3c . fc)--mapS4- :: (a -> a1) -> (b -> b1) -> (c -> c1) -> (d -> d1)- -> S4 a b c d- -> S4 a1 b1 c1 d1-mapS4 a b c d = caseS4 (S4a . a) (S4b . b) (S4c . c) (S4d . d)--mapS3a- :: Functor f- => (a -> f a1) -> (b -> f b1) -> (c -> f c1) -> S3 a b c -> f (S3 a1 b1 c1)-mapS3a a b c = caseS3 (fmap S3a . a) (fmap S3b . b) (fmap S3c . c)--mapS4a- :: Functor f- => (a -> f a1) -> (b -> f b1) -> (c -> f c1) -> (d -> f d1)- -> S4 a b c d -> f (S4 a1 b1 c1 d1)--mapS4a a b c d = caseS4 (fmap S4a . a) (fmap S4b . b) (fmap S4c . c)- (fmap S4d . d)-
lib/Penny/Wheat.hs view
@@ -37,7 +37,7 @@ import qualified System.Exit as Exit import qualified System.IO as IO import qualified Penny.Shield as S-import qualified Penny.Steel.Sums as Su+import qualified Data.Sums as Su import qualified Data.Version as V import qualified Data.Prednote.Test as TT
lib/Penny/Zinc.hs view
@@ -20,7 +20,7 @@ import qualified Penny.Lincoln as L import qualified Penny.Lincoln.Queries as Q import qualified Penny.Shield as S-import qualified Penny.Steel.Sums as Su+import qualified Data.Sums as Su import Control.Applicative ((<*>), pure, (<$)) import qualified Control.Monad.Trans.State as St
penny.cabal view
@@ -1,9 +1,9 @@ Name: penny-Version: 0.30.0.2+Version: 0.32.0.0 Cabal-version: >=1.8 Build-Type: Simple License: BSD3-Copyright: 2012-2013 Omari Norman.+Copyright: 2012-2014 Omari Norman. author: Omari Norman maintainer: omari@smileystation.com stability: Experimental@@ -168,38 +168,73 @@ extra-source-files: install-docs- , README+ , README.md , doc/*.dot , doc/*.hs , doc/examples/*.pny , doc/man/*.1 , doc/man/*.7+ , known-working-dependencies.txt source-repository head type: git location: git://github.com/massysett/penny.git Library++ -- If updating any of these dependencies, remember to update+ -- test dependencies too. Build-depends:+ -- base - tracks Haskell Platform.+ -- Haskell Platform 2013.2.0.0 is base 4.6.0.1 base ==4.6.*- , action-permutations ==0.0.0.0- , bytestring ==0.10.*- , cereal ==0.3.*- , containers ==0.5.*- , matchers ==0.12.*- , multiarg ==0.24.*- , ofx ==0.4.*- , old-locale ==1.0.*- , parsec >= 3.1.2 && < 3.2- , prednote == 0.16.*- , pretty-show ==1.5.*- , rainbow ==0.4.*- , semigroups ==0.9.*- , split ==0.2.*- , text ==0.11.*- , time ==1.4.*- , transformers == 0.3.* + -- Haskell Platform packages+ -- Currently, minimum versions reflect Haskell Platform 2013.2.0.0+ -- Parsec - must use at least 3.1.2; it added an instance for+ -- Text. Therefore '3.1.*' would not suffice.+ --+ -- If you are having problems getting Penny to build due to+ -- dependencies and you can't fix it by using a cabal sandbox,+ -- please let me know via email or Github.+ --+ -- Eventually I would like to test to make sure that the package+ -- builds with the minimum possible version of each dependency;+ -- developing a test for this would take a little while.+ -- Meanwhile, I do include a list of known working dependencies+ -- for this release in the file known-working-dependencies.txt.+ --+ -- Do not try to put comments on same line as data; Cabal does+ -- not allow this.++ -- Package Version+ , bytestring >=0.10.0.2+ , containers >=0.4.2.1+ , old-locale >=1.0.0.5+ , parsec >=3.1.3+ , split >=0.2.2+ , text >=0.11.3.1+ , time >=1.4.0.1+ , transformers >=0.3.0.0++ -- Packages I maintain. Track the latest version.+ -- Package Version+ , anonymous-sums ==0.2.*+ , matchers ==0.14.*+ , multiarg ==0.24.*+ , ofx ==0.4.*+ , prednote ==0.18.*+ , rainbow ==0.6.*++ -- Other packages. Try to keep dependencies as loose as+ -- possible. Newer uploads might cause breakage, unfortunately.+ -- Package Version+ , action-permutations ==0.0.0.0+ , cereal >=0.3.5.2+ , either >=3.4.1+ , pretty-show >=1.5+ , semigroups >=0.9.2+ Exposed-modules: Penny , Penny.Brenner@@ -246,6 +281,11 @@ , Penny.Copper.Parsec , Penny.Copper.Render , Penny.Copper.Terminals+ , Penny.Denver+ , Penny.Denver.Diff+ , Penny.Denver.Reprint+ , Penny.Denver.Selloff+ , Penny.Denver.Reconcile , Penny.Liberty , Penny.Lincoln , Penny.Lincoln.Balance@@ -268,7 +308,6 @@ , Penny.Lincoln.Serial , Penny.Shield , Penny.Steel- , Penny.Steel.Sums , Penny.Wheat , Penny.Zinc @@ -284,11 +323,87 @@ if flag(debug) ghc-options: -auto-all -caf-all -Executable penny- Build-depends:+Test-Suite penny-test+ type: exitcode-stdio-1.0+ Main-is: penny-test.hs+ other-modules:+ Copper+ , Copper.Gen.Parsers+ , Copper.Gen.Terminals+ , Copper.Parser+ , Copper.Render+ , Lincoln+ hs-source-dirs: tests++ -- Be sure the build-depends are listed within the if block;+ -- otherwise, cabal install will always include these+ -- build-dependencies in any build, even non-test builds. However,+ -- you still have to list all the build-depends--the library+ -- build-depends are included for dependency resolving purposes but+ -- not for building purposes.++ -- Test dependencies. test-framework has issues with newer versions,+ -- see+ -- https://github.com/batterseapower/test-framework/issues/34++ -- For details on why penny is a dependency here, see+ -- http://stackoverflow.com/questions/6711151++ build-depends: penny , base ==4.6.* + -- Packages I maintain+ , multiarg ==0.24.*+ , anonymous-sums ==0.2.*++ -- Other packages+ , QuickCheck >=2.5+ , random-shuffle ==0.0.4+ , parsec >= 3.1.3+ , semigroups >=0.9.2+ , text >=0.11.3.1+ , time >=1.4.0.1+ , transformers >=0.3.0.0++ ghc-options: -Wall++Executable penny-gibberish+ Main-is: penny-gibberish.hs+ other-modules:+ Copper.Gen.Parsers+ , Copper.Gen.Terminals+ hs-source-dirs: tests++ if flag(build-gibberish)+ build-depends:+ penny+ , base ==4.6.*++ -- Packages I maintain+ , multiarg ==0.24.*++ -- Other packages+ , QuickCheck >=2.5+ , random-shuffle ==0.0.4+ , random >=1.0.1.1+ , semigroups >=0.9.2+ , text >=0.11.3.1+ , time >=1.4.0.1+ , transformers >= 0.3.0.0++ else+ buildable: False++ ghc-options: -Wall++Flag build-gibberish+ Description: Build the penny-gibberish executable+ Default: False++Executable penny+ Build-depends: penny, base+ hs-source-dirs: bin Main-is: penny-main.hs Other-modules: Paths_penny@@ -304,16 +419,7 @@ Default: True Executable penny-selloff- Build-depends:- penny- , base == 4.6.*- , containers ==0.5.*- , either ==3.4.*- , semigroups ==0.9.*- , text ==0.11.*- , parsec ==3.1.*- , multiarg ==0.24.*- , transformers ==0.3.*+ Build-depends: penny, base other-modules: Paths_penny hs-source-dirs: bin@@ -330,11 +436,7 @@ Default: True Executable penny-diff- Build-depends:- penny- , base ==4.6.*- , text ==0.11.*- , multiarg ==0.24.*+ Build-depends: penny, base hs-source-dirs: bin Main-is: penny-diff.hs@@ -351,12 +453,7 @@ Default: True Executable penny-reprint- Build-depends:- penny- , base ==4.6.*- , multiarg ==0.24.*- , pretty-show ==1.5.*- , text ==0.11.*+ Build-depends: penny, base hs-source-dirs: bin main-is: penny-reprint.hs@@ -370,11 +467,7 @@ Default: True Executable penny-reconcile- Build-depends:- penny- , base ==4.6.*- , text ==0.11.*- , multiarg ==0.24.*+ Build-depends: penny, base hs-source-dirs: bin main-is: penny-reconcile.hs@@ -386,73 +479,6 @@ Flag build-reconcile Description: Build the penny-reconcile executable Default: True--Test-Suite penny-test- type: exitcode-stdio-1.0- Main-is: penny-test.hs- other-modules:- Copper- , Copper.Gen.Parsers- , Copper.Gen.Terminals- , Copper.Parser- , Copper.Render- , Lincoln- hs-source-dirs: tests-- -- Be sure the build-depends are listed within the if block;- -- otherwise, cabal install will always include these- -- build-dependencies in any build, even non-test builds. However,- -- you still have to list all the build-depends--the library- -- build-depends are included for dependency resolving purposes but- -- not for building purposes.-- -- Test dependencies. test-framework has issues with newer versions,- -- see- -- https://github.com/batterseapower/test-framework/issues/34-- -- For details on why penny is a dependency here, see- -- http://stackoverflow.com/questions/6711151-- build-depends:- penny- , QuickCheck ==2.5.*- , random-shuffle ==0.0.4-- , base ==4.6.*- , multiarg ==0.24.*- , parsec >= 3.1.2 && < 3.2- , semigroups ==0.9.*- , text ==0.11.*- , time ==1.4.*- , transformers == 0.3.*-- ghc-options: -Wall--Executable penny-gibberish- Main-is: penny-gibberish.hs- other-modules:- Copper.Gen.Parsers- , Copper.Gen.Terminals- hs-source-dirs: tests-- if flag(test)- build-depends:- penny- , QuickCheck ==2.5.*- , random-shuffle ==0.0.4- , random ==1.0.*-- , base ==4.6.*- , multiarg ==0.24.*- , semigroups ==0.9.*- , text ==0.11.*- , time ==1.4.*- , transformers == 0.3.*-- else- buildable: False-- ghc-options: -Wall Flag debug Description: turns on some debugging options
tests/Copper/Gen/Parsers.hs view
@@ -12,7 +12,7 @@ import qualified Data.Time as Time import Data.Maybe (fromMaybe, catMaybes) import Data.Monoid ((<>))-import qualified Penny.Steel.Sums as S+import qualified Data.Sums as S import qualified System.Random.Shuffle as Shuffle import qualified Lincoln as TL
tests/Lincoln.hs view
@@ -10,7 +10,7 @@ import Data.Maybe (isJust, isNothing, catMaybes) import qualified Data.List.NonEmpty as NE import Data.List.NonEmpty (NonEmpty((:|)))-import Data.Monoid (mempty)+import Data.Monoid (mempty, (<>)) import qualified Data.Time as T import qualified Test.QuickCheck as Q import qualified Test.QuickCheck.Gen as QG@@ -22,7 +22,7 @@ import Data.Text (Text) import qualified Data.Text as X import System.Random.Shuffle (shuffle')-import qualified Penny.Steel.Sums as Su+import qualified Data.Sums as Su -- -- # Qty@@ -698,9 +698,25 @@ -- # Balance -- +instance Arbitrary L.Balance where+ arbitrary = L.entryToBalance <$> (arbitrary :: Gen (L.Entry L.Qty))++-- | Adding Balances is commutative+prop_addBalancesCommutative :: L.Balance -> L.Balance -> Bool+prop_addBalancesCommutative x y = (x <> y) == (y <> x)++-- | Adding Balances is associative+prop_addBalancesAssociative+ :: L.Balance -> L.Balance -> L.Balance -> Bool+prop_addBalancesAssociative x y z = (x <> (y <> z)) == ((x <> y) <> z)++-- | A mempty balance behaves as it should+prop_balMempty :: L.Balance -> Bool+prop_balMempty b = (b <> mempty) == b+ -- | The Balanced of an empty Balance is always Balanced.-prop_emptyBalance :: Bool-prop_emptyBalance = L.balanced mempty == L.Balanced+prop_emptyBalance :: QCP.Property+prop_emptyBalance = QCP.once $ L.balanced mempty == L.Balanced -- | The Balanced of a list of Entry where all the commodities are the -- same is always Balanced or Inferable.
tests/penny-test.hs view
@@ -20,12 +20,12 @@ options :: [MA.OptSpec (Q.Args -> Q.Args)] options =- [ MA.OptSpec ["size"] "s" . MA.OneArgE $ \s -> do+ [ MA.OptSpec ["size"] "s" . MA.OneArg $ \s -> do i <- MA.reader s let f a = a { Q.maxSize = i } return f - , MA.OptSpec ["count"] "n" . MA.OneArgE $ \s -> do+ , MA.OptSpec ["count"] "n" . MA.OneArg $ \s -> do i <- MA.reader s let f a = a { Q.maxSuccess = i } return f