national-australia-bank 0.0.3 → 0.0.4
raw patch · 3 files changed
+347/−74 lines, 3 files
Files
- changelog.md +4/−0
- national-australia-bank.cabal +1/−1
- src/Data/Bank/NationalAustraliaBank/NationalAustraliaBank.hs +342/−73
changelog.md view
@@ -1,3 +1,7 @@+0.0.4++* Use classy lens/prism+ 0.0.3 * Remove `Combinators` module
national-australia-bank.cabal view
@@ -1,5 +1,5 @@ name: national-australia-bank-version: 0.0.3+version: 0.0.4 synopsis: Functions for National Australia Bank transactions description: Parsing, Processing and other functions for National Australia Bank transactions license: BSD3
src/Data/Bank/NationalAustraliaBank/NationalAustraliaBank.hs view
@@ -1,16 +1,11 @@ {-# OPTIONS_GHC -Wall #-}-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-} module Data.Bank.NationalAustraliaBank.NationalAustraliaBank where import Control.Applicative (Alternative((<|>)))-import Control.Category (Category(..) )-import Control.Lens- ( view,- makePrisms,- (#),- makeLenses )+import Control.Lens( Lens', Prism', prism', (#), view ) import Control.Monad.IO.Class ( MonadIO(..) ) import Control.Monad.Reader.Class ( MonadReader ) import Control.Monad.Trans.Except ( ExceptT(..) )@@ -56,9 +51,8 @@ try, ParsecT, Stream )-import Prelude hiding (id, (.) ) -data TransactionMonth =+data Month = Jan | Feb | Mar@@ -73,12 +67,158 @@ | Dec deriving (Eq, Ord, Show) -makePrisms ''TransactionMonth+class HasMonth a where+ month ::+ Lens' a Month -parseTransactionMonth ::+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 TransactionMonth-parseTransactionMonth =+ ParsecT s u m Month+parseMonth = asum . fmap try $ [ Jan <$ string "Jan" , Feb <$ string "Feb"@@ -94,24 +234,62 @@ , Dec <$ string "Dec" ] -data TransactionDate =- TransactionDate {+data Date =+ Date { _day1 :: DecDigit , _day2 :: DecDigit , _month ::- TransactionMonth+ Month , _year1 :: DecDigit , _year2 :: DecDigit } deriving (Eq, Show) -makeLenses ''TransactionDate+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 Ord TransactionDate where- TransactionDate d1 d2 m y1 y2 `compare` TransactionDate e1 e2 n z1 z2 =+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@@ -119,34 +297,34 @@ z = twoDigits z1 z2 :: Int in (y, m, d) `compare` (z, n, e) -parseTransactionDate ::+parseDate :: Stream s Identity Char =>- ParsecT s u Identity TransactionDate-parseTransactionDate =- TransactionDate <$>+ ParsecT s u Identity Date+parseDate =+ Date <$> parseDecimal <*> parseDecimal <* char ' ' <*>- parseTransactionMonth <*+ parseMonth <* char ' ' <*> parseDecimal <*> parseDecimal -decodeTransactionDate ::- Decode' ByteString TransactionDate-decodeTransactionDate =- D.withParsec parseTransactionDate+decodeDate ::+ Decode' ByteString Date+decodeDate =+ D.withParsec parseDate -encodeTransactionDate ::- NameEncode TransactionDate-encodeTransactionDate =- fromString "Date" =: E.mkEncodeBS (\(TransactionDate d1 d2 m y1 y2) ->+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]])) -transactionDayDate ::+dayDate :: Day- -> TransactionDate-transactionDayDate day =+ -> Date+dayDate day = let (y, m, d) = toGregorian day twodigits x = case either id id (integralDecDigits x) of@@ -169,12 +347,12 @@ 11 -> Nov _ -> Dec (y1, y2) = twodigits (y - 2000)- in TransactionDate d1 d2 m' y1 y2+ in Date d1 d2 m' y1 y2 -transactionDateDay ::- TransactionDate+dateDay ::+ Date -> Day-transactionDateDay (TransactionDate d1 d2 m y1 y2) =+dateDay (Date d1 d2 m y1 y2) = let year = 2000 + integralDecimal # y1 * 10 + integralDecimal # y2 mon Jan = 1 mon Feb = 2@@ -191,8 +369,8 @@ dt = integralDecimal # d1 * 10 + integralDecimal # d2 in fromGregorian year (mon m) dt -data TransactionAmount =- TransactionAmount {+data Amount =+ Amount { _negated :: Bool , _dollars ::@@ -203,36 +381,70 @@ DecDigit } deriving (Eq, Ord, Show) -makeLenses ''TransactionAmount+class AsAmount a where+ _Amount ::+ Prism' a Amount -parseTransactionAmount ::+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 TransactionAmount-parseTransactionAmount =- TransactionAmount <$>+ ParsecT s u Identity Amount+parseAmount =+ Amount <$> try (True <$ char '-' <|> pure False) <*> some1 parseDecimal <* char '.' <*> parseDecimal <*> parseDecimal -decodeTransactionAmount ::- Decode' ByteString TransactionAmount-decodeTransactionAmount =- D.withParsec parseTransactionAmount+decodeAmount ::+ Decode' ByteString Amount+decodeAmount =+ D.withParsec parseAmount -encodeTransactionAmount ::+encodeAmount :: String- -> NameEncode TransactionAmount-encodeTransactionAmount label =- fromString label =: E.mkEncodeBS (\(TransactionAmount n d c1 c2) ->+ -> 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]])) -realTransactionAmount ::+realAmount :: Integral a =>- TransactionAmount+ Amount -> Ratio a-realTransactionAmount (TransactionAmount n ds d1 d2) =+realAmount (Amount n ds d1 d2) = let neg = if n then Left else Right in (decDigitsIntegral (neg ds) * 100 + decDigitsIntegral (Right (d1 :| [d2]))) % 100@@ -240,9 +452,9 @@ data Transaction = Transaction { _date ::- TransactionDate+ Date , _amount ::- TransactionAmount+ Amount , _accountNumber :: String , _emptyField ::@@ -252,25 +464,82 @@ , _details :: String , _balance ::- TransactionAmount+ Amount , _category :: String , _merchantName :: String } deriving (Eq, Ord, Show) -makeLenses ''Transaction+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 encodeTransactionDate <>- contramap _amount (encodeTransactionAmount "Amount") <>+ 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 (encodeTransactionAmount "Balance") <>+ contramap _balance (encodeAmount "Balance") <> fromString "Category" =: contramap _category E.string <> fromString "Merchant Name" =: contramap _merchantName E.string @@ -278,19 +547,19 @@ Decode ByteString ByteString Transaction decodeTransaction = Transaction <$>- decodeTransactionDate <*>- decodeTransactionAmount <*>+ decodeDate <*>+ decodeAmount <*> D.string <*> D.string <*> D.string <*> D.string <*>- decodeTransactionAmount <*>+ decodeAmount <*> D.string <*> D.string date' :: MonadReader Transaction f =>- f TransactionDate+ f Date date' = view date @@ -298,11 +567,11 @@ MonadReader Transaction f => f Day dateDay' =- fmap transactionDateDay date'+ fmap dateDay date' amount' :: MonadReader Transaction f =>- f TransactionAmount+ f Amount amount' = view amount @@ -310,7 +579,7 @@ (MonadReader Transaction f, Integral b) => f (Ratio b) amountRatio' =- fmap realTransactionAmount amount'+ fmap realAmount amount' accountNumber' :: MonadReader Transaction f =>@@ -338,7 +607,7 @@ balance' :: MonadReader Transaction f =>- f TransactionAmount+ f Amount balance' = view balance @@ -346,7 +615,7 @@ (MonadReader Transaction f, Integral b) => f (Ratio b) balanceRatio' =- fmap realTransactionAmount balance'+ fmap realAmount balance' category' :: MonadReader Transaction f =>