haslo 0.1.1 → 0.1.2
raw patch · 3 files changed
+261/−16 lines, 3 files
Files
- Haslo.hs +12/−12
- Haslo/HasloQCTestL.hs +243/−0
- haslo.cabal +6/−4
Haslo.hs view
@@ -11,15 +11,15 @@ -- | Haslo aplication interface. The only module from haslo library you need to import. --------------------------------------------------------- -module Haslo+module Haslo (module Haslo.Parameters ,module Haslo.ErrorHandling ,module Haslo.InstalmentPlan ,module Haslo.InstalmentPlanProps ,module Haslo.CalcConfigurationType ,module Haslo.CalcConstructors - ,module Haslo.Calculator- ,getVersionHaslo+ ,module Haslo.Calculator + ,getVersionHaslo ) where @@ -29,12 +29,12 @@ import Haslo.InstalmentPlanProps import Haslo.CalcConfigurationType import Haslo.CalcConstructors -import Haslo.Calculator---- | Human friendly formatet output of list wrapped in the Either.--- Usefull for quick validation of loan constructors.-niceShow :: (Show a, Show a1) => Either a1 [a] -> IO ()-niceShow (Right xs) = mapM_ (putStrLn . show) xs-niceShow (Left err) = putStrLn $ show err--getVersionHaslo = "0.1.1"+import Haslo.Calculator + +-- | Human friendly formatet output of list wrapped in the Either. +-- Usefull for quick validation of loan constructors. +niceShow :: (Show a, Show a1) => Either a1 [a] -> IO () +niceShow (Right xs) = mapM_ (putStrLn . show) xs +niceShow (Left err) = putStrLn $ show err + +getVersionHaslo = "0.1.2"
+ Haslo/HasloQCTestL.hs view
@@ -0,0 +1,243 @@+--------------------------------------------------------- +-- +-- Module : HasloQCTestL +-- Copyright : Bartosz Wójcik (2011) +-- License : BSD3 +-- +-- Maintainer : bartek@sudety.it +-- Stability : Unstable +-- Portability : portable +-- +-- Part of haslo. Data types used for Quick Check. +-- Properties set up. +--------------------------------------------------------- +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} +module Haslo.HasloQCTestL +where + +import Haslo +import Data.List +import Data.Time +import Test.QuickCheck +import Text.PrettyShow + +caps = choose (1000::Amount,100000000) +caps' b = choose (b::Amount,100000000) + + +class Show a => ShowShort a where + showShort :: a -> String + +data GUIClassic = CL1 Classical + | CL2 Balloon + | CL3 BalloonPlus + | CL4 ReversBalloon + | CL5 Bullet + | CL6 UnfdBalloon + | CL7 UnfdBalloonPlus + deriving (Eq, Ord) + +instance Show GUIClassic where + show (CL1 l) = show l + show (CL2 l) = show l + show (CL3 l) = show l + show (CL4 l) = show l + show (CL5 l) = show l + show (CL6 l) = show l + show (CL7 l) = show l + + + +instance PrettyShow GUIClassic where + showWithLen n = showWithLen n . show + +instance ShowShort GUIClassic where + showShort = filter (/= '(') . head . drop 1 . words . show + +instance Enum GUIClassic where + toEnum 0 = CL1 $ Classical 0 0 0 0 + toEnum 1 = CL2 $ Balloon 0 0 0 0 0 + toEnum 2 = CL3 $ BalloonPlus 0 0 0 0 0 + toEnum 3 = CL4 $ ReversBalloon 0 0 0 0 0 + toEnum 4 = CL5 $ Bullet 0 0 0 0 + toEnum 5 = CL6 $ UnfdBalloon 0 0 0 0 0 0 + toEnum 6 = CL7 $ UnfdBalloonPlus 0 0 0 0 0 0 +-- toEnum x = toEnum $ x `mod` 7 + + fromEnum (CL1 _) = 0 + fromEnum (CL2 _) = 1 + fromEnum (CL3 _) = 2 + fromEnum (CL4 _) = 3 + fromEnum (CL5 _) = 4 + fromEnum (CL6 _) = 5 + fromEnum (CL7 _) = 6 + +instance ClassicLoan GUIClassic where + newLoanI (CL1 x) = newLoanI x + newLoanI (CL2 x) = newLoanI x + newLoanI (CL3 x) = newLoanI x + newLoanI (CL4 x) = newLoanI x + newLoanI (CL5 x) = newLoanI x + newLoanI (CL6 x) = newLoanI x + newLoanI (CL7 x) = newLoanI x + + extract (CL1 x) = extract x + extract (CL2 x) = extract x + extract (CL3 x) = extract x + extract (CL4 x) = extract x + extract (CL5 x) = extract x + extract (CL6 x) = extract x + extract (CL7 x) = extract x + +instance Balloons GUIClassic where + balloon (CL2 x) = balloon x + balloon (CL3 x) = balloon x + balloon (CL5 x) = balloon x + balloon (CL6 x) = balloon x + balloon (CL7 x) = balloon x + balloon l = error $ show l ++ " is not a balloon" + +instance UnfdBalloons GUIClassic where + eXtendedDuration (CL6 x) = eXtendedDuration x + eXtendedDuration (CL7 x) = eXtendedDuration x + eXtendedDuration l = error $ show l ++ " is not a UnfdBalloon" + +{- +data GUIFee = Fee1 FeeFinanced + | Fee2 FeeAsLateInterest + | Fee3 FeeLimitingFstInstalment + deriving (Eq, Ord, Show) + +instance Enum GUIFee where + toEnum 0 = Fee1 FeeFinanced + toEnum 1 = Fee2 FeeAsLateInterest + toEnum 2 = Fee3 FeeLimitingFstInstalment + + fromEnum (Fee1 _) = 0 + fromEnum (Fee2 _) = 1 + fromEnum (Fee3 _) = 2 + +instance FeeClass GUIFee where + addFee (Fee1 _) = addFee FeeFinanced + addFee (Fee2 _) = addFee FeeAsLateInterest + addFee (Fee3 _) = addFee FeeLimitingFstInstalment + +instance ShowShort GUIFee where + showShort = head . drop 1 . words . show + + +feeList = take 3 $ map showShort [Fee1 FeeFinanced ..] +-} + +-- | Poperties of instalment loan for given input parameters. +instance Arbitrary GUIClassic where + arbitrary = do + p <- frequency [--(15,return paramDT), + (70,return paramMT), + (30,return paramYT)] + -- Duration limited to 30 years + n <- choose (3::Duration, 30 * (freqPerYear $ freq p)) + + -- Deferment limited to 12 instalments + d <- choose (0::Duration,12) + + -- Interest rate limited to 20%. Selected like for humans: max 4 digits after decimal point. + r <- frequency [(1,return 0) + ,(99,liftM ((/10^6) . fromIntegral) $ choose (0::Int,2*10^5))+ ] + + -- Balloon amount and capital limited to 10^8 (in this makes 10^6) + b <- caps + c <- caps + cBal <- caps' b + + -- Instalment for reversal balloon limited to 10^6 (in this makes 10^4) + i <- choose (0::Amount,100000) + + -- Capital of reversal balloon selected so, that balloon amount will be positive + cRevBal <- choose (calcCapCl (fromIntegral i) n (cE2N (freq p) r) d + ,i * fromIntegral n * 2 + 1000000) + + -- Max duration of extended period of UnfdBalloons limited so that total duration doesn't extend 30 years + x <- choose (1::Duration, 30 * (freqPerYear $ freq p) - n + 1) + + oneof [return $ CL1 $ Classical c n d r + ,return $ CL2 $ Balloon cBal n d r b + ,return $ CL3 $ BalloonPlus cBal n d r b + ,return $ CL4 $ ReversBalloon cRevBal n d r i + ,return $ CL5 $ Bullet c n 0 r + ,return $ CL6 $ UnfdBalloon cBal n d r b x + ,return $ CL7 $ UnfdBalloonPlus cBal n d r b x + ] + +data TestL = TestL (GUIClassic,InstalmentPlanParam) + +instance Show TestL where + show (TestL (loan, IPP fr rd)) = show loan ++ " " ++ showWithLen 8 fr ++ showWithLen 9 rd + +instance Arbitrary TestL where + arbitrary = do + l <- arbitrary + p <- if duration (extract l) <= 30 + then frequency [--(15,return paramDT), + (10,return paramMR), + (40,return paramYR), + (10,return paramMT), + (40,return paramYT)] + else oneof [return paramMT + ,return paramMR + ] + return $ TestL (l, p) + + +instance Testable (ValidMonad Bool) where + property (Right b) = property b + property (Left err) = property False + +instance Testable (ValidMonad ()) where + property (Right _) = property True + property (Left err) = error $ show err + + +testLoan :: TestL -> ValidMonad InstalmentPlan +testLoan (TestL (loan, ipp)) = runWithIPP ipp $ newLoanI loan + + +propInstPlan :: TestL -> ValidMonad Bool +propInstPlan p@(TestL (loan, ipp)) = testLoan p >>= \ip -> + return (instalmentPlanCheck (principal $ extract loan) (fstInst p) ip) + +--propInstPlan :: TestL -> ValidMonad Bool +--propInstPlan p@(TestL (_,_,amt,_,_,_)) = testLoan p >>= \ip -> +-- return (instalmentPlanCheck amt (fstInst p) ip) + +--propInstPlanM :: TestL -> ValidMonad () +--propInstPlanM p@(TestL (_,_,amt,_,_,_)) = testLoan p >>= +-- instalmentPlanCheckM amt (fstInst p) + +fstInst :: TestL -> Double +fstInst (TestL (CL5 (Bullet amt dur def rat), ipp)) = + fromIntegral $ myRound (rounding ipp) $ rawCalcMaxFstInst (fromIntegral amt) dur (cE2N (freq ipp) rat) def +fstInst _ = 0 + +instance Arbitrary Freq where + arbitrary = oneof [return Daily, return Monthly, return Yearly] + +-- | Properity of interest rate conversion. +-- Interest rate has to be positive. +-- Daily interest rate not greater than 100%. +prop_cEN :: (Freq,Double) -> Property +prop_cEN (f,x) = x >= 0 && (x <= 1 || f /= Daily) ==> abs (cE2N f (cN2E f x) - x) <= x * 1e-12 + + +-- | Interest rate property doesn't work for Bullet and UnfdBalloon loans +propRate :: TestL -> ValidMonad Bool +propRate p@(TestL (loan, ipp@(IPP _ Truncated))) | fromEnum loan `elem` [0,1,2,3] = + testLoan p >>= rateCheckTruncated (principal $ extract loan) (fstInst p) r + | otherwise = return True + where r = cE2N (freq ipp) (rate $ extract loan) +propRate p@(TestL (loan, ipp@(IPP _ Rounded))) | fromEnum loan `elem` [0,1,2,3] = + testLoan p >>= rateCheckRounded (principal $ extract loan) (fstInst p) r + | otherwise = return True + where r = cE2N (freq ipp) (rate $ extract loan) +
haslo.cabal view
@@ -1,6 +1,6 @@ Name: haslo -Version: 0.1.1 -License: BSD3+Version: 0.1.2 +License: BSD3 License-file: license Author: Bartosz Wojcik Maintainer: Bartosz Wojcik <bartoszmwojcik@gmail.com> @@ -9,8 +9,8 @@ Synopsis: Loan calculator engine. Stability: experimental Build-type: Simple -Description: Loan calculator engine implementing rules mentioned in paper "Haskell Loan Library".- See more here: https://github.com/bartoszw/haslo/blob/master/haslo.pdf.+Description: Loan calculator engine implementing rules mentioned in paper "Haskell Loan Library". + See more here: https://github.com/bartoszw/haslo/blob/master/haslo.pdf. Acronym from Haskell Loan. Cabal-Version: >=1.2.3 @@ -30,9 +30,11 @@ Executable hasloQC Build-Depends: old-time, QuickCheck, mtl, time, wtk + Other-Modules: Haslo.HasloQCTestL Main-Is: HasloQC.hs Executable hasloSample Build-Depends: old-time, QuickCheck, mtl, time, wtk + Other-Modules: Haslo.HasloQCTestL Main-Is: Sample.hs