diff --git a/README b/README deleted file mode 100644 --- a/README +++ /dev/null @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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`. + +[![Build Status](https://travis-ci.org/massysett/penny.png?branch=master)](https://travis-ci.org/massysett/penny) diff --git a/bin/penny-diff.hs b/bin/penny-diff.hs --- a/bin/penny-diff.hs +++ b/bin/penny-diff.hs @@ -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 diff --git a/bin/penny-reconcile.hs b/bin/penny-reconcile.hs --- a/bin/penny-reconcile.hs +++ b/bin/penny-reconcile.hs @@ -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 diff --git a/bin/penny-reprint.hs b/bin/penny-reprint.hs --- a/bin/penny-reprint.hs +++ b/bin/penny-reprint.hs @@ -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 diff --git a/bin/penny-selloff.hs b/bin/penny-selloff.hs --- a/bin/penny-selloff.hs +++ b/bin/penny-selloff.hs @@ -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 diff --git a/doc/examples/more-file-format-details.pny b/doc/examples/more-file-format-details.pny --- a/doc/examples/more-file-format-details.pny +++ b/doc/examples/more-file-format-details.pny @@ -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: diff --git a/known-working-dependencies.txt b/known-working-dependencies.txt new file mode 100644 --- /dev/null +++ b/known-working-dependencies.txt @@ -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 + diff --git a/lib/Penny.hs b/lib/Penny.hs --- a/lib/Penny.hs +++ b/lib/Penny.hs @@ -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 diff --git a/lib/Penny/Brenner.hs b/lib/Penny/Brenner.hs --- a/lib/Penny/Brenner.hs +++ b/lib/Penny/Brenner.hs @@ -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 diff --git a/lib/Penny/Brenner/Clear.hs b/lib/Penny/Brenner/Clear.hs --- a/lib/Penny/Brenner/Clear.hs +++ b/lib/Penny/Brenner/Clear.hs @@ -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) diff --git a/lib/Penny/Brenner/Info.hs b/lib/Penny/Brenner/Info.hs --- a/lib/Penny/Brenner/Info.hs +++ b/lib/Penny/Brenner/Info.hs @@ -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 diff --git a/lib/Penny/Brenner/Merge.hs b/lib/Penny/Brenner/Merge.hs --- a/lib/Penny/Brenner/Merge.hs +++ b/lib/Penny/Brenner/Merge.hs @@ -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 diff --git a/lib/Penny/Brenner/Types.hs b/lib/Penny/Brenner/Types.hs --- a/lib/Penny/Brenner/Types.hs +++ b/lib/Penny/Brenner/Types.hs @@ -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. diff --git a/lib/Penny/Cabin/Balance/Convert/Chunker.hs b/lib/Penny/Cabin/Balance/Convert/Chunker.hs --- a/lib/Penny/Cabin/Balance/Convert/Chunker.hs +++ b/lib/Penny/Cabin/Balance/Convert/Chunker.hs @@ -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. diff --git a/lib/Penny/Cabin/Balance/Convert/ChunkerPct.hs b/lib/Penny/Cabin/Balance/Convert/ChunkerPct.hs --- a/lib/Penny/Cabin/Balance/Convert/ChunkerPct.hs +++ b/lib/Penny/Cabin/Balance/Convert/ChunkerPct.hs @@ -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. diff --git a/lib/Penny/Cabin/Balance/MultiCommodity/Chunker.hs b/lib/Penny/Cabin/Balance/MultiCommodity/Chunker.hs --- a/lib/Penny/Cabin/Balance/MultiCommodity/Chunker.hs +++ b/lib/Penny/Cabin/Balance/MultiCommodity/Chunker.hs @@ -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 diff --git a/lib/Penny/Cabin/Posts/Growers.hs b/lib/Penny/Cabin/Posts/Growers.hs --- a/lib/Penny/Cabin/Posts/Growers.hs +++ b/lib/Penny/Cabin/Posts/Growers.hs @@ -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 diff --git a/lib/Penny/Cabin/Row.hs b/lib/Penny/Cabin/Row.hs --- a/lib/Penny/Cabin/Row.hs +++ b/lib/Penny/Cabin/Row.hs @@ -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 diff --git a/lib/Penny/Copper.hs b/lib/Penny/Copper.hs --- a/lib/Penny/Copper.hs +++ b/lib/Penny/Copper.hs @@ -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 diff --git a/lib/Penny/Copper/Interface.hs b/lib/Penny/Copper/Interface.hs --- a/lib/Penny/Copper/Interface.hs +++ b/lib/Penny/Copper/Interface.hs @@ -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 diff --git a/lib/Penny/Copper/Parsec.hs b/lib/Penny/Copper/Parsec.hs --- a/lib/Penny/Copper/Parsec.hs +++ b/lib/Penny/Copper/Parsec.hs @@ -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 diff --git a/lib/Penny/Copper/Render.hs b/lib/Penny/Copper/Render.hs --- a/lib/Penny/Copper/Render.hs +++ b/lib/Penny/Copper/Render.hs @@ -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 diff --git a/lib/Penny/Denver.hs b/lib/Penny/Denver.hs new file mode 100644 --- /dev/null +++ b/lib/Penny/Denver.hs @@ -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 diff --git a/lib/Penny/Denver/Diff.hs b/lib/Penny/Denver/Diff.hs new file mode 100644 --- /dev/null +++ b/lib/Penny/Denver/Diff.hs @@ -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) diff --git a/lib/Penny/Denver/Reconcile.hs b/lib/Penny/Denver/Reconcile.hs new file mode 100644 --- /dev/null +++ b/lib/Penny/Denver/Reconcile.hs @@ -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) + diff --git a/lib/Penny/Denver/Reprint.hs b/lib/Penny/Denver/Reprint.hs new file mode 100644 --- /dev/null +++ b/lib/Penny/Denver/Reprint.hs @@ -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) diff --git a/lib/Penny/Denver/Selloff.hs b/lib/Penny/Denver/Selloff.hs new file mode 100644 --- /dev/null +++ b/lib/Penny/Denver/Selloff.hs @@ -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 diff --git a/lib/Penny/Lincoln/Bits/Qty.hs b/lib/Penny/Lincoln/Bits/Qty.hs --- a/lib/Penny/Lincoln/Bits/Qty.hs +++ b/lib/Penny/Lincoln/Bits/Qty.hs @@ -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) diff --git a/lib/Penny/Steel.hs b/lib/Penny/Steel.hs --- a/lib/Penny/Steel.hs +++ b/lib/Penny/Steel.hs @@ -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 diff --git a/lib/Penny/Steel/Sums.hs b/lib/Penny/Steel/Sums.hs deleted file mode 100644 --- a/lib/Penny/Steel/Sums.hs +++ /dev/null @@ -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) - diff --git a/lib/Penny/Wheat.hs b/lib/Penny/Wheat.hs --- a/lib/Penny/Wheat.hs +++ b/lib/Penny/Wheat.hs @@ -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 diff --git a/lib/Penny/Zinc.hs b/lib/Penny/Zinc.hs --- a/lib/Penny/Zinc.hs +++ b/lib/Penny/Zinc.hs @@ -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 diff --git a/penny.cabal b/penny.cabal --- a/penny.cabal +++ b/penny.cabal @@ -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 diff --git a/tests/Copper/Gen/Parsers.hs b/tests/Copper/Gen/Parsers.hs --- a/tests/Copper/Gen/Parsers.hs +++ b/tests/Copper/Gen/Parsers.hs @@ -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 diff --git a/tests/Lincoln.hs b/tests/Lincoln.hs --- a/tests/Lincoln.hs +++ b/tests/Lincoln.hs @@ -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. diff --git a/tests/penny-test.hs b/tests/penny-test.hs --- a/tests/penny-test.hs +++ b/tests/penny-test.hs @@ -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