summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorOmariNorman <>2014-02-14 02:23:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2014-02-14 02:23:00 (GMT)
commit454ee5d22423b33cb381821b36b1dbd361a55c66 (patch)
treea8eb0d542741017e5f7cb64dc211891c06570821
parent54e9ef9a0556557def2663067edbbd6ecf5b47f6 (diff)
version 0.32.0.00.32.0.0
-rw-r--r--README.md (renamed from README)24
-rw-r--r--bin/penny-diff.hs193
-rw-r--r--bin/penny-reconcile.hs74
-rw-r--r--bin/penny-reprint.hs50
-rw-r--r--bin/penny-selloff.hs616
-rw-r--r--doc/examples/more-file-format-details.pny27
-rw-r--r--known-working-dependencies.txt67
-rw-r--r--lib/Penny.hs10
-rw-r--r--lib/Penny/Brenner.hs2
-rw-r--r--lib/Penny/Brenner/Clear.hs2
-rw-r--r--lib/Penny/Brenner/Info.hs2
-rw-r--r--lib/Penny/Brenner/Merge.hs2
-rw-r--r--lib/Penny/Brenner/Types.hs2
-rw-r--r--lib/Penny/Cabin/Balance/Convert/Chunker.hs2
-rw-r--r--lib/Penny/Cabin/Balance/Convert/ChunkerPct.hs2
-rw-r--r--lib/Penny/Cabin/Balance/MultiCommodity/Chunker.hs2
-rw-r--r--lib/Penny/Cabin/Posts/Growers.hs2
-rw-r--r--lib/Penny/Cabin/Row.hs2
-rw-r--r--lib/Penny/Copper.hs2
-rw-r--r--lib/Penny/Copper/Interface.hs2
-rw-r--r--lib/Penny/Copper/Parsec.hs2
-rw-r--r--lib/Penny/Copper/Render.hs2
-rw-r--r--lib/Penny/Denver.hs6
-rw-r--r--lib/Penny/Denver/Diff.hs195
-rw-r--r--lib/Penny/Denver/Reconcile.hs76
-rw-r--r--lib/Penny/Denver/Reprint.hs52
-rw-r--r--lib/Penny/Denver/Selloff.hs618
-rw-r--r--lib/Penny/Lincoln/Bits/Qty.hs94
-rw-r--r--lib/Penny/Steel.hs4
-rw-r--r--lib/Penny/Steel/Sums.hs71
-rw-r--r--lib/Penny/Wheat.hs2
-rw-r--r--lib/Penny/Zinc.hs2
-rw-r--r--penny.cabal258
-rw-r--r--tests/Copper/Gen/Parsers.hs2
-rw-r--r--tests/Lincoln.hs24
-rw-r--r--tests/penny-test.hs4
36 files changed, 1318 insertions, 1179 deletions
diff --git a/README b/README.md
index e24ae39..ea9dede 100644
--- a/README
+++ b/README.md
@@ -3,7 +3,9 @@ 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
@@ -41,3 +43,25 @@ 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
index e9a07f8..2177dfb 100644
--- 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
index aef06ea..a5c39db 100644
--- 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
index 63eff48..b8fa85a 100644
--- 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
index c377905..2920091 100644
--- 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
index 9fec7a8..ae146bb 100644
--- 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
index 0000000..15d5303
--- /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
index b86d2a1..eb0373c 100644
--- a/lib/Penny.hs
+++ b/lib/Penny.hs
@@ -78,14 +78,14 @@ module Penny
-- "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.Spacers as PS
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
index 97d9bc3..d8ccff8 100644
--- a/lib/Penny/Brenner.hs
+++ b/lib/Penny/Brenner.hs
@@ -34,7 +34,7 @@ import qualified Penny.Brenner.Info as Info
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
index aa1686f..a822f3c 100644
--- a/lib/Penny/Brenner/Clear.hs
+++ b/lib/Penny/Brenner/Clear.hs
@@ -11,7 +11,7 @@ import qualified Data.Traversable as Tr
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
index 6300107..3bf05c4 100644
--- a/lib/Penny/Brenner/Info.hs
+++ b/lib/Penny/Brenner/Info.hs
@@ -6,7 +6,7 @@ import qualified Data.Text as X
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
index 85d9b49..0794899 100644
--- a/lib/Penny/Brenner/Merge.hs
+++ b/lib/Penny/Brenner/Merge.hs
@@ -16,7 +16,7 @@ import qualified Penny.Liberty as Ly
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
index c31f946..2bde3ef 100644
--- a/lib/Penny/Brenner/Types.hs
+++ b/lib/Penny/Brenner/Types.hs
@@ -34,7 +34,7 @@ import qualified Penny.Lincoln as L
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
index 5d05d5f..13652f3 100644
--- a/lib/Penny/Cabin/Balance/Convert/Chunker.hs
+++ b/lib/Penny/Cabin/Balance/Convert/Chunker.hs
@@ -60,7 +60,7 @@ maxWidthPerColumn ::
-> 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
index 6df69c1..045fe93 100644
--- a/lib/Penny/Cabin/Balance/Convert/ChunkerPct.hs
+++ b/lib/Penny/Cabin/Balance/Convert/ChunkerPct.hs
@@ -61,7 +61,7 @@ maxWidthPerColumn ::
-> 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
index 5243674..fa44178 100644
--- a/lib/Penny/Cabin/Balance/MultiCommodity/Chunker.hs
+++ b/lib/Penny/Cabin/Balance/MultiCommodity/Chunker.hs
@@ -63,7 +63,7 @@ maxWidthPerColumn ::
-> 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
index 62fe402..894c0ea 100644
--- a/lib/Penny/Cabin/Posts/Growers.hs
+++ b/lib/Penny/Cabin/Posts/Growers.hs
@@ -63,7 +63,7 @@ widestLine :: PreSpec -> Int
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
index d5d330f..6822ac9 100644
--- a/lib/Penny/Cabin/Row.hs
+++ b/lib/Penny/Cabin/Row.hs
@@ -77,7 +77,7 @@ justify
-> 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
index e04b13d..baea7b4 100644
--- a/lib/Penny/Copper.hs
+++ b/lib/Penny/Copper.hs
@@ -90,7 +90,7 @@ module Penny.Copper
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
index 9994718..6d03be2 100644
--- a/lib/Penny/Copper/Interface.hs
+++ b/lib/Penny/Copper/Interface.hs
@@ -2,7 +2,7 @@ module Penny.Copper.Interface where
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
index 9e90caf..3ede690 100644
--- a/lib/Penny/Copper/Parsec.hs
+++ b/lib/Penny/Copper/Parsec.hs
@@ -15,7 +15,7 @@ import Control.Applicative ((<$>), (<$), (<*>), (*>), (<*),
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
index 728f547..f6d46d4 100644
--- a/lib/Penny/Copper/Render.hs
+++ b/lib/Penny/Copper/Render.hs
@@ -16,7 +16,7 @@ import qualified Penny.Copper.Terminals as T
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
index 0000000..a075e66
--- /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
index 0000000..386b0a2
--- /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
index 0000000..a06a2f1
--- /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
index 0000000..d1da32a
--- /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
index 0000000..ca1f3df
--- /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
index e76fd08..c77e45d 100644
--- 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 @@ module Penny.Lincoln.Bits.Qty
, showQtyRep
, bestRadGroup
- -- * Other stuff
+ -- * Qty
, Qty
, HasQty(..)
, signif
@@ -49,12 +87,16 @@ module Penny.Lincoln.Bits.Qty
, newQty
, Signif
, Places
+
+ -- ** Arithmetic
, add
, mult
, divide
, Difference(LeftBiggerBy, RightBiggerBy, Equal)
, difference
, allocate
+
+ -- * Integer allocations
, TotSeats
, PartyVotes
, SeatsWon
@@ -79,7 +121,7 @@ import Data.Semigroup(sconcat)
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 @@ data CommaGrp
-- ^ 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 @@ newtype WholeOrFrac a = WholeOrFrac
{ 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 @@ wholeOrFrac
-> 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 @@ wholeOrFrac g@(GroupedDigits l1 lr) mayAft = case mayAft of
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,26 +569,22 @@ showQtyRep q = case q of
-- 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'
@@ -563,6 +602,8 @@ qtyOne :: Qty
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 @@ compareQty q1 q2 = compare (signif q1') (signif q2')
(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 @@ add x y =
+-- | 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
index 153a01b..5008665 100644
--- 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
index 3f1bd71..0000000
--- 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
index e02e311..4f33239 100644
--- a/lib/Penny/Wheat.hs
+++ b/lib/Penny/Wheat.hs
@@ -37,7 +37,7 @@ import qualified Text.Parsec as Parsec
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
index 91f994d..e44b8aa 100644
--- a/lib/Penny/Zinc.hs
+++ b/lib/Penny/Zinc.hs
@@ -20,7 +20,7 @@ import qualified Data.Prednote.Pdct as Pe
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
index 90d9f1d..282d8ac 100644
--- 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,37 +168,72 @@ description: Penny is a double-entry accounting system. It is inspired
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
@@ -246,6 +281,11 @@ Library
, 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 @@ Library
, Penny.Lincoln.Serial
, Penny.Shield
, Penny.Steel
- , Penny.Steel.Sums
, Penny.Wheat
, Penny.Zinc
@@ -284,11 +323,87 @@ Library
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 @@ Flag build-penny
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 @@ Flag build-selloff
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 @@ Flag build-diff
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 @@ Flag build-reprint
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
@@ -387,73 +480,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
Default: False
diff --git a/tests/Copper/Gen/Parsers.hs b/tests/Copper/Gen/Parsers.hs
index 11e49fa..dcfc3ed 100644
--- a/tests/Copper/Gen/Parsers.hs
+++ b/tests/Copper/Gen/Parsers.hs
@@ -12,7 +12,7 @@ import qualified Penny.Copper.Render as CR
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
index 54276bf..b5c7a49 100644
--- a/tests/Lincoln.hs
+++ b/tests/Lincoln.hs
@@ -10,7 +10,7 @@ import Data.List (foldl1')
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 Penny.Lincoln.Equivalent ((==~))
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 @@ instance Arbitrary L.PostingData where
-- # 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
index ae808b4..204a632 100644
--- a/tests/penny-test.hs
+++ b/tests/penny-test.hs
@@ -20,12 +20,12 @@ help pn = unlines
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