national-australia-bank 0.0.9 → 0.0.10
raw patch · 7 files changed
+1141/−861 lines, 7 files
Files
- changelog.md +5/−0
- national-australia-bank.cabal +5/−2
- src/Data/Bank/NationalAustraliaBank.hs +9/−0
- src/Data/Bank/NationalAustraliaBank/NationalAustraliaBank.hs +0/−859
- src/Data/Bank/NationalAustraliaBank/Report.hs +51/−0
- src/Data/Bank/NationalAustraliaBank/Search.hs +212/−0
- src/Data/Bank/NationalAustraliaBank/Transaction.hs +859/−0
changelog.md view
@@ -1,3 +1,8 @@+0.0.10++* split out modules+* add search report modules+ 0.0.9 * Fix `amountReal` to accept function how to handle precision loss.
national-australia-bank.cabal view
@@ -1,5 +1,5 @@ name: national-australia-bank-version: 0.0.9+version: 0.0.10 synopsis: Functions for National Australia Bank transactions description: Parsing, Processing and other functions for National Australia Bank transactions license: BSD3@@ -21,7 +21,10 @@ library exposed-modules:- Data.Bank.NationalAustraliaBank.NationalAustraliaBank+ Data.Bank.NationalAustraliaBank+ Data.Bank.NationalAustraliaBank.Report+ Data.Bank.NationalAustraliaBank.Search+ Data.Bank.NationalAustraliaBank.Transaction build-depends: base >= 4.9 && < 4.15 , bytestring == 0.10.8.2
+ src/Data/Bank/NationalAustraliaBank.hs view
@@ -0,0 +1,9 @@+{-# OPTIONS_GHC -Wall #-}++module Data.Bank.NationalAustraliaBank(+ module N+) where++import Data.Bank.NationalAustraliaBank.Report as N+import Data.Bank.NationalAustraliaBank.Search as N+import Data.Bank.NationalAustraliaBank.Transaction as N
− src/Data/Bank/NationalAustraliaBank/NationalAustraliaBank.hs
@@ -1,859 +0,0 @@-{-# OPTIONS_GHC -Wall #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE LambdaCase #-}--module Data.Bank.NationalAustraliaBank.NationalAustraliaBank where--import Control.Applicative (Alternative((<|>)))-import Control.Lens( Lens', Prism', prism', (#), view, preview, over, _2 )-import Control.Monad.IO.Class ( MonadIO(..) )-import Control.Monad.Reader.Class ( MonadReader )-import Control.Monad.Trans.Except ( ExceptT(..) )-import Data.Bool(bool)-import Data.List ( sortBy )-import Data.Functor( Functor(..), (<$>) )-import Data.Functor.Identity ( Identity(..) )-import Data.ByteString(ByteString)-import qualified Data.ByteString.Lazy.UTF8 as L(fromString)-import Data.Digit- ( charDecimal,- parseDecimal,- decDigitsIntegral,- integralDecDigits,- integralDecimal,- DecDigit(DecDigit0) )-import Data.Foldable ( asum, toList )-import Data.List.NonEmpty ( NonEmpty(..), some1 )-import Data.Maybe( fromMaybe )-import Data.Ord( comparing )-import Data.String ( IsString(fromString) )-import Data.Sv- ( parseDecodeFromFile,- (=:),- comma,- ParseOptions(ParseOptions),- Decode,- Decode',- NameEncode,- Headedness(Headed) )-import qualified Data.Sv.Decode as D-import qualified Data.Sv.Encode as E-import Data.Validation ( toEither )-import Data.Time ( fromGregorian, toGregorian, diffDays, Day )-import Data.Functor.Contravariant ( Contravariant(contramap) )-import Data.Ratio ( Ratio, (%) )-import System.Directory- ( doesDirectoryExist,- listDirectory )-import System.FilePath ( (</>) )-import Text.Parsec- ( char,- string,- try,- ParsecT,- Stream )---- $setup--- >>> import Data.Digit--data Month =- Jan- | Feb- | Mar- | Apr- | May- | Jun- | Jul- | Aug- | Sep- | Oct- | Nov- | Dec- deriving (Eq, Ord, Show)--class HasMonth a where- month ::- Lens' a Month--instance HasMonth Month where- month =- id--class AsMonth a where- _Month ::- Prism' a Month- _Jan ::- Prism' a ()- _Jan =- _Month .- prism'- (\() -> Jan)- (\case- Jan ->- Just ()- _ ->- Nothing)- _Feb ::- Prism' a ()- _Feb =- _Month .- prism'- (\() -> Feb)- (\case- Feb ->- Just ()- _ ->- Nothing)- _Mar ::- Prism' a ()- _Mar =- _Month .- prism'- (\() -> Mar)- (\case- Mar ->- Just ()- _ ->- Nothing)- _Apr ::- Prism' a ()- _Apr =- _Month .- prism'- (\() -> Apr)- (\case- Apr ->- Just ()- _ ->- Nothing)- _May ::- Prism' a ()- _May =- _Month .- prism'- (\() -> May)- (\case- May ->- Just ()- _ ->- Nothing)- _Jun ::- Prism' a ()- _Jun =- _Month .- prism'- (\() -> Jun)- (\case- Jun ->- Just ()- _ ->- Nothing)- _Jul ::- Prism' a ()- _Jul =- _Month .- prism'- (\() -> Jul)- (\case- Jul ->- Just ()- _ ->- Nothing)- _Aug ::- Prism' a ()- _Aug =- _Month .- prism'- (\() -> Aug)- (\case- Aug ->- Just ()- _ ->- Nothing)- _Sep ::- Prism' a ()- _Sep =- _Month .- prism'- (\() -> Sep)- (\case- Sep ->- Just ()- _ ->- Nothing)- _Oct ::- Prism' a ()- _Oct =- _Month .- prism'- (\() -> Oct)- (\case- Oct ->- Just ()- _ ->- Nothing)- _Nov ::- Prism' a ()- _Nov =- _Month .- prism'- (\() -> Nov)- (\case- Nov ->- Just ()- _ ->- Nothing)- _Dec ::- Prism' a ()- _Dec =- _Month .- prism'- (\() -> Dec)- (\case- Dec ->- Just ()- _ ->- Nothing)--instance AsMonth Month where- _Month =- id--parseMonth ::- Stream s m Char =>- ParsecT s u m Month-parseMonth =- asum . fmap try $ [- Jan <$ string "Jan"- , Feb <$ string "Feb"- , Mar <$ string "Mar"- , Apr <$ string "Apr"- , May <$ string "May"- , Jun <$ string "Jun"- , Jul <$ string "Jul"- , Aug <$ string "Aug"- , Sep <$ string "Sep"- , Oct <$ string "Oct"- , Nov <$ string "Nov"- , Dec <$ string "Dec"- ]--data Date =- Date {- _day1 ::- DecDigit- , _day2 ::- DecDigit- , _month ::- Month- , _year1 ::- DecDigit- , _year2 ::- DecDigit- } deriving (Eq, Show)--class HasDate a where- date ::- Lens' a Date- day1 ::- Lens' a DecDigit- day1 =- date .- \f (Date d1 d2 m y1 y2) -> fmap (\d1' -> Date d1' d2 m y1 y2) (f d1)- day2 ::- Lens' a DecDigit- day2 =- date .- \f (Date d1 d2 m y1 y2) -> fmap (\d2' -> Date d1 d2' m y1 y2) (f d2)- year1 ::- Lens' a DecDigit- year1 =- date .- \f (Date d1 d2 m y1 y2) -> fmap (\y1' -> Date d1 d2 m y1' y2) (f y1)- year2 ::- Lens' a DecDigit- year2 =- date .- \f (Date d1 d2 m y1 y2) -> fmap (\y2' -> Date d1 d2 m y1 y2') (f y2)--instance HasDate Date where- date =- id--instance HasMonth Date where- month f (Date d1 d2 m y1 y2) =- fmap (\m' -> Date d1 d2 m' y1 y2) (f m)--class AsDate a where- _Date ::- Prism' a Date--instance AsDate Date where- _Date =- id--instance Ord Date where- Date d1 d2 m y1 y2 `compare` Date e1 e2 n z1 z2 =- let twoDigits a b = decDigitsIntegral (Right (a :| [b]))- d = twoDigits d1 d2 :: Int- e = twoDigits e1 e2 :: Int- y = twoDigits y1 y2 :: Int- z = twoDigits z1 z2 :: Int- in (y, m, d) `compare` (z, n, e)--parseDate ::- Stream s Identity Char =>- ParsecT s u Identity Date-parseDate =- Date <$>- parseDecimal <*>- parseDecimal <*- char ' ' <*>- parseMonth <*- char ' ' <*>- parseDecimal <*>- parseDecimal--decodeDate ::- Decode' ByteString Date-decodeDate =- D.withParsec parseDate--encodeDate ::- NameEncode Date-encodeDate =- fromString "Date" =: E.mkEncodeBS (\(Date d1 d2 m y1 y2) ->- L.fromString (concat [[charDecimal # d1, charDecimal # d2, ' '], show m, [' ', charDecimal # y1], [charDecimal # y2]]))--dayDate ::- Day- -> Date-dayDate day =- let (y, m, d) = toGregorian day- twodigits x =- case either id id (integralDecDigits x) of- h :| [] ->- (DecDigit0, h)- h :| i : _ ->- (h, i)- (d1, d2) = twodigits d- m' = case m of- 1 -> Jan- 2 -> Feb- 3 -> Mar- 4 -> Apr- 5 -> May- 6 -> Jun- 7 -> Jul- 8 -> Aug- 9 -> Sep- 10 -> Oct- 11 -> Nov- _ -> Dec- (y1, y2) = twodigits (y - 2000)- in Date d1 d2 m' y1 y2--dateDay ::- Date- -> Day-dateDay (Date d1 d2 m y1 y2) =- let year = 2000 + integralDecimal # y1 * 10 + integralDecimal # y2- mon Jan = 1- mon Feb = 2- mon Mar = 3- mon Apr = 4- mon May = 5- mon Jun = 6- mon Jul = 7- mon Aug = 8- mon Sep = 9- mon Oct = 10- mon Nov = 11- mon Dec = 12- dt = integralDecimal # d1 * 10 + integralDecimal # d2- in fromGregorian year (mon m) dt--diffDates ::- Date- -> Date- -> Integer-diffDates dt1 dt2 =- dateDay dt1 `diffDays` dateDay dt2--data Amount =- Amount {- _negated ::- Bool- , _dollars ::- NonEmpty DecDigit- , _cents1 ::- DecDigit- , _cents2 ::- DecDigit- } deriving (Eq, Ord, Show)--class AsAmount a where- _Amount ::- Prism' a Amount--instance AsAmount Amount where- _Amount =- id--class HasAmount a where- amount ::- Lens' a Amount- negated ::- Lens' a Bool- negated =- amount .- \f (Amount n d c1 c2) -> fmap (\n' -> Amount n' d c1 c2) (f n)- dollars ::- Lens' a (NonEmpty DecDigit)- dollars =- amount .- \f (Amount n d c1 c2) -> fmap (\d' -> Amount n d' c1 c2) (f d)- cents1 ::- Lens' a DecDigit- cents1 =- amount .- \f (Amount n d c1 c2) -> fmap (\c1' -> Amount n d c1' c2) (f c1)- cents2 ::- Lens' a DecDigit- cents2 =- amount .- \f (Amount n d c1 c2) -> fmap (\c2' -> Amount n d c1 c2') (f c2)--instance HasAmount Amount where- amount =- id--parseAmount ::- Stream s Identity Char =>- ParsecT s u Identity Amount-parseAmount =- Amount <$>- try (True <$ char '-' <|> pure False) <*>- some1 parseDecimal <*- char '.' <*>- parseDecimal <*>- parseDecimal--decodeAmount ::- Decode' ByteString Amount-decodeAmount =- D.withParsec parseAmount--encodeAmount ::- String- -> NameEncode Amount-encodeAmount label =- fromString label =: E.mkEncodeBS (\(Amount n d c1 c2) ->- L.fromString (concat [bool "" "-" n, fmap (charDecimal #) (toList d), ".", [charDecimal # c1], [charDecimal # c2]]))--realAmount ::- Integral a =>- Amount- -> Ratio a-realAmount a =- integralAmount100 a % 100---- |------ >>> amountRealRound 0--- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit0}------ >>> amountRealRound 0.01--- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}------ >>> amountRealRound 0.0123--- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}------ >>> amountRealRound (-0.01)--- Amount {_negated = True, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}------ >>> amountRealRound (-0.0123)--- Amount {_negated = True, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}------ >>> amountRealRound (-12.01)--- Amount {_negated = True, _dollars = DecDigit1 :| [DecDigit2], _cents1 = DecDigit0, _cents2 = DecDigit1}------ >>> amountRealRound (452.99)--- Amount {_negated = False, _dollars = DecDigit4 :| [DecDigit5,DecDigit2], _cents1 = DecDigit9, _cents2 = DecDigit9}------ >>> amountRealRound (391233 % 67700)--- Amount {_negated = False, _dollars = DecDigit5 :| [], _cents1 = DecDigit7, _cents2 = DecDigit8}-amountRealRound ::- Integral a =>- Ratio a- -> Amount-amountRealRound =- amountReal round---- |------ >>> amountRealTruncate 0--- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit0}------ >>> amountRealTruncate 0.01--- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}------ >>> amountRealTruncate 0.0123--- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}------ >>> amountRealTruncate (-0.01)--- Amount {_negated = True, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}------ >>> amountRealTruncate (-0.0123)--- Amount {_negated = True, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}------ >>> amountRealTruncate (-12.01)--- Amount {_negated = True, _dollars = DecDigit1 :| [DecDigit2], _cents1 = DecDigit0, _cents2 = DecDigit1}------ >>> amountRealTruncate (452.99)--- Amount {_negated = False, _dollars = DecDigit4 :| [DecDigit5,DecDigit2], _cents1 = DecDigit9, _cents2 = DecDigit9}------ >>> amountRealTruncate (391233 % 67700)--- Amount {_negated = False, _dollars = DecDigit5 :| [], _cents1 = DecDigit7, _cents2 = DecDigit7}-amountRealTruncate ::- Integral a =>- Ratio a- -> Amount-amountRealTruncate =- amountReal truncate---- |------ >>> amountRealCeiling 0--- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit0}------ >>> amountRealCeiling 0.01--- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}------ >>> amountRealCeiling 0.0123--- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit2}------ >>> amountRealCeiling (-0.01)--- Amount {_negated = True, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}------ >>> amountRealCeiling (-0.0123)--- Amount {_negated = True, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}------ >>> amountRealCeiling (-12.01)--- Amount {_negated = True, _dollars = DecDigit1 :| [DecDigit2], _cents1 = DecDigit0, _cents2 = DecDigit1}------ >>> amountRealCeiling (452.99)--- Amount {_negated = False, _dollars = DecDigit4 :| [DecDigit5,DecDigit2], _cents1 = DecDigit9, _cents2 = DecDigit9}------ >>> amountRealCeiling (391233 % 67700)--- Amount {_negated = False, _dollars = DecDigit5 :| [], _cents1 = DecDigit7, _cents2 = DecDigit8}-amountRealCeiling ::- Integral a =>- Ratio a- -> Amount-amountRealCeiling =- amountReal ceiling---- |------ >>> amountRealFloor 0--- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit0}------ >>> amountRealFloor 0.01--- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}------ >>> amountRealFloor 0.0123--- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}------ >>> amountRealFloor (-0.01)--- Amount {_negated = True, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}------ >>> amountRealFloor (-0.0123)--- Amount {_negated = True, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit2}------ >>> amountRealFloor (-12.01)--- Amount {_negated = True, _dollars = DecDigit1 :| [DecDigit2], _cents1 = DecDigit0, _cents2 = DecDigit1}------ >>> amountRealFloor (452.99)--- Amount {_negated = False, _dollars = DecDigit4 :| [DecDigit5,DecDigit2], _cents1 = DecDigit9, _cents2 = DecDigit9}------ >>> amountRealFloor (391233 % 67700)--- Amount {_negated = False, _dollars = DecDigit5 :| [], _cents1 = DecDigit7, _cents2 = DecDigit7}-amountRealFloor ::- Integral a =>- Ratio a- -> Amount-amountRealFloor =- amountReal floor--amountReal ::- Num a =>- (a -> Integer)- -> a- -> Amount-amountReal loss r =- let div10 x = over _2 (fromMaybe DecDigit0 . preview integralDecimal) (divMod x 10)- n = loss (r * 100) :: Integer- (as1, c2) = div10 (abs n)- (as2, c1) = div10 as1- in Amount (n < 0) (either id id (integralDecDigits as2)) c1 c2--integralAmount100 ::- Integral a =>- Amount- -> a-integralAmount100 (Amount n ds d1 d2) =- let neg =- if n then (-1) else 1- in neg * (decDigitsIntegral (Right ds) * 100 + decDigitsIntegral (Right (d1 :| [d2])))---- |------ >>> Amount False (DecDigit1 :| []) DecDigit0 DecDigit0 <> Amount False (DecDigit1 :| []) DecDigit0 DecDigit0--- Amount {_negated = False, _dollars = DecDigit2 :| [], _cents1 = DecDigit0, _cents2 = DecDigit0}------ >>> Amount True (DecDigit1 :| []) DecDigit0 DecDigit0 <> Amount False (DecDigit1 :| []) DecDigit0 DecDigit0--- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit0}------ >>> Amount False (DecDigit1 :| []) DecDigit0 DecDigit0 <> Amount True (DecDigit1 :| []) DecDigit0 DecDigit0--- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit0}------ >>> Amount True (DecDigit1 :| [DecDigit2]) DecDigit5 DecDigit9 <> Amount True (DecDigit9 :| []) DecDigit7 DecDigit3--- Amount {_negated = True, _dollars = DecDigit2 :| [DecDigit2], _cents1 = DecDigit3, _cents2 = DecDigit2}------ >>> Amount False (DecDigit1 :| [DecDigit2]) DecDigit5 DecDigit9 <> Amount True (DecDigit9 :| []) DecDigit7 DecDigit3--- Amount {_negated = False, _dollars = DecDigit2 :| [], _cents1 = DecDigit8, _cents2 = DecDigit6}------ >>> Amount False (DecDigit1 :| [DecDigit2]) DecDigit5 DecDigit9 <> Amount False (DecDigit9 :| []) DecDigit7 DecDigit3--- Amount {_negated = False, _dollars = DecDigit2 :| [DecDigit2], _cents1 = DecDigit3, _cents2 = DecDigit2}-instance Semigroup Amount where- a1 <> a2 =- amountRealTruncate (realAmount a1 + realAmount a2 :: Ratio Integer)--instance Monoid Amount where- mempty =- Amount False (DecDigit0 :| []) DecDigit0 DecDigit0--data Transaction =- Transaction {- _date ::- Date- , _amount ::- Amount- , _accountNumber ::- String- , _emptyField ::- String- , _transactionType ::- String- , _details ::- String- , _balance ::- Amount- , _category ::- String- , _merchantName ::- String- } deriving (Eq, Ord, Show)--class AsTransaction a where- _Transaction ::- Prism' a Transaction--instance AsTransaction Transaction where- _Transaction =- id--class HasTransaction a where- transaction ::- Lens' a Transaction- accountNumber ::- Lens' a String- accountNumber =- transaction .- \f (Transaction dt am an ef tt dl bl ct mn) -> fmap (\an' -> Transaction dt am an' ef tt dl bl ct mn) (f an)- emptyField ::- Lens' a String- emptyField =- transaction .- \f (Transaction dt am an ef tt dl bl ct mn) -> fmap (\ef' -> Transaction dt am an ef' tt dl bl ct mn) (f ef)- transactionType ::- Lens' a String- transactionType =- transaction .- \f (Transaction dt am an ef tt dl bl ct mn) -> fmap (\tt' -> Transaction dt am an ef tt' dl bl ct mn) (f tt)- details ::- Lens' a String- details =- transaction .- \f (Transaction dt am an ef tt dl bl ct mn) -> fmap (\dl' -> Transaction dt am an ef tt dl' bl ct mn) (f dl)- balance ::- Lens' a Amount- balance =- transaction .- \f (Transaction dt am an ef tt dl bl ct mn) -> fmap (\bl' -> Transaction dt am an ef tt dl bl' ct mn) (f bl)- category ::- Lens' a String- category =- transaction .- \f (Transaction dt am an ef tt dl bl ct mn) -> fmap (\ct' -> Transaction dt am an ef tt dl bl ct' mn) (f ct)- merchantName ::- Lens' a String- merchantName =- transaction .- \f (Transaction dt am an ef tt dl bl ct mn) -> fmap (\mn' -> Transaction dt am an ef tt dl bl ct mn') (f mn)--instance HasTransaction Transaction where- transaction =- id--instance HasDate Transaction where- date f (Transaction dt am an ef tt dl bl ct mn) =- fmap (\dt' -> Transaction dt' am an ef tt dl bl ct mn) (f dt)--instance HasAmount Transaction where- amount f (Transaction dt am an ef tt dl bl ct mn) =- fmap (\am' -> Transaction dt am' an ef tt dl bl ct mn) (f am)--encodeTransaction ::- NameEncode Transaction-encodeTransaction =- contramap _date encodeDate <>- contramap _amount (encodeAmount "Amount") <>- fromString "Account Number" =: contramap _accountNumber E.string <>- fromString "" =: contramap _emptyField E.string <>- fromString "Transaction Type" =: contramap _transactionType E.string <>- fromString "Transaction Details" =: contramap _details E.string <>- contramap _balance (encodeAmount "Balance") <>- fromString "Category" =: contramap _category E.string <>- fromString "Merchant Name" =: contramap _merchantName E.string--encodeTransactionNoEmptyField ::- NameEncode Transaction-encodeTransactionNoEmptyField =- contramap _date encodeDate <>- contramap _amount (encodeAmount "Amount") <>- fromString "Account Number" =: contramap _accountNumber E.string <>- fromString "Transaction Type" =: contramap _transactionType E.string <>- fromString "Transaction Details" =: contramap _details E.string <>- contramap _balance (encodeAmount "Balance") <>- fromString "Category" =: contramap _category E.string <>- fromString "Merchant Name" =: contramap _merchantName E.string--decodeTransaction ::- Decode ByteString ByteString Transaction-decodeTransaction =- Transaction <$>- decodeDate <*>- decodeAmount <*>- D.string <*>- D.string <*>- D.string <*>- D.string <*>- decodeAmount <*>- D.string <*>- D.string--date' ::- MonadReader Transaction f =>- f Date-date' =- view date--dateDay' ::- MonadReader Transaction f =>- f Day-dateDay' =- fmap dateDay date'--amount' ::- MonadReader Transaction f =>- f Amount-amount' =- view amount--amountRatio' ::- (MonadReader Transaction f, Integral b) =>- f (Ratio b)-amountRatio' =- fmap realAmount amount'--accountNumber' ::- MonadReader Transaction f =>- f String-accountNumber' =- view accountNumber--emptyField' ::- MonadReader Transaction f =>- f String-emptyField' =- view emptyField--transactionType' ::- MonadReader Transaction f =>- f String-transactionType' =- view transactionType--details' ::- MonadReader Transaction f =>- f String-details' =- view details--balance' ::- MonadReader Transaction f =>- f Amount-balance' =- view balance--balanceRatio' ::- (MonadReader Transaction f, Integral b) =>- f (Ratio b)-balanceRatio' =- fmap realAmount balance'--category' ::- MonadReader Transaction f =>- f String-category' =- view category--merchantName' ::- MonadReader Transaction f =>- f String-merchantName' =- view merchantName--parseTransactionDirectory ::- MonadIO m =>- FilePath- -> ExceptT (D.DecodeErrors ByteString) m [Transaction]-parseTransactionDirectory p =- let parseCSVDirectory ::- MonadIO m =>- Decode' ByteString a- -> FilePath- -> ExceptT (D.DecodeErrors ByteString) m [a]- parseCSVDirectory dec fp =- let files =- do e <- liftIO (doesDirectoryExist fp)- if e- then- do d <- liftIO (listDirectory fp)- pure (fmap (fp </>) d)- else- pure [fp]- in ExceptT $- do f <- files- x <- mapM (parseDecodeFromFile dec (ParseOptions comma Headed)) f- pure (fmap concat (toEither (sequenceA x)))- sortTransactions ::- [Transaction]- -> [Transaction]- sortTransactions =- let comp t1 t2 =- comparing dateDay' t1 t2 <> comparing accountNumber' t1 t2- in sortBy comp- in fmap sortTransactions (parseCSVDirectory decodeTransaction p)
+ src/Data/Bank/NationalAustraliaBank/Report.hs view
@@ -0,0 +1,51 @@+{-# OPTIONS_GHC -Wall #-}++module Data.Bank.NationalAustraliaBank.Report where++import Data.Bank.NationalAustraliaBank.Transaction+ ( Transaction,+ Amount,+ Date,+ diffDates,+ realAmount,+ date',+ amount' )+import Data.Ratio ( Ratio )++cumulativeSumTransactions ::+ [Transaction]+ -> [Amount]+cumulativeSumTransactions [] =+ []+cumulativeSumTransactions (h:t) =+ scanl (\a t' -> amount' t' <> a) (amount' h) t++cumulativeDays ::+ [Transaction]+ -> [Integer]+cumulativeDays [] =+ []+cumulativeDays r@(h:_) =+ cumulativeDays' (date' h) r++cumulativeDays' ::+ Date+ -> [Transaction]+ -> [Integer]+cumulativeDays' d =+ fmap (\t -> d `diffDates` date' t + 1)++cumulativePerDay ::+ [Transaction]+ -> [Ratio Integer]+cumulativePerDay [] =+ []+cumulativePerDay r@(h:_) =+ cumulativePerDay' (date' h) r++cumulativePerDay' ::+ Date+ -> [Transaction]+ -> [Ratio Integer]+cumulativePerDay' dt txs =+ zipWith (\a i -> realAmount a / fromInteger i) (cumulativeSumTransactions txs) (cumulativeDays' dt txs)
+ src/Data/Bank/NationalAustraliaBank/Search.hs view
@@ -0,0 +1,212 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE FlexibleContexts #-}++module Data.Bank.NationalAustraliaBank.Search where++import Control.Applicative ( Alternative(empty) )+import Control.Monad.Reader.Class ( MonadReader )+import Data.Bank.NationalAustraliaBank.Transaction+ ( Transaction, Date, dateDay, date' )+import Data.Bool ( bool )+import Data.Either ( isRight )+import Data.Functor.Identity ( Identity )+import Data.List ( isInfixOf )+import Data.List.NonEmpty ( some1 )+import Data.Time ( diffDays )+import Text.Parsec(Stream, ParsecT, Parsec, parse, try, string, char, eof, noneOf)++fromBool ::+ Alternative f =>+ a+ -> Bool+ -> f a+fromBool =+ bool empty . pure++predicate ::+ (Alternative g, Functor f) =>+ (a -> Bool)+ -> f a+ -> x+ -> f (g x)+predicate f b x =+ fmap (fromBool x . f) b++contains ::+ (Eq a, Functor f, Alternative g) =>+ [a]+ -> f [a]+ -> x+ -> f (g x)+contains =+ predicate . isInfixOf++notContains ::+ (Eq a, Functor f, Alternative g) =>+ [a]+ -> f [a]+ -> x+ -> f (g x)+notContains a =+ predicate (not . isInfixOf a)++equals ::+ (Eq a, Functor f, Alternative g) =>+ a+ -> f a+ -> x+ -> f (g x)+equals a =+ predicate (a ==)++notEquals ::+ (Eq a, Functor f, Alternative g) =>+ a+ -> f a+ -> x+ -> f (g x)+notEquals a =+ predicate (a /=)++(.&&.) ::+ (Eq (g x), Monad f, Alternative g) =>+ (x -> f (g x))+ -> (x -> f (g x))+ -> (x -> f (g x))+p .&&. q =+ \x ->+ p x >>= \g -> bool (q x) (pure g) (g == empty)++infixr 6 .&&.++(.||.) ::+ (Eq (g x), Monad f, Alternative g) =>+ (x -> f (g x))+ -> (x -> f (g x))+ -> (x -> f (g x))+p .||. q =+ \x ->+ p x >>= \g -> bool (pure g) (q x) (g == empty)++infixr 5 .||.++(.|||.) ::+ (Monad f, Alternative g, Eq (g x)) =>+ (a -> b -> x -> f (g x))+ -> (a -> b -> x -> f (g x))+ -> a -> b -> x -> f (g x)+p .|||. q =+ \a fa ->+ p a fa .||. q a fa++infixl 9 .|||.++(~~) :: a -> (a -> b) -> b+(~~) a f =+ f a++infixl 7 ~~++($$) :: (a -> b) -> a -> b+($$) =+ ($)++infixl 7 $$++($$$) ::+ Monoid b =>+ (a -> b)+ -> [a]+ -> b+($$$) =+ foldMap++infixl 7 $$$++parenthesisedParser ::+ Stream s m Char =>+ String+ -> ParsecT s u m ()+parenthesisedParser s =+ string s *> string " (" *> some1 (noneOf ")") *> char ')' *> eof++parses ::+ (Functor f, Alternative g, Stream s Identity t) =>+ Parsec s () c+ -> f s+ -> x+ -> f (g x)+parses p =+ predicate (isRight . parse (try p) "parses")++parenthesised ::+ (Functor f, Alternative g, Stream s Identity Char) =>+ String+ -> f s+ -> x+ -> f (g x)+parenthesised =+ parses . parenthesisedParser++dateDiffPredicate ::+ (Alternative g, MonadReader Transaction f) =>+ (Integer -> Bool)+ -> Date+ -> x+ -> f (g x)+dateDiffPredicate p d =+ predicate (p . diffDays (dateDay d) . dateDay) date'++dateEquals ::+ (Alternative g, MonadReader Transaction f) =>+ Date+ -> x+ -> f (g x)+dateEquals =+ dateDiffPredicate (== 0)++dateAfterIncl ::+ (Alternative g, MonadReader Transaction f) =>+ Date+ -> x+ -> f (g x)+dateAfterIncl =+ dateDiffPredicate (<= 0)++dateBeforeIncl ::+ (Alternative g, MonadReader Transaction f) =>+ Date+ -> x+ -> f (g x)+dateBeforeIncl =+ dateDiffPredicate (>= 0)++dateBetweenIncl ::+ (Eq (g x), Alternative g, MonadReader Transaction f) =>+ Date+ -> Date+ -> x+ -> f (g x)+dateBetweenIncl dt1 dt2 =+ dateAfterIncl dt1 .&&. dateBeforeIncl dt2++(...||) ::+ (Monad f, Foldable k, Alternative g, Eq (g x)) =>+ (a -> f a -> x -> f (g x))+ -> k a -> f a -> x -> f (g x)+f ...|| t =+ \v ->+ foldr (\a b -> f a v .||. b) (pure (pure empty)) t++infixl 9 ...||++(...&&) ::+ (Monad f, Foldable k, Alternative g, Eq (g x)) =>+ (a -> f a -> x -> f (g x))+ -> k a+ -> (f a -> x -> f (g x))+f ...&& t =+ \v x ->+ foldr (\a b -> f a v .&&. b) (pure (pure (pure x))) t x++infixl 9 ...&&
+ src/Data/Bank/NationalAustraliaBank/Transaction.hs view
@@ -0,0 +1,859 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}++module Data.Bank.NationalAustraliaBank.Transaction where++import Control.Applicative (Alternative((<|>)))+import Control.Lens( Lens', Prism', prism', (#), view, preview, over, _2 )+import Control.Monad.IO.Class ( MonadIO(..) )+import Control.Monad.Reader.Class ( MonadReader )+import Control.Monad.Trans.Except ( ExceptT(..) )+import Data.Bool(bool)+import Data.List ( sortBy )+import Data.Functor( Functor(..), (<$>) )+import Data.Functor.Identity ( Identity(..) )+import Data.ByteString(ByteString)+import qualified Data.ByteString.Lazy.UTF8 as L(fromString)+import Data.Digit+ ( charDecimal,+ parseDecimal,+ decDigitsIntegral,+ integralDecDigits,+ integralDecimal,+ DecDigit(DecDigit0) )+import Data.Foldable ( asum, toList )+import Data.List.NonEmpty ( NonEmpty(..), some1 )+import Data.Maybe( fromMaybe )+import Data.Ord( comparing )+import Data.String ( IsString(fromString) )+import Data.Sv+ ( parseDecodeFromFile,+ (=:),+ comma,+ ParseOptions(ParseOptions),+ Decode,+ Decode',+ NameEncode,+ Headedness(Headed) )+import qualified Data.Sv.Decode as D+import qualified Data.Sv.Encode as E+import Data.Validation ( toEither )+import Data.Time ( fromGregorian, toGregorian, diffDays, Day )+import Data.Functor.Contravariant ( Contravariant(contramap) )+import Data.Ratio ( Ratio, (%) )+import System.Directory+ ( doesDirectoryExist,+ listDirectory )+import System.FilePath ( (</>) )+import Text.Parsec+ ( char,+ string,+ try,+ ParsecT,+ Stream )++-- $setup+-- >>> import Data.Digit++data Month =+ Jan+ | Feb+ | Mar+ | Apr+ | May+ | Jun+ | Jul+ | Aug+ | Sep+ | Oct+ | Nov+ | Dec+ deriving (Eq, Ord, Show)++class HasMonth a where+ month ::+ Lens' a Month++instance HasMonth Month where+ month =+ id++class AsMonth a where+ _Month ::+ Prism' a Month+ _Jan ::+ Prism' a ()+ _Jan =+ _Month .+ prism'+ (\() -> Jan)+ (\case+ Jan ->+ Just ()+ _ ->+ Nothing)+ _Feb ::+ Prism' a ()+ _Feb =+ _Month .+ prism'+ (\() -> Feb)+ (\case+ Feb ->+ Just ()+ _ ->+ Nothing)+ _Mar ::+ Prism' a ()+ _Mar =+ _Month .+ prism'+ (\() -> Mar)+ (\case+ Mar ->+ Just ()+ _ ->+ Nothing)+ _Apr ::+ Prism' a ()+ _Apr =+ _Month .+ prism'+ (\() -> Apr)+ (\case+ Apr ->+ Just ()+ _ ->+ Nothing)+ _May ::+ Prism' a ()+ _May =+ _Month .+ prism'+ (\() -> May)+ (\case+ May ->+ Just ()+ _ ->+ Nothing)+ _Jun ::+ Prism' a ()+ _Jun =+ _Month .+ prism'+ (\() -> Jun)+ (\case+ Jun ->+ Just ()+ _ ->+ Nothing)+ _Jul ::+ Prism' a ()+ _Jul =+ _Month .+ prism'+ (\() -> Jul)+ (\case+ Jul ->+ Just ()+ _ ->+ Nothing)+ _Aug ::+ Prism' a ()+ _Aug =+ _Month .+ prism'+ (\() -> Aug)+ (\case+ Aug ->+ Just ()+ _ ->+ Nothing)+ _Sep ::+ Prism' a ()+ _Sep =+ _Month .+ prism'+ (\() -> Sep)+ (\case+ Sep ->+ Just ()+ _ ->+ Nothing)+ _Oct ::+ Prism' a ()+ _Oct =+ _Month .+ prism'+ (\() -> Oct)+ (\case+ Oct ->+ Just ()+ _ ->+ Nothing)+ _Nov ::+ Prism' a ()+ _Nov =+ _Month .+ prism'+ (\() -> Nov)+ (\case+ Nov ->+ Just ()+ _ ->+ Nothing)+ _Dec ::+ Prism' a ()+ _Dec =+ _Month .+ prism'+ (\() -> Dec)+ (\case+ Dec ->+ Just ()+ _ ->+ Nothing)++instance AsMonth Month where+ _Month =+ id++parseMonth ::+ Stream s m Char =>+ ParsecT s u m Month+parseMonth =+ asum . fmap try $ [+ Jan <$ string "Jan"+ , Feb <$ string "Feb"+ , Mar <$ string "Mar"+ , Apr <$ string "Apr"+ , May <$ string "May"+ , Jun <$ string "Jun"+ , Jul <$ string "Jul"+ , Aug <$ string "Aug"+ , Sep <$ string "Sep"+ , Oct <$ string "Oct"+ , Nov <$ string "Nov"+ , Dec <$ string "Dec"+ ]++data Date =+ Date {+ _day1 ::+ DecDigit+ , _day2 ::+ DecDigit+ , _month ::+ Month+ , _year1 ::+ DecDigit+ , _year2 ::+ DecDigit+ } deriving (Eq, Show)++class HasDate a where+ date ::+ Lens' a Date+ day1 ::+ Lens' a DecDigit+ day1 =+ date .+ \f (Date d1 d2 m y1 y2) -> fmap (\d1' -> Date d1' d2 m y1 y2) (f d1)+ day2 ::+ Lens' a DecDigit+ day2 =+ date .+ \f (Date d1 d2 m y1 y2) -> fmap (\d2' -> Date d1 d2' m y1 y2) (f d2)+ year1 ::+ Lens' a DecDigit+ year1 =+ date .+ \f (Date d1 d2 m y1 y2) -> fmap (\y1' -> Date d1 d2 m y1' y2) (f y1)+ year2 ::+ Lens' a DecDigit+ year2 =+ date .+ \f (Date d1 d2 m y1 y2) -> fmap (\y2' -> Date d1 d2 m y1 y2') (f y2)++instance HasDate Date where+ date =+ id++instance HasMonth Date where+ month f (Date d1 d2 m y1 y2) =+ fmap (\m' -> Date d1 d2 m' y1 y2) (f m)++class AsDate a where+ _Date ::+ Prism' a Date++instance AsDate Date where+ _Date =+ id++instance Ord Date where+ Date d1 d2 m y1 y2 `compare` Date e1 e2 n z1 z2 =+ let twoDigits a b = decDigitsIntegral (Right (a :| [b]))+ d = twoDigits d1 d2 :: Int+ e = twoDigits e1 e2 :: Int+ y = twoDigits y1 y2 :: Int+ z = twoDigits z1 z2 :: Int+ in (y, m, d) `compare` (z, n, e)++parseDate ::+ Stream s Identity Char =>+ ParsecT s u Identity Date+parseDate =+ Date <$>+ parseDecimal <*>+ parseDecimal <*+ char ' ' <*>+ parseMonth <*+ char ' ' <*>+ parseDecimal <*>+ parseDecimal++decodeDate ::+ Decode' ByteString Date+decodeDate =+ D.withParsec parseDate++encodeDate ::+ NameEncode Date+encodeDate =+ fromString "Date" =: E.mkEncodeBS (\(Date d1 d2 m y1 y2) ->+ L.fromString (concat [[charDecimal # d1, charDecimal # d2, ' '], show m, [' ', charDecimal # y1], [charDecimal # y2]]))++dayDate ::+ Day+ -> Date+dayDate day =+ let (y, m, d) = toGregorian day+ twodigits x =+ case either id id (integralDecDigits x) of+ h :| [] ->+ (DecDigit0, h)+ h :| i : _ ->+ (h, i)+ (d1, d2) = twodigits d+ m' = case m of+ 1 -> Jan+ 2 -> Feb+ 3 -> Mar+ 4 -> Apr+ 5 -> May+ 6 -> Jun+ 7 -> Jul+ 8 -> Aug+ 9 -> Sep+ 10 -> Oct+ 11 -> Nov+ _ -> Dec+ (y1, y2) = twodigits (y - 2000)+ in Date d1 d2 m' y1 y2++dateDay ::+ Date+ -> Day+dateDay (Date d1 d2 m y1 y2) =+ let year = 2000 + integralDecimal # y1 * 10 + integralDecimal # y2+ mon Jan = 1+ mon Feb = 2+ mon Mar = 3+ mon Apr = 4+ mon May = 5+ mon Jun = 6+ mon Jul = 7+ mon Aug = 8+ mon Sep = 9+ mon Oct = 10+ mon Nov = 11+ mon Dec = 12+ dt = integralDecimal # d1 * 10 + integralDecimal # d2+ in fromGregorian year (mon m) dt++diffDates ::+ Date+ -> Date+ -> Integer+diffDates dt1 dt2 =+ dateDay dt1 `diffDays` dateDay dt2++data Amount =+ Amount {+ _negated ::+ Bool+ , _dollars ::+ NonEmpty DecDigit+ , _cents1 ::+ DecDigit+ , _cents2 ::+ DecDigit+ } deriving (Eq, Ord, Show)++class AsAmount a where+ _Amount ::+ Prism' a Amount++instance AsAmount Amount where+ _Amount =+ id++class HasAmount a where+ amount ::+ Lens' a Amount+ negated ::+ Lens' a Bool+ negated =+ amount .+ \f (Amount n d c1 c2) -> fmap (\n' -> Amount n' d c1 c2) (f n)+ dollars ::+ Lens' a (NonEmpty DecDigit)+ dollars =+ amount .+ \f (Amount n d c1 c2) -> fmap (\d' -> Amount n d' c1 c2) (f d)+ cents1 ::+ Lens' a DecDigit+ cents1 =+ amount .+ \f (Amount n d c1 c2) -> fmap (\c1' -> Amount n d c1' c2) (f c1)+ cents2 ::+ Lens' a DecDigit+ cents2 =+ amount .+ \f (Amount n d c1 c2) -> fmap (\c2' -> Amount n d c1 c2') (f c2)++instance HasAmount Amount where+ amount =+ id++parseAmount ::+ Stream s Identity Char =>+ ParsecT s u Identity Amount+parseAmount =+ Amount <$>+ try (True <$ char '-' <|> pure False) <*>+ some1 parseDecimal <*+ char '.' <*>+ parseDecimal <*>+ parseDecimal++decodeAmount ::+ Decode' ByteString Amount+decodeAmount =+ D.withParsec parseAmount++encodeAmount ::+ String+ -> NameEncode Amount+encodeAmount label =+ fromString label =: E.mkEncodeBS (\(Amount n d c1 c2) ->+ L.fromString (concat [bool "" "-" n, fmap (charDecimal #) (toList d), ".", [charDecimal # c1], [charDecimal # c2]]))++realAmount ::+ Integral a =>+ Amount+ -> Ratio a+realAmount a =+ integralAmount100 a % 100++-- |+--+-- >>> amountRealRound 0+-- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit0}+--+-- >>> amountRealRound 0.01+-- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}+--+-- >>> amountRealRound 0.0123+-- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}+--+-- >>> amountRealRound (-0.01)+-- Amount {_negated = True, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}+--+-- >>> amountRealRound (-0.0123)+-- Amount {_negated = True, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}+--+-- >>> amountRealRound (-12.01)+-- Amount {_negated = True, _dollars = DecDigit1 :| [DecDigit2], _cents1 = DecDigit0, _cents2 = DecDigit1}+--+-- >>> amountRealRound (452.99)+-- Amount {_negated = False, _dollars = DecDigit4 :| [DecDigit5,DecDigit2], _cents1 = DecDigit9, _cents2 = DecDigit9}+--+-- >>> amountRealRound (391233 % 67700)+-- Amount {_negated = False, _dollars = DecDigit5 :| [], _cents1 = DecDigit7, _cents2 = DecDigit8}+amountRealRound ::+ Integral a =>+ Ratio a+ -> Amount+amountRealRound =+ amountReal round++-- |+--+-- >>> amountRealTruncate 0+-- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit0}+--+-- >>> amountRealTruncate 0.01+-- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}+--+-- >>> amountRealTruncate 0.0123+-- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}+--+-- >>> amountRealTruncate (-0.01)+-- Amount {_negated = True, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}+--+-- >>> amountRealTruncate (-0.0123)+-- Amount {_negated = True, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}+--+-- >>> amountRealTruncate (-12.01)+-- Amount {_negated = True, _dollars = DecDigit1 :| [DecDigit2], _cents1 = DecDigit0, _cents2 = DecDigit1}+--+-- >>> amountRealTruncate (452.99)+-- Amount {_negated = False, _dollars = DecDigit4 :| [DecDigit5,DecDigit2], _cents1 = DecDigit9, _cents2 = DecDigit9}+--+-- >>> amountRealTruncate (391233 % 67700)+-- Amount {_negated = False, _dollars = DecDigit5 :| [], _cents1 = DecDigit7, _cents2 = DecDigit7}+amountRealTruncate ::+ Integral a =>+ Ratio a+ -> Amount+amountRealTruncate =+ amountReal truncate++-- |+--+-- >>> amountRealCeiling 0+-- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit0}+--+-- >>> amountRealCeiling 0.01+-- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}+--+-- >>> amountRealCeiling 0.0123+-- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit2}+--+-- >>> amountRealCeiling (-0.01)+-- Amount {_negated = True, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}+--+-- >>> amountRealCeiling (-0.0123)+-- Amount {_negated = True, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}+--+-- >>> amountRealCeiling (-12.01)+-- Amount {_negated = True, _dollars = DecDigit1 :| [DecDigit2], _cents1 = DecDigit0, _cents2 = DecDigit1}+--+-- >>> amountRealCeiling (452.99)+-- Amount {_negated = False, _dollars = DecDigit4 :| [DecDigit5,DecDigit2], _cents1 = DecDigit9, _cents2 = DecDigit9}+--+-- >>> amountRealCeiling (391233 % 67700)+-- Amount {_negated = False, _dollars = DecDigit5 :| [], _cents1 = DecDigit7, _cents2 = DecDigit8}+amountRealCeiling ::+ Integral a =>+ Ratio a+ -> Amount+amountRealCeiling =+ amountReal ceiling++-- |+--+-- >>> amountRealFloor 0+-- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit0}+--+-- >>> amountRealFloor 0.01+-- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}+--+-- >>> amountRealFloor 0.0123+-- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}+--+-- >>> amountRealFloor (-0.01)+-- Amount {_negated = True, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit1}+--+-- >>> amountRealFloor (-0.0123)+-- Amount {_negated = True, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit2}+--+-- >>> amountRealFloor (-12.01)+-- Amount {_negated = True, _dollars = DecDigit1 :| [DecDigit2], _cents1 = DecDigit0, _cents2 = DecDigit1}+--+-- >>> amountRealFloor (452.99)+-- Amount {_negated = False, _dollars = DecDigit4 :| [DecDigit5,DecDigit2], _cents1 = DecDigit9, _cents2 = DecDigit9}+--+-- >>> amountRealFloor (391233 % 67700)+-- Amount {_negated = False, _dollars = DecDigit5 :| [], _cents1 = DecDigit7, _cents2 = DecDigit7}+amountRealFloor ::+ Integral a =>+ Ratio a+ -> Amount+amountRealFloor =+ amountReal floor++amountReal ::+ Num a =>+ (a -> Integer)+ -> a+ -> Amount+amountReal loss r =+ let div10 x = over _2 (fromMaybe DecDigit0 . preview integralDecimal) (divMod x 10)+ n = loss (r * 100) :: Integer+ (as1, c2) = div10 (abs n)+ (as2, c1) = div10 as1+ in Amount (n < 0) (either id id (integralDecDigits as2)) c1 c2++integralAmount100 ::+ Integral a =>+ Amount+ -> a+integralAmount100 (Amount n ds d1 d2) =+ let neg =+ if n then (-1) else 1+ in neg * (decDigitsIntegral (Right ds) * 100 + decDigitsIntegral (Right (d1 :| [d2])))++-- |+--+-- >>> Amount False (DecDigit1 :| []) DecDigit0 DecDigit0 <> Amount False (DecDigit1 :| []) DecDigit0 DecDigit0+-- Amount {_negated = False, _dollars = DecDigit2 :| [], _cents1 = DecDigit0, _cents2 = DecDigit0}+--+-- >>> Amount True (DecDigit1 :| []) DecDigit0 DecDigit0 <> Amount False (DecDigit1 :| []) DecDigit0 DecDigit0+-- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit0}+--+-- >>> Amount False (DecDigit1 :| []) DecDigit0 DecDigit0 <> Amount True (DecDigit1 :| []) DecDigit0 DecDigit0+-- Amount {_negated = False, _dollars = DecDigit0 :| [], _cents1 = DecDigit0, _cents2 = DecDigit0}+--+-- >>> Amount True (DecDigit1 :| [DecDigit2]) DecDigit5 DecDigit9 <> Amount True (DecDigit9 :| []) DecDigit7 DecDigit3+-- Amount {_negated = True, _dollars = DecDigit2 :| [DecDigit2], _cents1 = DecDigit3, _cents2 = DecDigit2}+--+-- >>> Amount False (DecDigit1 :| [DecDigit2]) DecDigit5 DecDigit9 <> Amount True (DecDigit9 :| []) DecDigit7 DecDigit3+-- Amount {_negated = False, _dollars = DecDigit2 :| [], _cents1 = DecDigit8, _cents2 = DecDigit6}+--+-- >>> Amount False (DecDigit1 :| [DecDigit2]) DecDigit5 DecDigit9 <> Amount False (DecDigit9 :| []) DecDigit7 DecDigit3+-- Amount {_negated = False, _dollars = DecDigit2 :| [DecDigit2], _cents1 = DecDigit3, _cents2 = DecDigit2}+instance Semigroup Amount where+ a1 <> a2 =+ amountRealTruncate (realAmount a1 + realAmount a2 :: Ratio Integer)++instance Monoid Amount where+ mempty =+ Amount False (DecDigit0 :| []) DecDigit0 DecDigit0++data Transaction =+ Transaction {+ _date ::+ Date+ , _amount ::+ Amount+ , _accountNumber ::+ String+ , _emptyField ::+ String+ , _transactionType ::+ String+ , _details ::+ String+ , _balance ::+ Amount+ , _category ::+ String+ , _merchantName ::+ String+ } deriving (Eq, Ord, Show)++class AsTransaction a where+ _Transaction ::+ Prism' a Transaction++instance AsTransaction Transaction where+ _Transaction =+ id++class HasTransaction a where+ transaction ::+ Lens' a Transaction+ accountNumber ::+ Lens' a String+ accountNumber =+ transaction .+ \f (Transaction dt am an ef tt dl bl ct mn) -> fmap (\an' -> Transaction dt am an' ef tt dl bl ct mn) (f an)+ emptyField ::+ Lens' a String+ emptyField =+ transaction .+ \f (Transaction dt am an ef tt dl bl ct mn) -> fmap (\ef' -> Transaction dt am an ef' tt dl bl ct mn) (f ef)+ transactionType ::+ Lens' a String+ transactionType =+ transaction .+ \f (Transaction dt am an ef tt dl bl ct mn) -> fmap (\tt' -> Transaction dt am an ef tt' dl bl ct mn) (f tt)+ details ::+ Lens' a String+ details =+ transaction .+ \f (Transaction dt am an ef tt dl bl ct mn) -> fmap (\dl' -> Transaction dt am an ef tt dl' bl ct mn) (f dl)+ balance ::+ Lens' a Amount+ balance =+ transaction .+ \f (Transaction dt am an ef tt dl bl ct mn) -> fmap (\bl' -> Transaction dt am an ef tt dl bl' ct mn) (f bl)+ category ::+ Lens' a String+ category =+ transaction .+ \f (Transaction dt am an ef tt dl bl ct mn) -> fmap (\ct' -> Transaction dt am an ef tt dl bl ct' mn) (f ct)+ merchantName ::+ Lens' a String+ merchantName =+ transaction .+ \f (Transaction dt am an ef tt dl bl ct mn) -> fmap (\mn' -> Transaction dt am an ef tt dl bl ct mn') (f mn)++instance HasTransaction Transaction where+ transaction =+ id++instance HasDate Transaction where+ date f (Transaction dt am an ef tt dl bl ct mn) =+ fmap (\dt' -> Transaction dt' am an ef tt dl bl ct mn) (f dt)++instance HasAmount Transaction where+ amount f (Transaction dt am an ef tt dl bl ct mn) =+ fmap (\am' -> Transaction dt am' an ef tt dl bl ct mn) (f am)++encodeTransaction ::+ NameEncode Transaction+encodeTransaction =+ contramap _date encodeDate <>+ contramap _amount (encodeAmount "Amount") <>+ fromString "Account Number" =: contramap _accountNumber E.string <>+ fromString "" =: contramap _emptyField E.string <>+ fromString "Transaction Type" =: contramap _transactionType E.string <>+ fromString "Transaction Details" =: contramap _details E.string <>+ contramap _balance (encodeAmount "Balance") <>+ fromString "Category" =: contramap _category E.string <>+ fromString "Merchant Name" =: contramap _merchantName E.string++encodeTransactionNoEmptyField ::+ NameEncode Transaction+encodeTransactionNoEmptyField =+ contramap _date encodeDate <>+ contramap _amount (encodeAmount "Amount") <>+ fromString "Account Number" =: contramap _accountNumber E.string <>+ fromString "Transaction Type" =: contramap _transactionType E.string <>+ fromString "Transaction Details" =: contramap _details E.string <>+ contramap _balance (encodeAmount "Balance") <>+ fromString "Category" =: contramap _category E.string <>+ fromString "Merchant Name" =: contramap _merchantName E.string++decodeTransaction ::+ Decode ByteString ByteString Transaction+decodeTransaction =+ Transaction <$>+ decodeDate <*>+ decodeAmount <*>+ D.string <*>+ D.string <*>+ D.string <*>+ D.string <*>+ decodeAmount <*>+ D.string <*>+ D.string++date' ::+ MonadReader Transaction f =>+ f Date+date' =+ view date++dateDay' ::+ MonadReader Transaction f =>+ f Day+dateDay' =+ fmap dateDay date'++amount' ::+ MonadReader Transaction f =>+ f Amount+amount' =+ view amount++amountRatio' ::+ (MonadReader Transaction f, Integral b) =>+ f (Ratio b)+amountRatio' =+ fmap realAmount amount'++accountNumber' ::+ MonadReader Transaction f =>+ f String+accountNumber' =+ view accountNumber++emptyField' ::+ MonadReader Transaction f =>+ f String+emptyField' =+ view emptyField++transactionType' ::+ MonadReader Transaction f =>+ f String+transactionType' =+ view transactionType++details' ::+ MonadReader Transaction f =>+ f String+details' =+ view details++balance' ::+ MonadReader Transaction f =>+ f Amount+balance' =+ view balance++balanceRatio' ::+ (MonadReader Transaction f, Integral b) =>+ f (Ratio b)+balanceRatio' =+ fmap realAmount balance'++category' ::+ MonadReader Transaction f =>+ f String+category' =+ view category++merchantName' ::+ MonadReader Transaction f =>+ f String+merchantName' =+ view merchantName++parseTransactionDirectory ::+ MonadIO m =>+ FilePath+ -> ExceptT (D.DecodeErrors ByteString) m [Transaction]+parseTransactionDirectory p =+ let parseCSVDirectory ::+ MonadIO m =>+ Decode' ByteString a+ -> FilePath+ -> ExceptT (D.DecodeErrors ByteString) m [a]+ parseCSVDirectory dec fp =+ let files =+ do e <- liftIO (doesDirectoryExist fp)+ if e+ then+ do d <- liftIO (listDirectory fp)+ pure (fmap (fp </>) d)+ else+ pure [fp]+ in ExceptT $+ do f <- files+ x <- mapM (parseDecodeFromFile dec (ParseOptions comma Headed)) f+ pure (fmap concat (toEither (sequenceA x)))+ sortTransactions ::+ [Transaction]+ -> [Transaction]+ sortTransactions =+ let comp t1 t2 =+ comparing dateDay' t1 t2 <> comparing accountNumber' t1 t2+ in sortBy comp+ in fmap sortTransactions (parseCSVDirectory decodeTransaction p)