{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveAnyClass #-}
module Lib
(Amount,Rate,Dates,Period(..),Balance
,StartDate,EndDate,daysBetween,daysBetweenI
,Spread,Date
,paySeqLiabilities,prorataFactors
,afterNPeriod,Ts(..),periodsBetween
,periodRateFromAnnualRate
,Floor,Cap,TsPoint(..)
,toDate,toDates,genDates,nextDate
,getValOnByDate,getIntValOnByDate,sumValTs,subTsBetweenDates,splitTsByDate
,paySeqLiabilitiesAmt,getIntervalDays,getIntervalFactors
,zipWith8,zipWith9,zipWith10,zipWith11,zipWith12
,weightedBy, mkTs
,mkRateTs,paySeqLiabResi
) where
import qualified Data.Time as T
import qualified Data.Time.Format as TF
import Data.List
import qualified Data.Map as M
import Language.Haskell.TH
import Data.Aeson.TH
import Data.Aeson.Types
import Data.Aeson hiding (json)
import Text.Regex.TDFA
import Data.Fixed (Fixed(..), HasResolution,Centi, resolution)
import Data.Ratio
import Types
import Control.Lens
import Data.List.Lens
import Control.Lens.TH
import Debug.Trace
debug :: c -> String -> c
debug = (String -> c -> c) -> c -> String -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> c -> c
forall a. String -> a -> a
trace
periodRateFromAnnualRate :: Period -> IRate -> IRate
periodRateFromAnnualRate :: Period -> IRate -> IRate
periodRateFromAnnualRate Period
Annually IRate
annual_rate = IRate
annual_rate
periodRateFromAnnualRate Period
Monthly IRate
annual_rate = IRate
annual_rate IRate -> IRate -> IRate
forall a. Fractional a => a -> a -> a
/ IRate
12
periodRateFromAnnualRate Period
Quarterly IRate
annual_rate = IRate
annual_rate IRate -> IRate -> IRate
forall a. Fractional a => a -> a -> a
/ IRate
4
periodRateFromAnnualRate Period
SemiAnnually IRate
annual_rate = IRate
annual_rate IRate -> IRate -> IRate
forall a. Fractional a => a -> a -> a
/ IRate
2
periodRateFromAnnualRate Period
Daily IRate
annual_rate = IRate
annual_rate IRate -> IRate -> IRate
forall a. Fractional a => a -> a -> a
/ IRate
365
periodRateFromAnnualRate Period
Weekly IRate
annual_rate = IRate
annual_rate IRate -> IRate -> IRate
forall a. Fractional a => a -> a -> a
/ IRate
52.143
addD :: Date -> T.CalendarDiffDays -> Date
addD :: Date -> CalendarDiffDays -> Date
addD Date
d CalendarDiffDays
calendarMonth = CalendarDiffDays -> Date -> Date
T.addGregorianDurationClip CalendarDiffDays
T.calendarMonth Date
d
getIntervalDays :: [Date] -> [Int]
getIntervalDays :: [Date] -> [Int]
getIntervalDays [Date]
ds = (Date -> Date -> Int) -> [Date] -> [Date] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Date -> Date -> Int
daysBetweenI ([Date] -> [Date]
forall a. HasCallStack => [a] -> [a]
init [Date]
ds) ([Date] -> [Date]
forall a. HasCallStack => [a] -> [a]
tail [Date]
ds)
getIntervalFactors :: [Date] -> [Rate]
getIntervalFactors :: [Date] -> [Rational]
getIntervalFactors [Date]
ds = (\Int
x -> Int -> Rational
forall a. Real a => a -> Rational
toRational Int
x Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
365) (Int -> Rational) -> [Int] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Date] -> [Int]
getIntervalDays [Date]
ds
prorataFactors :: [Balance] -> Balance -> [Balance]
prorataFactors :: [Amount] -> Amount -> [Amount]
prorataFactors [Amount]
bals Amount
amt =
case Rational
s of
Rational
0.0 -> Int -> Amount -> [Amount]
forall a. Int -> a -> [a]
replicate ([Amount] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Amount]
bals) Amount
0.0
Rational
_ -> let
weights :: [Rational]
weights = (Amount -> Rational) -> [Amount] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map (\Amount
x -> Amount -> Rational
forall a. Real a => a -> Rational
toRational Amount
x Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
s) [Amount]
bals
outPut :: [Amount]
outPut = (\Rational
y -> Rational -> Amount
forall a. Fractional a => Rational -> a
fromRational (Rational
y Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
amtToPay)) (Rational -> Amount) -> [Rational] -> [Amount]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rational]
weights
eps :: Amount
eps = Amount
amt Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
- [Amount] -> Amount
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Amount]
outPut
in
if Amount
eps Amount -> Amount -> Bool
forall a. Eq a => a -> a -> Bool
== Amount
0.00 then
[Amount]
outPut
else
ASetter [Amount] [Amount] Amount Amount
-> (Amount -> Amount) -> [Amount] -> [Amount]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Index [Amount] -> Traversal' [Amount] (IxValue [Amount])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index [Amount]
0) (Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
+ Amount
eps) [Amount]
outPut
where
s :: Rational
s = Amount -> Rational
forall a. Real a => a -> Rational
toRational (Amount -> Rational) -> Amount -> Rational
forall a b. (a -> b) -> a -> b
$ [Amount] -> Amount
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Amount]
bals
amtToPay :: Rational
amtToPay = Rational -> Rational
forall a. Real a => a -> Rational
toRational (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min Rational
s (Amount -> Rational
forall a. Real a => a -> Rational
toRational Amount
amt)
paySeqLiabilities :: Balance -> [Balance] -> [(Balance,Balance)]
paySeqLiabilities :: Amount -> [Amount] -> [(Amount, Amount)]
paySeqLiabilities Amount
startAmt [Amount]
liabilities =
[(Amount, Amount)] -> [(Amount, Amount)]
forall a. HasCallStack => [a] -> [a]
tail ([(Amount, Amount)] -> [(Amount, Amount)])
-> [(Amount, Amount)] -> [(Amount, Amount)]
forall a b. (a -> b) -> a -> b
$ [(Amount, Amount)] -> [(Amount, Amount)]
forall a. [a] -> [a]
reverse ([(Amount, Amount)] -> [(Amount, Amount)])
-> [(Amount, Amount)] -> [(Amount, Amount)]
forall a b. (a -> b) -> a -> b
$ ([(Amount, Amount)] -> Amount -> [(Amount, Amount)])
-> [(Amount, Amount)] -> [Amount] -> [(Amount, Amount)]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [(Amount, Amount)] -> Amount -> [(Amount, Amount)]
forall {b}. (Ord b, Num b) => [(b, b)] -> b -> [(b, b)]
pay [(Amount
startAmt, Amount
0)] [Amount]
liabilities
where pay :: [(b, b)] -> b -> [(b, b)]
pay accum :: [(b, b)]
accum@((b
amt, b
_):[(b, b)]
xs) b
target =
if b
amt b -> b -> Bool
forall a. Ord a => a -> a -> Bool
>= b
target then
(b
amtb -> b -> b
forall a. Num a => a -> a -> a
-b
target, b
0)(b, b) -> [(b, b)] -> [(b, b)]
forall a. a -> [a] -> [a]
:[(b, b)]
accum
else
(b
0, b
targetb -> b -> b
forall a. Num a => a -> a -> a
-b
amt)(b, b) -> [(b, b)] -> [(b, b)]
forall a. a -> [a] -> [a]
:[(b, b)]
accum
paySeqLiabilitiesAmt :: Balance -> [Balance] -> [Balance]
paySeqLiabilitiesAmt :: Amount -> [Amount] -> [Amount]
paySeqLiabilitiesAmt Amount
startAmt [Amount]
funds
= (Amount -> Amount -> Amount) -> [Amount] -> [Amount] -> [Amount]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [Amount]
funds [Amount]
remainBals
where
remainBals :: [Amount]
remainBals = ((Amount, Amount) -> Amount) -> [(Amount, Amount)] -> [Amount]
forall a b. (a -> b) -> [a] -> [b]
map (Amount, Amount) -> Amount
forall a b. (a, b) -> b
snd ([(Amount, Amount)] -> [Amount]) -> [(Amount, Amount)] -> [Amount]
forall a b. (a -> b) -> a -> b
$ Amount -> [Amount] -> [(Amount, Amount)]
paySeqLiabilities Amount
startAmt [Amount]
funds
paySeqLiabResi :: Amount -> [Balance] -> [Amount]
paySeqLiabResi :: Amount -> [Amount] -> [Amount]
paySeqLiabResi Amount
startAmt [Amount]
funds
= (Amount -> Amount -> Amount) -> [Amount] -> [Amount] -> [Amount]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [Amount]
funds [Amount]
allocatedAmts
where
allocatedAmts :: [Amount]
allocatedAmts = Amount -> [Amount] -> [Amount]
paySeqLiabilitiesAmt Amount
startAmt [Amount]
funds
afterNPeriod :: T.Day -> Integer -> Period -> T.Day
afterNPeriod :: Date -> Integer -> Period -> Date
afterNPeriod Date
d Integer
i Period
p =
Integer -> Date -> Date
T.addGregorianMonthsClip ( Integer
months Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i) Date
d
where
months :: Integer
months = case Period
p of
Period
Monthly -> Integer
1
Period
Quarterly -> Integer
3
Period
SemiAnnually -> Integer
6
Period
Annually -> Integer
12
periodsBetween :: T.Day -> T.Day -> Period -> Integer
periodsBetween :: Date -> Date -> Period -> Integer
periodsBetween Date
t1 Date
t2 Period
p
= case Period
p of
Period
Weekly -> Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div (Date -> Date -> Integer
T.diffDays Date
t1 Date
t2) Integer
7
Period
Monthly -> Integer
_diff
Period
Annually -> Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
_diff Integer
12
Period
Quarterly -> Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
_diff Integer
4
where
_diff :: Integer
_diff = CalendarDiffDays -> Integer
T.cdMonths (CalendarDiffDays -> Integer) -> CalendarDiffDays -> Integer
forall a b. (a -> b) -> a -> b
$ Date -> Date -> CalendarDiffDays
T.diffGregorianDurationClip Date
t1 Date
t2
mkTs :: [(Date,Rational)] -> Ts
mkTs :: [(Date, Rational)] -> Ts
mkTs [] = [TsPoint Rational] -> Ts
FloatCurve []
mkTs [(Date, Rational)]
ps = [TsPoint Rational] -> Ts
FloatCurve [ Date -> Rational -> TsPoint Rational
forall a. Date -> a -> TsPoint a
TsPoint Date
d Rational
v | (Date
d,Rational
v) <- [(Date, Rational)]
ps]
mkRateTs :: [(Date,IRate)] -> Ts
mkRateTs :: [(Date, IRate)] -> Ts
mkRateTs [(Date, IRate)]
ps = [TsPoint IRate] -> Ts
IRateCurve [ Date -> IRate -> TsPoint IRate
forall a. Date -> a -> TsPoint a
TsPoint Date
d IRate
v | (Date
d,IRate
v) <- [(Date, IRate)]
ps]
getValOnByDate :: Ts -> Date -> Balance
getValOnByDate :: Ts -> Date -> Amount
getValOnByDate (BalanceCurve [TsPoint Amount]
dps) Date
d
= case (TsPoint Amount -> Bool)
-> [TsPoint Amount] -> Maybe (TsPoint Amount)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(TsPoint Date
_d Amount
_) -> ( Date
d Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
>= Date
_d )) ([TsPoint Amount] -> [TsPoint Amount]
forall a. [a] -> [a]
reverse [TsPoint Amount]
dps) of
Just (TsPoint Date
_d Amount
v) -> Amount
v
Maybe (TsPoint Amount)
Nothing -> Amount
0
getIntValOnByDate :: Ts -> Date -> Int
getIntValOnByDate :: Ts -> Date -> Int
getIntValOnByDate (IntCurve [TsPoint Int]
dps) Date
d
= case (TsPoint Int -> Bool) -> [TsPoint Int] -> Maybe (TsPoint Int)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(TsPoint Date
_d Int
_) -> ( Date
d Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
>= Date
_d )) ([TsPoint Int] -> [TsPoint Int]
forall a. [a] -> [a]
reverse [TsPoint Int]
dps) of
Just (TsPoint Date
_d Int
v) -> Int
v
Maybe (TsPoint Int)
Nothing -> Int
0
splitTsByDate :: Ts -> T.Day -> (Ts, Ts)
splitTsByDate :: Ts -> Date -> (Ts, Ts)
splitTsByDate (BalanceCurve [TsPoint Amount]
ds) Date
d
= case ((TsPoint Amount -> Bool) -> [TsPoint Amount] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (\(TsPoint Date
_d Amount
_) -> Date
_d Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> Date
d ) [TsPoint Amount]
ds) of
Maybe Int
Nothing -> ([TsPoint Amount] -> Ts
BalanceCurve [TsPoint Amount]
ds, [TsPoint Amount] -> Ts
BalanceCurve [])
Just Int
idx -> ([TsPoint Amount] -> Ts
BalanceCurve [TsPoint Amount]
l, [TsPoint Amount] -> Ts
BalanceCurve [TsPoint Amount]
r)
where
([TsPoint Amount]
l,[TsPoint Amount]
r) = Int -> [TsPoint Amount] -> ([TsPoint Amount], [TsPoint Amount])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
idx [TsPoint Amount]
ds
subTsBetweenDates :: Ts -> Maybe Date -> Maybe Date -> Ts
subTsBetweenDates :: Ts -> Maybe Date -> Maybe Date -> Ts
subTsBetweenDates (BalanceCurve [TsPoint Amount]
vs) (Just Date
sd) (Just Date
ed)
= [TsPoint Amount] -> Ts
BalanceCurve ([TsPoint Amount] -> Ts) -> [TsPoint Amount] -> Ts
forall a b. (a -> b) -> a -> b
$ (TsPoint Amount -> Bool) -> [TsPoint Amount] -> [TsPoint Amount]
forall a. (a -> Bool) -> [a] -> [a]
filter(\(TsPoint Date
x Amount
_) -> (Date
x Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> Date
sd) Bool -> Bool -> Bool
&& (Date
x Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
< Date
ed) ) [TsPoint Amount]
vs
subTsBetweenDates (BalanceCurve [TsPoint Amount]
vs) Maybe Date
Nothing (Just Date
ed)
= [TsPoint Amount] -> Ts
BalanceCurve ([TsPoint Amount] -> Ts) -> [TsPoint Amount] -> Ts
forall a b. (a -> b) -> a -> b
$ (TsPoint Amount -> Bool) -> [TsPoint Amount] -> [TsPoint Amount]
forall a. (a -> Bool) -> [a] -> [a]
filter(\(TsPoint Date
x Amount
_) -> Date
x Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
< Date
ed ) [TsPoint Amount]
vs
subTsBetweenDates (BalanceCurve [TsPoint Amount]
vs) (Just Date
sd) Maybe Date
Nothing
= [TsPoint Amount] -> Ts
BalanceCurve ([TsPoint Amount] -> Ts) -> [TsPoint Amount] -> Ts
forall a b. (a -> b) -> a -> b
$ (TsPoint Amount -> Bool) -> [TsPoint Amount] -> [TsPoint Amount]
forall a. (a -> Bool) -> [a] -> [a]
filter(\(TsPoint Date
x Amount
_) -> Date
x Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> Date
sd ) [TsPoint Amount]
vs
sumValTs :: Ts -> Amount
sumValTs :: Ts -> Amount
sumValTs (BalanceCurve [TsPoint Amount]
ds) = (TsPoint Amount -> Amount -> Amount)
-> Amount -> [TsPoint Amount] -> Amount
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(TsPoint Date
_ Amount
v) Amount
acc -> Amount
accAmount -> Amount -> Amount
forall a. Num a => a -> a -> a
+Amount
v ) Amount
0 [TsPoint Amount]
ds
toDate :: String -> Date
toDate :: String -> Date
toDate = Bool -> TimeLocale -> String -> String -> Date
forall t.
ParseTime t =>
Bool -> TimeLocale -> String -> String -> t
TF.parseTimeOrError Bool
True TimeLocale
TF.defaultTimeLocale String
"%Y%m%d"
toDates :: [String] -> [Date]
toDates :: [String] -> [Date]
toDates [String]
ds = String -> Date
toDate (String -> Date) -> [String] -> [Date]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
ds
zipWith8 :: (a->b->c->d->e->f->g->h->i) -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]->[i]
zipWith8 :: forall a b c d e f g h i.
(a -> b -> c -> d -> e -> f -> g -> h -> i)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [h] -> [i]
zipWith8 a -> b -> c -> d -> e -> f -> g -> h -> i
z (a
a:[a]
as) (b
b:[b]
bs) (c
c:[c]
cs) (d
d:[d]
ds) (e
e:[e]
es) (f
f:[f]
fs) (g
g:[g]
gs) (h
h:[h]
hs)
= a -> b -> c -> d -> e -> f -> g -> h -> i
z a
a b
b c
c d
d e
e f
f g
g h
h i -> [i] -> [i]
forall a. a -> [a] -> [a]
: (a -> b -> c -> d -> e -> f -> g -> h -> i)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [h] -> [i]
forall a b c d e f g h i.
(a -> b -> c -> d -> e -> f -> g -> h -> i)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [h] -> [i]
zipWith8 a -> b -> c -> d -> e -> f -> g -> h -> i
z [a]
as [b]
bs [c]
cs [d]
ds [e]
es [f]
fs [g]
gs [h]
hs
zipWith8 a -> b -> c -> d -> e -> f -> g -> h -> i
_ [a]
_ [b]
_ [c]
_ [d]
_ [e]
_ [f]
_ [g]
_ [h]
_ = []
zipWith9 :: (a->b->c->d->e->f->g->h->i->j) -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]->[i]->[j]
zipWith9 :: forall a b c d e f g h i j.
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j)
-> [a]
-> [b]
-> [c]
-> [d]
-> [e]
-> [f]
-> [g]
-> [h]
-> [i]
-> [j]
zipWith9 a -> b -> c -> d -> e -> f -> g -> h -> i -> j
z (a
a:[a]
as) (b
b:[b]
bs) (c
c:[c]
cs) (d
d:[d]
ds) (e
e:[e]
es) (f
f:[f]
fs) (g
g:[g]
gs) (h
h:[h]
hs) (i
j:[i]
js)
= a -> b -> c -> d -> e -> f -> g -> h -> i -> j
z a
a b
b c
c d
d e
e f
f g
g h
h i
j j -> [j] -> [j]
forall a. a -> [a] -> [a]
: (a -> b -> c -> d -> e -> f -> g -> h -> i -> j)
-> [a]
-> [b]
-> [c]
-> [d]
-> [e]
-> [f]
-> [g]
-> [h]
-> [i]
-> [j]
forall a b c d e f g h i j.
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j)
-> [a]
-> [b]
-> [c]
-> [d]
-> [e]
-> [f]
-> [g]
-> [h]
-> [i]
-> [j]
zipWith9 a -> b -> c -> d -> e -> f -> g -> h -> i -> j
z [a]
as [b]
bs [c]
cs [d]
ds [e]
es [f]
fs [g]
gs [h]
hs [i]
js
zipWith9 a -> b -> c -> d -> e -> f -> g -> h -> i -> j
_ [a]
_ [b]
_ [c]
_ [d]
_ [e]
_ [f]
_ [g]
_ [h]
_ [i]
_ = []
zipWith10 :: (a->b->c->d->e->f->g->h->i->j->k) -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]->[i]->[j]->[k]
zipWith10 :: forall a b c d e f g h i j k.
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k)
-> [a]
-> [b]
-> [c]
-> [d]
-> [e]
-> [f]
-> [g]
-> [h]
-> [i]
-> [j]
-> [k]
zipWith10 a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k
z (a
a:[a]
as) (b
b:[b]
bs) (c
c:[c]
cs) (d
d:[d]
ds) (e
e:[e]
es) (f
f:[f]
fs) (g
g:[g]
gs) (h
h:[h]
hs) (i
j:[i]
js) (j
k:[j]
ks)
= a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k
z a
a b
b c
c d
d e
e f
f g
g h
h i
j j
kk -> [k] -> [k]
forall a. a -> [a] -> [a]
: (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k)
-> [a]
-> [b]
-> [c]
-> [d]
-> [e]
-> [f]
-> [g]
-> [h]
-> [i]
-> [j]
-> [k]
forall a b c d e f g h i j k.
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k)
-> [a]
-> [b]
-> [c]
-> [d]
-> [e]
-> [f]
-> [g]
-> [h]
-> [i]
-> [j]
-> [k]
zipWith10 a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k
z [a]
as [b]
bs [c]
cs [d]
ds [e]
es [f]
fs [g]
gs [h]
hs [i]
js [j]
ks
zipWith10 a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k
_ [a]
_ [b]
_ [c]
_ [d]
_ [e]
_ [f]
_ [g]
_ [h]
_ [i]
_ [j]
_ = []
zipWith11 :: (a->b->c->d->e->f->g->h->i->j->k->l) -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]->[i]->[j]->[k]->[l]
zipWith11 :: forall a b c d e f g h i j k l.
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l)
-> [a]
-> [b]
-> [c]
-> [d]
-> [e]
-> [f]
-> [g]
-> [h]
-> [i]
-> [j]
-> [k]
-> [l]
zipWith11 a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l
z (a
a:[a]
as) (b
b:[b]
bs) (c
c:[c]
cs) (d
d:[d]
ds) (e
e:[e]
es) (f
f:[f]
fs) (g
g:[g]
gs) (h
h:[h]
hs) (i
j:[i]
js) (j
k:[j]
ks) (k
l:[k]
ls)
= a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l
z a
a b
b c
c d
d e
e f
f g
g h
h i
j j
k k
ll -> [l] -> [l]
forall a. a -> [a] -> [a]
: (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l)
-> [a]
-> [b]
-> [c]
-> [d]
-> [e]
-> [f]
-> [g]
-> [h]
-> [i]
-> [j]
-> [k]
-> [l]
forall a b c d e f g h i j k l.
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l)
-> [a]
-> [b]
-> [c]
-> [d]
-> [e]
-> [f]
-> [g]
-> [h]
-> [i]
-> [j]
-> [k]
-> [l]
zipWith11 a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l
z [a]
as [b]
bs [c]
cs [d]
ds [e]
es [f]
fs [g]
gs [h]
hs [i]
js [j]
ks [k]
ls
zipWith11 a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l
_ [a]
_ [b]
_ [c]
_ [d]
_ [e]
_ [f]
_ [g]
_ [h]
_ [i]
_ [j]
_ [k]
_ = []
zipWith12 :: (a->b->c->d->e->f->g->h->i->j->k->l->m) -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]->[i]->[j]->[k]->[l]->[m]
zipWith12 :: forall a b c d e f g h i j k l m.
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m)
-> [a]
-> [b]
-> [c]
-> [d]
-> [e]
-> [f]
-> [g]
-> [h]
-> [i]
-> [j]
-> [k]
-> [l]
-> [m]
zipWith12 a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m
z (a
a:[a]
as) (b
b:[b]
bs) (c
c:[c]
cs) (d
d:[d]
ds) (e
e:[e]
es) (f
f:[f]
fs) (g
g:[g]
gs) (h
h:[h]
hs) (i
j:[i]
js) (j
k:[j]
ks) (k
l:[k]
ls) (l
m:[l]
ms)
= a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m
z a
a b
b c
c d
d e
e f
f g
g h
h i
j j
k k
l l
mm -> [m] -> [m]
forall a. a -> [a] -> [a]
: (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m)
-> [a]
-> [b]
-> [c]
-> [d]
-> [e]
-> [f]
-> [g]
-> [h]
-> [i]
-> [j]
-> [k]
-> [l]
-> [m]
forall a b c d e f g h i j k l m.
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m)
-> [a]
-> [b]
-> [c]
-> [d]
-> [e]
-> [f]
-> [g]
-> [h]
-> [i]
-> [j]
-> [k]
-> [l]
-> [m]
zipWith12 a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m
z [a]
as [b]
bs [c]
cs [d]
ds [e]
es [f]
fs [g]
gs [h]
hs [i]
js [j]
ks [k]
ls [l]
ms
zipWith12 a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m
_ [a]
_ [b]
_ [c]
_ [d]
_ [e]
_ [f]
_ [g]
_ [h]
_ [i]
_ [j]
_ [k]
_ [l]
_ = []
floatToFixed :: HasResolution a => Float -> Fixed a
floatToFixed :: forall a. HasResolution a => Float -> Fixed a
floatToFixed Float
x = Fixed a
y where
y :: Fixed a
y = Integer -> Fixed a
forall k (a :: k). Integer -> Fixed a
MkFixed (Float -> Integer
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Integer -> Float
forall a. Num a => Integer -> a
fromInteger (Fixed a -> Integer
forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
forall (p :: * -> *). p a -> Integer
resolution Fixed a
y) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x))
weightedBy :: [Rational] -> [Rational] -> Rational
weightedBy :: [Rational] -> [Rational] -> Rational
weightedBy [Rational]
ws [Rational]
vs
| Rational
sum_weights Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
0 = Rational
0
| Bool
otherwise = [Rational] -> Rational
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ( (Rational -> Rational -> Rational)
-> [Rational] -> [Rational] -> [Rational]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(*) [Rational]
vs [Rational]
ws ) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
sum_weights
where
sum_weights :: Rational
sum_weights = [Rational] -> Rational
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Rational]
ws
daysBetween :: Date -> Date -> Integer
daysBetween :: Date -> Date -> Integer
daysBetween Date
sd Date
ed = Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Date -> Date -> Integer
T.diffDays Date
ed Date
sd)
daysBetweenI :: Date -> Date -> Int
daysBetweenI :: Date -> Date -> Int
daysBetweenI Date
sd Date
ed = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Date -> Date -> Integer
T.diffDays Date
ed Date
sd
genDates :: Date -> Period -> Int -> [Date]
genDates :: Date -> Period -> Int -> [Date]
genDates Date
start_day Period
BiWeekly Int
n =
[ CalendarDiffDays -> Date -> Date
T.addGregorianDurationClip (Integer -> Integer -> CalendarDiffDays
T.CalendarDiffDays Integer
0 (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
14)) Date
start_day | Int
i <- [Int
1..Int
n]]
genDates Date
start_day Period
Weekly Int
n =
[ CalendarDiffDays -> Date -> Date
T.addGregorianDurationClip (Integer -> Integer -> CalendarDiffDays
T.CalendarDiffDays Integer
0 (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
7)) Date
start_day | Int
i <- [Int
1..Int
n]]
genDates Date
start_day Period
p Int
n =
[ CalendarDiffDays -> Date -> Date
T.addGregorianDurationClip (Integer -> Integer -> CalendarDiffDays
T.CalendarDiffDays (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
mul) Integer
0) Date
start_day | Int
i <- [Int
1..Int
n]]
where
mul :: Integer
mul = case Period
p of
Period
Monthly -> Integer
1
Period
Quarterly -> Integer
3
Period
SemiAnnually -> Integer
6
Period
Annually -> Integer
12
Period
_ -> String -> Integer
forall a. HasCallStack => String -> a
error (String -> Integer) -> String -> Integer
forall a b. (a -> b) -> a -> b
$ String
"Invalid period" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Period -> String
forall a. Show a => a -> String
show Period
p
nextDate :: Date -> Period -> Date
nextDate :: Date -> Period -> Date
nextDate Date
d Period
p
= Integer -> Date -> Date
T.addGregorianMonthsClip Integer
m Date
d
where
m :: Integer
m = case Period
p of
Period
Monthly -> Integer
1
Period
Quarterly -> Integer
3
Period
SemiAnnually -> Integer
6
Period
Annually -> Integer
12
Period
_ -> Integer
0