(by_unit b1)
}
--- * The 'Equilibre' type
+-- * The 'Deviation' type
--- | See 'equilibre'.
-newtype Equilibre
- = Equilibre By_Unit
+-- | The 'By_Unit' whose 'Unit_Sum's’ 'amount'
+-- is not zero and possible 'Account' to 'infer_equilibrium'.
+newtype Deviation
+ = Deviation By_Unit
deriving (Data, Eq, Read, Show, Typeable)
-- | Return the 'by_unit' of the given 'Balance' with:
-- * and remaining 'Unit's having their 'Unit_Sum' 'accounts'
-- complemented with the 'by_account' of the given 'Balance'
-- (i.e. now mapping to accounts __not__ involved to build the 'Unit_Sum').
-equilibre :: Balance -> Equilibre
-equilibre balance = do
+deviation :: Balance -> Deviation
+deviation balance = do
let all_accounts = Lib.TreeMap.flatten (const ()) (by_account balance)
let max_accounts = Data.Map.size all_accounts
- Equilibre $
+ Deviation $
Data.Map.foldlWithKey
(\m unit Unit_Sum{amount, accounts} ->
if Amount.is_zero amount
Data.Map.empty
(by_unit balance)
-
--- | Return either:
+-- | Return the 'Balance' of the given 'Posting's and either:
--
--- * 'Left': the 'Posting.By_Account's (lazy list) that cannot be inferred
--- * 'Right': the given 'Posting.By_Account's with inferred 'Amount's inserted.
-infer_equilibre
+-- * 'Left': the 'Posting's that cannot be inferred.
+-- * 'Right': the given 'Posting's with inferred 'Amount's inserted.
+infer_equilibrium
:: Posting.By_Account
- -> Either [Unit_Sum]
- Posting.By_Account
-infer_equilibre ps = do
+ -> (Balance, Either [Unit_Sum] Posting.By_Account)
+infer_equilibrium ps = do
let bal = postings ps nil
- let Equilibre equ = equilibre bal
- (\(l, r) -> case l of
- _:_ -> Left l
- _ -> Right r) $ do
+ let Deviation dev = deviation bal
+ (\(l, r) -> (bal, case l of { [] -> Right r; _ -> Left l })) $ do
Lib.Foldable.accumLeftsAndFoldrRights
(\p -> Data.Map.insertWith
(\pn -> (++) pn . Data.List.filter (not . Data.Map.null . Posting.amounts))
Data.Foldable.foldr
(\unit_sum@(Unit_Sum{ amount=amt, accounts }) acc ->
case Data.Map.size accounts of
- 0 -> acc
1 -> (Right $ (Posting.nil $ fst $ Data.Map.elemAt 0 accounts)
- { Posting.amounts = Amount.from_List [negate amt] }
- ):acc
- _ -> Left [unit_sum]:acc
- )
+ { Posting.amounts = Amount.from_List [negate amt] }):acc
+ _ -> Left [unit_sum]:acc)
[]
- equ
+ dev
-- ** Tests
--- | Return 'True' if and only if the given 'Equilibre' satisfies:
---
--- * 'is_equilibrated',
--- * or 'is_inferrable'.
-is_equilibrable :: Equilibre -> Bool
-is_equilibrable e@(Equilibre eq) =
- Data.Map.null eq || is_inferrable e
-
--- | Return 'True' if and only if the given 'Equilibre' maps no 'Unit'.
-is_equilibrated :: Equilibre -> Bool
-is_equilibrated (Equilibre eq) = Data.Map.null eq
+-- | Return 'True' if and only if the given 'Deviation' maps no 'Unit'.
+is_at_equilibrium :: Deviation -> Bool
+is_at_equilibrium (Deviation dev) = Data.Map.null dev
--- | Return 'True' if and only if the given 'Equilibre'
+-- | Return 'True' if and only if the given 'Deviation'
-- maps only to 'Unit_Sum's whose 'accounts'
-- maps exactly one 'Account'.
-is_inferrable :: Equilibre -> Bool
-is_inferrable (Equilibre eq) =
+is_equilibrium_inferrable :: Deviation -> Bool
+is_equilibrium_inferrable (Deviation dev) =
Data.Foldable.all
(\Unit_Sum{accounts} -> Data.Map.size accounts == 1)
- eq
+ dev
--- | Return 'True' if and only if the given 'Equilibre'
+-- | Return 'True' if and only if the given 'Deviation'
-- maps to at least one 'Unit_Sum's whose 'accounts'
-- maps more than one 'Account'.
-is_non_inferrable :: Equilibre -> Bool
-is_non_inferrable (Equilibre eq) =
+is_equilibrium_non_inferrable :: Deviation -> Bool
+is_equilibrium_non_inferrable (Deviation dev) =
Data.Foldable.any
(\Unit_Sum{accounts} -> Data.Map.size accounts > 1)
- eq
+ dev
-- * The 'Expanded' type
--- | See 'expand'.
+-- | Descending propagation of 'Amount's accross 'Account's.
type Expanded = Lib.TreeMap.TreeMap Account.Name Account_Sum_Expanded
data Account_Sum_Expanded
= Account_Sum_Expanded
-- * and every mapped Amount.'Amount.By_Unit'
-- added with any Amount.'Amount.By_Unit'
-- of the 'Account's’ for which it is 'Account.ascending'.
-expand :: By_Account -> Expanded
-expand =
+expanded :: By_Account -> Expanded
+expanded =
Lib.TreeMap.map_by_depth_first
(\descendants value ->
let exc = fromMaybe Data.Map.empty value in
Data.Map.foldr
( Data.Map.unionWith (GHC.Num.+)
. ( inclusive
- . fromMaybe (error "Oops, should not happen in: Hcompta.Calc.Balance.expand")
+ . fromMaybe (error "Oops, should not happen in: Hcompta.Calc.Balance.expanded")
. Lib.TreeMap.node_value) )
exc $ Lib.TreeMap.nodes $ descendants
})
}
]
}
+ , "[A+$1, B+$1]" ~:
+ (Data.List.foldl
+ (flip Calc.Balance.posting)
+ Calc.Balance.nil
+ [ (Posting.nil ("A":|[]))
+ { Posting.amounts=Amount.from_List [ Amount.usd $ 1 ]
+ }
+ , (Posting.nil ("B":|[]))
+ { Posting.amounts=Amount.from_List [ Amount.usd $ 1 ]
+ }
+ ])
+ ~?=
+ Calc.Balance.Balance
+ { Calc.Balance.by_account =
+ Lib.TreeMap.from_List const
+ [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
+ , ("B":|[], Amount.from_List [ Amount.usd $ 1 ])
+ ]
+ , Calc.Balance.by_unit =
+ Data.Map.fromList $
+ Data.List.map Calc.Balance.assoc_unit_sum $
+ [ Calc.Balance.Unit_Sum
+ { Calc.Balance.amount = Amount.usd $ 2
+ , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
+ ["A":|[], "B":|[]]
+ }
+ ]
+ }
, "[A+$1+€2, A-$1-€2] = {A+$0+€0, $+0 €+0}" ~:
(Data.List.foldl
(flip Calc.Balance.posting)
]
}
]
- , "expand" ~: TestList
+ , "expanded" ~: TestList
[ "nil_By_Account" ~:
- Calc.Balance.expand
+ Calc.Balance.expanded
Calc.Balance.nil_By_Account
~?=
Lib.TreeMap.empty
, "A+$1 = A+$1" ~:
- Calc.Balance.expand
+ Calc.Balance.expanded
(Lib.TreeMap.from_List const
[ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ])
~?=
})
])
, "A/A+$1 = A+$1 A/A+$1" ~:
- Calc.Balance.expand
+ Calc.Balance.expanded
(Lib.TreeMap.from_List const
[ ("A":|["A"], Amount.from_List [ Amount.usd $ 1 ]) ])
~?=
})
])
, "A/B+$1 = A+$1 A/B+$1" ~:
- Calc.Balance.expand
+ Calc.Balance.expanded
(Lib.TreeMap.from_List const
[ ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ]) ])
~?=
})
])
, "A/B/C+$1 = A+$1 A/B+$1 A/B/C+$1" ~:
- Calc.Balance.expand
+ Calc.Balance.expanded
(Lib.TreeMap.from_List const
[ ("A":|["B", "C"], Amount.from_List [ Amount.usd $ 1 ]) ])
~?=
})
])
, "A+$1 A/B+$1 = A+$2 A/B+$1" ~:
- Calc.Balance.expand
+ Calc.Balance.expanded
(Lib.TreeMap.from_List const
[ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
, ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ])
})
])
, "A+$1 A/B+$1 A/B/C+$1 = A+$3 A/B+$2 A/B/C+$1" ~:
- Calc.Balance.expand
+ Calc.Balance.expanded
(Lib.TreeMap.from_List const
[ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
, ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ])
})
])
, "A+$1 A/B+$1 A/B/C+$1 A/B/C/D+$1 = A+$4 A/B+$3 A/B/C+$2 A/B/C/D+$1" ~:
- Calc.Balance.expand
+ Calc.Balance.expanded
(Lib.TreeMap.from_List const
[ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
, ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ])
})
])
, "A+$1 A/B+$1 A/BB+$1 AA/B+$1 = A+$3 A/B+$1 A/BB+$1 AA+$1 AA/B+$1" ~:
- Calc.Balance.expand
+ Calc.Balance.expanded
(Lib.TreeMap.from_List const
[ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
, ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ])
})
])
]
- , "equilibre" ~: TestList
+ , "deviation" ~: TestList
[ "{A+$1, $1}" ~:
- (Calc.Balance.equilibre $
+ (Calc.Balance.deviation $
Calc.Balance.Balance
{ Calc.Balance.by_account =
Lib.TreeMap.from_List const
]
})
~?=
- (Calc.Balance.Equilibre $
+ (Calc.Balance.Deviation $
Data.Map.fromList $
Data.List.map Calc.Balance.assoc_unit_sum $
[ Calc.Balance.Unit_Sum
["B":|[]]
}
])
+ , "{A+$1 B+$1, $2}" ~:
+ (Calc.Balance.deviation $
+ Calc.Balance.Balance
+ { Calc.Balance.by_account =
+ Lib.TreeMap.from_List const
+ [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
+ , ("B":|[], Amount.from_List [ Amount.usd $ 1 ])
+ ]
+ , Calc.Balance.by_unit =
+ Data.Map.fromList $
+ Data.List.map Calc.Balance.assoc_unit_sum $
+ [ Calc.Balance.Unit_Sum
+ { Calc.Balance.amount = Amount.usd $ 2
+ , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
+ [ "A":|[]
+ , "B":|[]
+ ]
+ }
+ ]
+ })
+ ~?=
+ (Calc.Balance.Deviation $
+ Data.Map.fromList $
+ Data.List.map Calc.Balance.assoc_unit_sum $
+ [ Calc.Balance.Unit_Sum
+ { Calc.Balance.amount = Amount.usd $ 2
+ , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
+ [
+ ]
+ }
+ ])
]
- , "is_equilibrable" ~: TestList
+ , "is_equilibrium_inferrable" ~: TestList
[ "nil" ~: TestCase $
(@=?) True $
- Calc.Balance.is_equilibrable $
- Calc.Balance.equilibre $
+ Calc.Balance.is_equilibrium_inferrable $
+ Calc.Balance.deviation $
Calc.Balance.nil
, "{A+$0, $+0}" ~: TestCase $
(@=?) True $
- Calc.Balance.is_equilibrable $
- Calc.Balance.equilibre $
+ Calc.Balance.is_equilibrium_inferrable $
+ Calc.Balance.deviation $
Calc.Balance.Balance
{ Calc.Balance.by_account =
Lib.TreeMap.from_List const
}
, "{A+$1, $+1}" ~: TestCase $
(@=?) False $
- Calc.Balance.is_equilibrable $
- Calc.Balance.equilibre $
+ Calc.Balance.is_equilibrium_inferrable $
+ Calc.Balance.deviation $
Calc.Balance.Balance
{ Calc.Balance.by_account =
Lib.TreeMap.from_List const
}
, "{A+$0+€0, $0 €+0}" ~: TestCase $
(@=?) True $
- Calc.Balance.is_equilibrable $
- Calc.Balance.equilibre $
+ Calc.Balance.is_equilibrium_inferrable $
+ Calc.Balance.deviation $
Calc.Balance.Balance
{ Calc.Balance.by_account =
Lib.TreeMap.from_List const
}
, "{A+$1, B-$1, $+0}" ~: TestCase $
(@=?) True $
- Calc.Balance.is_equilibrable $
- Calc.Balance.equilibre $
+ Calc.Balance.is_equilibrium_inferrable $
+ Calc.Balance.deviation $
Calc.Balance.Balance
{ Calc.Balance.by_account =
Lib.TreeMap.from_List const
}
, "{A+$1 B, $+1}" ~: TestCase $
(@=?) True $
- Calc.Balance.is_equilibrable $
- Calc.Balance.equilibre $
+ Calc.Balance.is_equilibrium_inferrable $
+ Calc.Balance.deviation $
Calc.Balance.Balance
{ Calc.Balance.by_account =
Lib.TreeMap.from_List const
}
, "{A+$1 B+€1, $+1 €+1}" ~: TestCase $
(@=?) True $
- Calc.Balance.is_equilibrable $
- Calc.Balance.equilibre $
+ Calc.Balance.is_equilibrium_inferrable $
+ Calc.Balance.deviation $
Calc.Balance.Balance
{ Calc.Balance.by_account =
Lib.TreeMap.from_List const
}
, "{A+$1 B-$1+€1, $+0 €+1}" ~: TestCase $
(@=?) True $
- Calc.Balance.is_equilibrable $
- Calc.Balance.equilibre $
+ Calc.Balance.is_equilibrium_inferrable $
+ Calc.Balance.deviation $
Calc.Balance.Balance
{ Calc.Balance.by_account =
Lib.TreeMap.from_List const
}
, "{A+$1+€2+£3 B-$1-€2-£3, $+0 €+0 £+0}" ~: TestCase $
(@=?) True $
- Calc.Balance.is_equilibrable $
- Calc.Balance.equilibre $
+ Calc.Balance.is_equilibrium_inferrable $
+ Calc.Balance.deviation $
Calc.Balance.Balance
{ Calc.Balance.by_account =
Lib.TreeMap.from_List const
]
}
]
- , "infer_equilibre" ~: TestList
+ , "infer_equilibrium" ~: TestList
[ "{A+$1 B}" ~:
- (Calc.Balance.infer_equilibre $
+ (snd $ Calc.Balance.infer_equilibrium $
Posting.from_List
[ (Posting.nil ("A":|[]))
{ Posting.amounts=Amount.from_List [ Amount.usd $ 1 ] }
{ Posting.amounts=Amount.from_List [ Amount.usd $ -1 ] }
])
, "{A+$1 B-1€}" ~:
- (Calc.Balance.infer_equilibre $
+ (snd $ Calc.Balance.infer_equilibrium $
Posting.from_List
[ (Posting.nil ("A":|[]))
{ Posting.amounts=Amount.from_List [ Amount.usd $ 1 ] }
, (Posting.nil ("B":|[]))
{ Posting.amounts=Amount.from_List [ Amount.eur $ -1 ] }
])
+ , "{A+$1 B+$1}" ~:
+ (snd $ Calc.Balance.infer_equilibrium $
+ Posting.from_List
+ [ (Posting.nil ("A":|[]))
+ { Posting.amounts=Amount.from_List [ Amount.usd $ 1 ] }
+ , (Posting.nil ("B":|[]))
+ { Posting.amounts=Amount.from_List [ Amount.usd $ 1 ] }
+ ])
+ ~?=
+ (Left
+ [ Calc.Balance.Unit_Sum
+ { Calc.Balance.amount = Amount.usd $ 2
+ , Calc.Balance.accounts = Data.Map.fromList []}
+ ])
]
]
]
sourcephile / git / comptalang.git / commitdiff