{-# LANGUAGE FlexibleContexts #-}
{-|

A 'Transaction' represents a movement of some commodity(ies) between two
or more accounts. It consists of multiple account 'Posting's which balance
to zero, a date, and optional extras like description, cleared status, and
tags.

-}

{-# LANGUAGE OverloadedStrings, LambdaCase #-}

module Hledger.Data.Transaction (
  -- * Transaction
  nullsourcepos,
  nulltransaction,
  txnTieKnot,
  txnUntieKnot,
  -- * operations
  showAccountName,
  hasRealPostings,
  realPostings,
  assignmentPostings,
  virtualPostings,
  balancedVirtualPostings,
  transactionsPostings,
  isTransactionBalanced,
  -- nonzerobalanceerror,
  -- * date operations
  transactionDate2,
  -- * arithmetic
  transactionPostingBalances,
  balanceTransaction,
  balanceTransactionUpdate,
  -- * rendering
  showTransaction,
  showTransactionUnelided,
  showTransactionUnelidedOneLineAmounts,
  showPostingLine,
  showPostingLines,
  -- * GenericSourcePos
  sourceFilePath,
  sourceFirstLine,
  showGenericSourcePos,
  -- * misc.
  tests_Hledger_Data_Transaction
)
where
import Data.List
import Control.Monad.Except
import Control.Monad.Identity
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar
import Test.HUnit
import Text.Printf
import qualified Data.Map as Map

import Hledger.Utils
import Hledger.Data.Types
import Hledger.Data.Dates
import Hledger.Data.Posting
import Hledger.Data.Amount

instance Show Transaction where show = showTransactionUnelided

instance Show ModifierTransaction where
    show t = "= " ++ T.unpack (mtvalueexpr t) ++ "\n" ++ unlines (map show (mtpostings t))

instance Show PeriodicTransaction where
    show t = "~ " ++ T.unpack (ptperiodexpr t) ++ "\n" ++ unlines (map show (ptpostings t))

sourceFilePath :: GenericSourcePos -> FilePath
sourceFilePath = \case
    GenericSourcePos fp _ _ -> fp
    JournalSourcePos fp _ -> fp

sourceFirstLine :: GenericSourcePos -> Int
sourceFirstLine = \case
    GenericSourcePos _ line _ -> line
    JournalSourcePos _ (line, _) -> line

showGenericSourcePos :: GenericSourcePos -> String
showGenericSourcePos = \case
    GenericSourcePos fp line column -> show fp ++ " (line " ++ show line ++ ", column " ++ show column ++ ")"
    JournalSourcePos fp (line, line') -> show fp ++ " (lines " ++ show line ++ "-" ++ show line' ++ ")"

nullsourcepos :: GenericSourcePos
nullsourcepos = GenericSourcePos "" 1 1

nulltransaction :: Transaction
nulltransaction = Transaction {
                    tindex=0,
                    tsourcepos=nullsourcepos,
                    tdate=nulldate,
                    tdate2=Nothing,
                    tstatus=Unmarked,
                    tcode="",
                    tdescription="",
                    tcomment="",
                    ttags=[],
                    tpostings=[],
                    tpreceding_comment_lines=""
                  }

{-|
Show a journal transaction, formatted for the print command. ledger 2.x's
standard format looks like this:

@
yyyy/mm/dd[ *][ CODE] description.........          [  ; comment...............]
    account name 1.....................  ...$amount1[  ; comment...............]
    account name 2.....................  ..$-amount1[  ; comment...............]

pcodewidth    = no limit -- 10          -- mimicking ledger layout.
pdescwidth    = no limit -- 20          -- I don't remember what these mean,
pacctwidth    = 35 minimum, no maximum  -- they were important at the time.
pamtwidth     = 11
pcommentwidth = no limit -- 22
@
-}
showTransaction :: Transaction -> String
showTransaction = showTransactionHelper True False

showTransactionUnelided :: Transaction -> String
showTransactionUnelided = showTransactionHelper False False

tests_showTransactionUnelided = [
   "showTransactionUnelided" ~: do
    let t `gives` s = assertEqual "" s (showTransactionUnelided t)
    nulltransaction `gives` "0000/01/01\n\n"
    nulltransaction{
      tdate=parsedate "2012/05/14",
      tdate2=Just $ parsedate "2012/05/15",
      tstatus=Unmarked,
      tcode="code",
      tdescription="desc",
      tcomment="tcomment1\ntcomment2\n",
      ttags=[("ttag1","val1")],
      tpostings=[
        nullposting{
          pstatus=Cleared,
          paccount="a",
          pamount=Mixed [usd 1, hrs 2],
          pcomment="\npcomment2\n",
          ptype=RegularPosting,
          ptags=[("ptag1","val1"),("ptag2","val2")]
          }
       ]
      }
      `gives` unlines [
      "2012/05/14=2012/05/15 (code) desc    ; tcomment1",
      "    ; tcomment2",
      "    * a         $1.00",
      "    ; pcomment2",
      "    * a         2.00h",
      "    ; pcomment2",
      ""
      ]
 ]

showTransactionUnelidedOneLineAmounts :: Transaction -> String
showTransactionUnelidedOneLineAmounts = showTransactionHelper False True

-- cf showPosting
showTransactionHelper :: Bool -> Bool -> Transaction -> String
showTransactionHelper elide onelineamounts t =
    unlines $ [descriptionline]
              ++ newlinecomments
              ++ (postingsAsLines elide onelineamounts t (tpostings t))
              ++ [""]
    where
      descriptionline = rstrip $ concat [date, status, code, desc, samelinecomment]
      date = showDate (tdate t) ++ maybe "" (("="++) . showDate) (tdate2 t)
      status | tstatus t == Cleared = " *"
             | tstatus t == Pending = " !"
             | otherwise            = ""
      code = if T.length (tcode t) > 0 then printf " (%s)" $ T.unpack $ tcode t else ""
      desc = if null d then "" else " " ++ d where d = T.unpack $ tdescription t
      (samelinecomment, newlinecomments) =
        case renderCommentLines (tcomment t) of []   -> ("",[])
                                                c:cs -> (c,cs)

-- Render a transaction or posting's comment as indented, semicolon-prefixed comment lines.
renderCommentLines :: Text -> [String]
renderCommentLines t  = case lines $ T.unpack t of ("":ls) -> "":map commentprefix ls
                                                   ls      -> map commentprefix ls
    where
      commentprefix = indent . ("; "++)

-- -- Render a transaction or posting's comment as semicolon-prefixed comment lines -
-- -- an inline (same-line) comment if it's a single line, otherwise multiple indented lines.
-- commentLines' :: String -> (String, [String])
-- commentLines' s
--     | null s = ("", [])
--     | length ls == 1 = (prefix $ head ls, [])
--     | otherwise = ("", (prefix $ head ls):(map prefix $ tail ls))
--     where
--       ls = lines s
--       prefix = indent . (";"++)

postingsAsLines :: Bool -> Bool -> Transaction -> [Posting] -> [String]
postingsAsLines elide onelineamounts t ps
    | elide && length ps > 1 && isTransactionBalanced Nothing t -- imprecise balanced check
       = (concatMap (postingAsLines False onelineamounts ps) $ init ps) ++ postingAsLines True onelineamounts ps (last ps)
    | otherwise = concatMap (postingAsLines False onelineamounts ps) ps

postingAsLines :: Bool -> Bool -> [Posting] -> Posting -> [String]
postingAsLines elideamount onelineamounts ps p = concat [
    postingblock
    ++ newlinecomments
    | postingblock <- postingblocks]
  where
    postingblocks = [map rstrip $ lines $ concatTopPadded [statusandaccount, "  ", amount, assertion, samelinecomment] | amount <- shownAmounts]
    assertion = maybe "" ((" = " ++) . showAmountWithZeroCommodity . fst) $ pbalanceassertion p
    statusandaccount = indent $ fitString (Just $ minwidth) Nothing False True $ pstatusandacct p
        where
          -- pad to the maximum account name width, plus 2 to leave room for status flags, to keep amounts aligned  
          minwidth = maximum $ map ((2+) . textWidth . T.pack . pacctstr) ps
          pstatusandacct p' = pstatusprefix p' ++ pacctstr p'
          pstatusprefix p' | null s    = ""
                           | otherwise = s ++ " "
            where s = show $ pstatus p'
          pacctstr p' = showAccountName Nothing (ptype p') (paccount p')

    -- currently prices are considered part of the amount string when right-aligning amounts
    shownAmounts
      | elideamount    = [""]
      | onelineamounts = [fitString (Just amtwidth) Nothing False False $ showMixedAmountOneLine $ pamount p]
      | null (amounts $ pamount p) = [""]
      | otherwise      = map (fitStringMulti (Just amtwidth) Nothing False False . showAmount ) . amounts $ pamount p
      where
        amtwidth = maximum $ 12 : map (strWidth . showMixedAmount . pamount) ps  -- min. 12 for backwards compatibility

    (samelinecomment, newlinecomments) =
      case renderCommentLines (pcomment p) of []   -> ("",[])
                                              c:cs -> (c,cs)


-- used in balance assertion error
showPostingLine p =
  indent $
  if pstatus p == Cleared then "* " else "" ++
  showAccountName Nothing (ptype p) (paccount p) ++
  "    " ++
  showMixedAmountOneLine (pamount p)

-- | Produce posting line with all comment lines associated with it
showPostingLines :: Posting -> [String]
showPostingLines p = postingAsLines False False ps p where
    ps | Just t <- ptransaction p = tpostings t
       | otherwise = [p]

tests_postingAsLines = [
   "postingAsLines" ~: do
    let p `gives` ls = assertEqual (show p) ls (postingAsLines False False [p] p)
    posting `gives` [""]
    posting{
      pstatus=Cleared,
      paccount="a",
      pamount=Mixed [usd 1, hrs 2],
      pcomment="pcomment1\npcomment2\n  tag3: val3  \n",
      ptype=RegularPosting,
      ptags=[("ptag1","val1"),("ptag2","val2")]
      }
     `gives` [
      "    * a         $1.00    ; pcomment1",
      "    ; pcomment2",
      "    ;   tag3: val3  ",
      "    * a         2.00h    ; pcomment1",
      "    ; pcomment2",
      "    ;   tag3: val3  "
      ]
 ]

tests_inference = [
    "inferBalancingAmount" ~: do
    let p `gives` p' = assertEqual (show p) (Right p') $ inferTransaction p
        inferTransaction :: Transaction -> Either String Transaction
        inferTransaction = runIdentity . runExceptT . inferBalancingAmount (\_ _ -> return ()) Map.empty
    nulltransaction `gives` nulltransaction
    nulltransaction{
      tpostings=[
        "a" `post` usd (-5),
        "b" `post` missingamt
      ]}
      `gives`
      nulltransaction{
        tpostings=[
          "a" `post` usd (-5),
          "b" `post` usd 5
        ]}
    nulltransaction{
      tpostings=[
        "a" `post` usd (-5),
        "b" `post` (eur 3 @@ usd 4),
        "c" `post` missingamt
      ]}
      `gives`
      nulltransaction{
        tpostings=[
          "a" `post` usd (-5),
          "b" `post` (eur 3 @@ usd 4),
          "c" `post` usd 1
        ]}
 ]

indent :: String -> String
indent = ("    "++)

-- | Show an account name, clipped to the given width if any, and
-- appropriately bracketed/parenthesised for the given posting type.
showAccountName :: Maybe Int -> PostingType -> AccountName -> String
showAccountName w = fmt
    where
      fmt RegularPosting = take w' . T.unpack
      fmt VirtualPosting = parenthesise . reverse . take (w'-2) . reverse . T.unpack
      fmt BalancedVirtualPosting = bracket . reverse . take (w'-2) . reverse . T.unpack
      w' = fromMaybe 999999 w

parenthesise :: String -> String
parenthesise s = "("++s++")"

bracket :: String -> String
bracket s = "["++s++"]"

hasRealPostings :: Transaction -> Bool
hasRealPostings = not . null . realPostings

realPostings :: Transaction -> [Posting]
realPostings = filter isReal . tpostings

assignmentPostings :: Transaction -> [Posting]
assignmentPostings = filter isAssignment . tpostings

virtualPostings :: Transaction -> [Posting]
virtualPostings = filter isVirtual . tpostings

balancedVirtualPostings :: Transaction -> [Posting]
balancedVirtualPostings = filter isBalancedVirtual . tpostings

transactionsPostings :: [Transaction] -> [Posting]
transactionsPostings = concat . map tpostings

-- | Get the sums of a transaction's real, virtual, and balanced virtual postings.
transactionPostingBalances :: Transaction -> (MixedAmount,MixedAmount,MixedAmount)
transactionPostingBalances t = (sumPostings $ realPostings t
                               ,sumPostings $ virtualPostings t
                               ,sumPostings $ balancedVirtualPostings t)

-- | Is this transaction balanced ? A balanced transaction's real
-- (non-virtual) postings sum to 0, and any balanced virtual postings
-- also sum to 0.
isTransactionBalanced :: Maybe (Map.Map CommoditySymbol AmountStyle) -> Transaction -> Bool
isTransactionBalanced styles t =
    -- isReallyZeroMixedAmountCost rsum && isReallyZeroMixedAmountCost bvsum
    isZeroMixedAmount rsum' && isZeroMixedAmount bvsum'
    where
      (rsum, _, bvsum) = transactionPostingBalances t
      rsum'  = canonicalise $ costOfMixedAmount rsum
      bvsum' = canonicalise $ costOfMixedAmount bvsum
      canonicalise = maybe id canonicaliseMixedAmount styles

-- | Ensure this transaction is balanced, possibly inferring a missing
-- amount or conversion price(s), or return an error message.
-- Balancing is affected by commodity display precisions, so those can
-- (optionally) be provided.
-- 
-- this fails for example, if there are several missing amounts
-- (possibly with balance assignments)
balanceTransaction :: Maybe (Map.Map CommoditySymbol AmountStyle)
                   -> Transaction -> Either String Transaction
balanceTransaction stylemap = runIdentity . runExceptT
  . balanceTransactionUpdate (\_ _ -> return ()) stylemap


-- | More general version of 'balanceTransaction' that takes an update
-- function
balanceTransactionUpdate :: MonadError String m
  => (AccountName -> MixedAmount -> m ())
     -- ^ update function
  -> Maybe (Map.Map CommoditySymbol AmountStyle)
  -> Transaction -> m Transaction
balanceTransactionUpdate update mstyles t =
  finalize =<< inferBalancingAmount update (fromMaybe Map.empty mstyles) t
  where
    finalize t' = let t'' = inferBalancingPrices t'
                  in if isTransactionBalanced mstyles t''
                     then return $ txnTieKnot t''
                     else throwError $ printerr $ nonzerobalanceerror t''
    printerr s = intercalate "\n" [s, showTransactionUnelided t]
    nonzerobalanceerror :: Transaction -> String
    nonzerobalanceerror t = printf "could not balance this transaction (%s%s%s)" rmsg sep bvmsg
        where
          (rsum, _, bvsum) = transactionPostingBalances t
          rmsg | isReallyZeroMixedAmountCost rsum = ""
               | otherwise = "real postings are off by "
                 ++ showMixedAmount (costOfMixedAmount rsum)
          bvmsg | isReallyZeroMixedAmountCost bvsum = ""
                | otherwise = "balanced virtual postings are off by "
                  ++ showMixedAmount (costOfMixedAmount bvsum)
          sep = if not (null rmsg) && not (null bvmsg) then "; " else "" :: String

-- | Infer up to one missing amount for this transactions's real postings, and
-- likewise for its balanced virtual postings, if needed; or return an error
-- message if we can't.
--
-- We can infer a missing amount when there are multiple postings and exactly
-- one of them is amountless. If the amounts had price(s) the inferred amount
-- have the same price(s), and will be converted to the price commodity.
inferBalancingAmount :: MonadError String m =>
                        (AccountName -> MixedAmount -> m ()) -- ^ update function
                     -> Map.Map CommoditySymbol AmountStyle  -- ^ standard amount styles
                     -> Transaction
                     -> m Transaction
inferBalancingAmount update styles t@Transaction{tpostings=ps}
  | length amountlessrealps > 1
      = throwError $ printerr "could not balance this transaction - can't have more than one real posting with no amount (remember to put 2 or more spaces before amounts)"
  | length amountlessbvps > 1
      = throwError $ printerr "could not balance this transaction - can't have more than one balanced virtual posting with no amount (remember to put 2 or more spaces before amounts)"
  | otherwise
      = do postings <- mapM inferamount ps
           return t{tpostings=postings}
  where
    printerr s = intercalate "\n" [s, showTransactionUnelided t]
    (amountfulrealps, amountlessrealps) = partition hasAmount (realPostings t)
    realsum = sumStrict $ map pamount amountfulrealps
    (amountfulbvps, amountlessbvps) = partition hasAmount (balancedVirtualPostings t)
    bvsum = sumStrict $ map pamount amountfulbvps
    inferamount p@Posting{ptype=RegularPosting}
     | not (hasAmount p) = updateAmount p realsum
    inferamount p@Posting{ptype=BalancedVirtualPosting}
     | not (hasAmount p) = updateAmount p bvsum
    inferamount p = return p
    updateAmount p amt = 
      update (paccount p) amt' >> return p { pamount=amt', porigin=Just $ originalPosting p }
      where
        -- Inferred amounts are converted to cost.
        -- Also, ensure the new amount has the standard style for its commodity  
        -- (the main amount styling pass happened before this balancing pass).   
        amt' = styleMixedAmount styles $ normaliseMixedAmount $ costOfMixedAmount (-amt)

-- | Infer prices for this transaction's posting amounts, if needed to make
-- the postings balance, and if possible. This is done once for the real
-- postings and again (separately) for the balanced virtual postings. When
-- it's not possible, the transaction is left unchanged.
--
-- The simplest example is a transaction with two postings, each in a
-- different commodity, with no prices specified. In this case we'll add a
-- price to the first posting such that it can be converted to the commodity
-- of the second posting (with -B), and such that the postings balance.
--
-- In general, we can infer a conversion price when the sum of posting amounts
-- contains exactly two different commodities and no explicit prices.  Also
-- all postings are expected to contain an explicit amount (no missing
-- amounts) in a single commodity. Otherwise no price inferring is attempted.
--
-- The transaction itself could contain more than two commodities, and/or
-- prices, if they cancel out; what matters is that the sum of posting amounts
-- contains exactly two commodities and zero prices.
--
-- There can also be more than two postings in either of the commodities.
--
-- We want to avoid excessive display of digits when the calculated price is
-- an irrational number, while hopefully also ensuring the displayed numbers
-- make sense if the user does a manual calculation. This is (mostly) achieved
-- in two ways:
--
-- - when there is only one posting in the "from" commodity, a total price
--   (@@) is used, and all available decimal digits are shown
--
-- - otherwise, a suitable averaged unit price (@) is applied to the relevant
--   postings, with display precision equal to the summed display precisions
--   of the two commodities being converted between, or 2, whichever is larger.
--
-- (We don't always calculate a good-looking display precision for unit prices
-- when the commodity display precisions are low, eg when a journal doesn't
-- use any decimal places. The minimum of 2 helps make the prices shown by the
-- print command a bit less surprising in this case. Could do better.)
--
inferBalancingPrices :: Transaction -> Transaction
inferBalancingPrices t@Transaction{tpostings=ps} = t{tpostings=ps'}
  where
    ps' = map (priceInferrerFor t BalancedVirtualPosting) $
          map (priceInferrerFor t RegularPosting) $
          ps

-- | Generate a posting update function which assigns a suitable balancing
-- price to the posting, if and as appropriate for the given transaction and
-- posting type (real or balanced virtual).
priceInferrerFor :: Transaction -> PostingType -> (Posting -> Posting)
priceInferrerFor t pt = inferprice
  where
    postings       = filter ((==pt).ptype) $ tpostings t
    pmixedamounts  = map pamount postings
    pamounts       = concatMap amounts pmixedamounts
    pcommodities   = map acommodity pamounts
    sumamounts     = amounts $ sumStrict pmixedamounts -- sum normalises to one amount per commodity & price
    sumcommodities = map acommodity sumamounts
    sumprices      = filter (/=NoPrice) $ map aprice sumamounts
    caninferprices = length sumcommodities == 2 && null sumprices

    inferprice p@Posting{pamount=Mixed [a]}
      | caninferprices && ptype p == pt && acommodity a == fromcommodity
        = p{pamount=Mixed [a{aprice=conversionprice}], porigin=Just $ originalPosting p}
      where
        fromcommodity = head $ filter (`elem` sumcommodities) pcommodities -- these heads are ugly but should be safe
        conversionprice
          | fromcount==1 = TotalPrice $ abs toamount `withPrecision` maxprecision
          | otherwise    = UnitPrice $ abs unitprice `withPrecision` unitprecision
          where
            fromcount     = length $ filter ((==fromcommodity).acommodity) pamounts
            fromamount    = head $ filter ((==fromcommodity).acommodity) sumamounts
            tocommodity   = head $ filter (/=fromcommodity) sumcommodities
            toamount      = head $ filter ((==tocommodity).acommodity) sumamounts
            unitprice     = toamount `divideAmount` (aquantity fromamount)
            unitprecision = max 2 ((asprecision $ astyle $ toamount) + (asprecision $ astyle $ fromamount))
    inferprice p = p

-- Get a transaction's secondary date, defaulting to the primary date.
transactionDate2 :: Transaction -> Day
transactionDate2 t = fromMaybe (tdate t) $ tdate2 t

-- | Ensure a transaction's postings refer back to it, so that eg
-- relatedPostings works right.
txnTieKnot :: Transaction -> Transaction
txnTieKnot t@Transaction{tpostings=ps} = t' where
    t' = t{tpostings=map (postingSetTransaction t') ps}

-- | Ensure a transaction's postings do not refer back to it, so that eg
-- recursiveSize and GHCI's :sprint work right.
txnUntieKnot :: Transaction -> Transaction
txnUntieKnot t@Transaction{tpostings=ps} = t{tpostings=map (\p -> p{ptransaction=Nothing}) ps}

-- | Set a posting's parent transaction.
postingSetTransaction :: Transaction -> Posting -> Posting
postingSetTransaction t p = p{ptransaction=Just t}

tests_Hledger_Data_Transaction = TestList $ concat [
  tests_postingAsLines,
  tests_showTransactionUnelided,
  tests_inference,
  [
  "showTransaction" ~: do
     assertEqual "show a balanced transaction, eliding last amount"
       (unlines
        ["2007/01/28 coopportunity"
        ,"    expenses:food:groceries          $47.18"
        ,"    assets:checking"
        ,""
        ])
       (let t = Transaction 0 nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "coopportunity" "" []
                [posting{paccount="expenses:food:groceries", pamount=Mixed [usd 47.18], ptransaction=Just t}
                ,posting{paccount="assets:checking", pamount=Mixed [usd (-47.18)], ptransaction=Just t}
                ] ""
        in showTransaction t)

  ,"showTransaction" ~: do
     assertEqual "show a balanced transaction, no eliding"
       (unlines
        ["2007/01/28 coopportunity"
        ,"    expenses:food:groceries          $47.18"
        ,"    assets:checking                 $-47.18"
        ,""
        ])
       (let t = Transaction 0 nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "coopportunity" "" []
                [posting{paccount="expenses:food:groceries", pamount=Mixed [usd 47.18], ptransaction=Just t}
                ,posting{paccount="assets:checking", pamount=Mixed [usd (-47.18)], ptransaction=Just t}
                ] ""
        in showTransactionUnelided t)

     -- document some cases that arise in debug/testing:
  ,"showTransaction" ~: do
     assertEqual "show an unbalanced transaction, should not elide"
       (unlines
        ["2007/01/28 coopportunity"
        ,"    expenses:food:groceries          $47.18"
        ,"    assets:checking                 $-47.19"
        ,""
        ])
       (showTransaction
        (txnTieKnot $ Transaction 0 nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "coopportunity" "" []
         [posting{paccount="expenses:food:groceries", pamount=Mixed [usd 47.18]}
         ,posting{paccount="assets:checking", pamount=Mixed [usd (-47.19)]}
         ] ""))

  ,"showTransaction" ~: do
     assertEqual "show an unbalanced transaction with one posting, should not elide"
       (unlines
        ["2007/01/28 coopportunity"
        ,"    expenses:food:groceries          $47.18"
        ,""
        ])
       (showTransaction
        (txnTieKnot $ Transaction 0 nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "coopportunity" "" []
         [posting{paccount="expenses:food:groceries", pamount=Mixed [usd 47.18]}
         ] ""))

  ,"showTransaction" ~: do
     assertEqual "show a transaction with one posting and a missing amount"
       (unlines
        ["2007/01/28 coopportunity"
        ,"    expenses:food:groceries"
        ,""
        ])
       (showTransaction
        (txnTieKnot $ Transaction 0 nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "coopportunity" "" []
         [posting{paccount="expenses:food:groceries", pamount=missingmixedamt}
         ] ""))

  ,"showTransaction" ~: do
     assertEqual "show a transaction with a priced commodityless amount"
       (unlines
        ["2010/01/01 x"
        ,"    a          1 @ $2"
        ,"    b"
        ,""
        ])
       (showTransaction
        (txnTieKnot $ Transaction 0 nullsourcepos (parsedate "2010/01/01") Nothing Unmarked "" "x" "" []
         [posting{paccount="a", pamount=Mixed [num 1 `at` (usd 2 `withPrecision` 0)]}
         ,posting{paccount="b", pamount= missingmixedamt}
         ] ""))

  ,"balanceTransaction" ~: do
     assertBool "detect unbalanced entry, sign error"
                    (isLeft $ balanceTransaction Nothing
                           (Transaction 0 nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "test" "" []
                            [posting{paccount="a", pamount=Mixed [usd 1]}
                            ,posting{paccount="b", pamount=Mixed [usd 1]}
                            ] ""))

     assertBool "detect unbalanced entry, multiple missing amounts"
                    (isLeft $ balanceTransaction Nothing
                           (Transaction 0 nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "test" "" []
                            [posting{paccount="a", pamount=missingmixedamt}
                            ,posting{paccount="b", pamount=missingmixedamt}
                            ] ""))

     let e = balanceTransaction Nothing (Transaction 0 nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "" "" []
                           [posting{paccount="a", pamount=Mixed [usd 1]}
                           ,posting{paccount="b", pamount=missingmixedamt}
                           ] "")
     assertBool "balanceTransaction allows one missing amount" (isRight e)
     assertEqual "balancing amount is inferred"
                     (Mixed [usd (-1)])
                     (case e of
                        Right e' -> (pamount $ last $ tpostings e')
                        Left _ -> error' "should not happen")

     let e = balanceTransaction Nothing (Transaction 0 nullsourcepos (parsedate "2011/01/01") Nothing Unmarked "" "" "" []
                           [posting{paccount="a", pamount=Mixed [usd 1.35]}
                           ,posting{paccount="b", pamount=Mixed [eur (-1)]}
                           ] "")
     assertBool "balanceTransaction can infer conversion price" (isRight e)
     assertEqual "balancing conversion price is inferred"
                     (Mixed [usd 1.35 @@ (eur 1 `withPrecision` maxprecision)])
                     (case e of
                        Right e' -> (pamount $ head $ tpostings e')
                        Left _ -> error' "should not happen")

     assertBool "balanceTransaction balances based on cost if there are unit prices" (isRight $
       balanceTransaction Nothing (Transaction 0 nullsourcepos (parsedate "2011/01/01") Nothing Unmarked "" "" "" []
                           [posting{paccount="a", pamount=Mixed [usd 1 `at` eur 2]}
                           ,posting{paccount="a", pamount=Mixed [usd (-2) `at` eur 1]}
                           ] ""))

     assertBool "balanceTransaction balances based on cost if there are total prices" (isRight $
       balanceTransaction Nothing (Transaction 0 nullsourcepos (parsedate "2011/01/01") Nothing Unmarked "" "" "" []
                           [posting{paccount="a", pamount=Mixed [usd 1    @@ eur 1]}
                           ,posting{paccount="a", pamount=Mixed [usd (-2) @@ eur 1]}
                           ] ""))

  ,"isTransactionBalanced" ~: do
     let t = Transaction 0 nullsourcepos (parsedate "2009/01/01") Nothing Unmarked "" "a" "" []
             [posting{paccount="b", pamount=Mixed [usd 1.00], ptransaction=Just t}
             ,posting{paccount="c", pamount=Mixed [usd (-1.00)], ptransaction=Just t}
             ] ""
     assertBool "detect balanced" (isTransactionBalanced Nothing t)
     let t = Transaction 0 nullsourcepos (parsedate "2009/01/01") Nothing Unmarked "" "a" "" []
             [posting{paccount="b", pamount=Mixed [usd 1.00], ptransaction=Just t}
             ,posting{paccount="c", pamount=Mixed [usd (-1.01)], ptransaction=Just t}
             ] ""
     assertBool "detect unbalanced" (not $ isTransactionBalanced Nothing t)
     let t = Transaction 0 nullsourcepos (parsedate "2009/01/01") Nothing Unmarked "" "a" "" []
             [posting{paccount="b", pamount=Mixed [usd 1.00], ptransaction=Just t}
             ] ""
     assertBool "detect unbalanced, one posting" (not $ isTransactionBalanced Nothing t)
     let t = Transaction 0 nullsourcepos (parsedate "2009/01/01") Nothing Unmarked "" "a" "" []
             [posting{paccount="b", pamount=Mixed [usd 0], ptransaction=Just t}
             ] ""
     assertBool "one zero posting is considered balanced for now" (isTransactionBalanced Nothing t)
     let t = Transaction 0 nullsourcepos (parsedate "2009/01/01") Nothing Unmarked "" "a" "" []
             [posting{paccount="b", pamount=Mixed [usd 1.00], ptransaction=Just t}
             ,posting{paccount="c", pamount=Mixed [usd (-1.00)], ptransaction=Just t}
             ,posting{paccount="d", pamount=Mixed [usd 100], ptype=VirtualPosting, ptransaction=Just t}
             ] ""
     assertBool "virtual postings don't need to balance" (isTransactionBalanced Nothing t)
     let t = Transaction 0 nullsourcepos (parsedate "2009/01/01") Nothing Unmarked "" "a" "" []
             [posting{paccount="b", pamount=Mixed [usd 1.00], ptransaction=Just t}
             ,posting{paccount="c", pamount=Mixed [usd (-1.00)], ptransaction=Just t}
             ,posting{paccount="d", pamount=Mixed [usd 100], ptype=BalancedVirtualPosting, ptransaction=Just t}
             ] ""
     assertBool "balanced virtual postings need to balance among themselves" (not $ isTransactionBalanced Nothing t)
     let t = Transaction 0 nullsourcepos (parsedate "2009/01/01") Nothing Unmarked "" "a" "" []
             [posting{paccount="b", pamount=Mixed [usd 1.00], ptransaction=Just t}
             ,posting{paccount="c", pamount=Mixed [usd (-1.00)], ptransaction=Just t}
             ,posting{paccount="d", pamount=Mixed [usd 100], ptype=BalancedVirtualPosting, ptransaction=Just t}
             ,posting{paccount="3", pamount=Mixed [usd (-100)], ptype=BalancedVirtualPosting, ptransaction=Just t}
             ] ""
     assertBool "balanced virtual postings need to balance among themselves (2)" (isTransactionBalanced Nothing t)

  ]]
