national-australia-bank (empty) → 0.0.1
raw patch · 5 files changed
+517/−0 lines, 5 filesdep +basedep +bytestringdep +digitsetup-changed
Dependencies added: base, bytestring, digit, directory, filepath, lens, mtl, parsec, sv, time, transformers, utf8-string, validation
Files
- LICENCE +27/−0
- Setup.hs +3/−0
- changelog.md +3/−0
- national-australia-bank.cabal +42/−0
- src/Data/Bank/NationalAustraliaBank/NationalAustraliaBank.hs +442/−0
+ LICENCE view
@@ -0,0 +1,27 @@+Copyright 2023 Tony Morris++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple+main = defaultMain+
+ changelog.md view
@@ -0,0 +1,3 @@+0.0.1++* This change log starts
+ national-australia-bank.cabal view
@@ -0,0 +1,42 @@+name: national-australia-bank+version: 0.0.1+synopsis: Functions for National Australia Bank transactions+description: Parsing, Processing and other functions for National Australia Bank transactions+license: BSD3+license-file: LICENCE+author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ>+maintainer: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ>+copyright: Copyright (C) 2023 Tony Morris+category: Test+build-type: Simple+extra-source-files: changelog.md+cabal-version: >=1.10+homepage: https://gitlab.com/tonymorris/national-australia-bank+bug-reports: https://gitlab.com/tonymorris/national-australia-bank/issues+tested-with: GHC == 9.0.2++source-repository head+ type: git+ location: git@gitlab.com:tonymorris/national-australia-bank.git++library+ exposed-modules:+ Data.Bank.NationalAustraliaBank.NationalAustraliaBank++ build-depends: base >= 4.9 && < 4.15+ , bytestring == 0.10.8.2+ , digit == 0.12+ , directory == 1.3.6.1+ , filepath == 1.4.2.1+ , lens == 4.19.2+ , mtl == 2.2.2+ , parsec == 3.1.13.0+ , time == 1.8.0.2+ , validation == 1.1.3+ , sv == 1.4.0.1+ , transformers == 0.5.6.2+ , utf8-string == 1.0.2++ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall
+ src/Data/Bank/NationalAustraliaBank/NationalAustraliaBank.hs view
@@ -0,0 +1,442 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}++module Data.Bank.NationalAustraliaBank.NationalAustraliaBank where++import Control.Applicative (Applicative(liftA2), Alternative((<|>)))+import Control.Category (Category(..) )+import Control.Lens+ ( view,+ makePrisms,+ (#),+ makeLenses,+ Field1(_1),+ Field2(_2) )+import Control.Monad.IO.Class ( MonadIO(..) )+import Control.Monad.State+ ( mapM, StateT, gets )+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 ( Foldable, asum, toList )+import Data.List.NonEmpty ( NonEmpty(..), some1 )+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, 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 )+import Prelude hiding (id, (.) )++data TransactionMonth =+ Jan+ | Feb+ | Mar+ | Apr+ | May+ | Jun+ | Jul+ | Aug+ | Sep+ | Oct+ | Nov+ | Dec+ deriving (Eq, Ord, Show)++makePrisms ''TransactionMonth++parseTransactionMonth ::+ Stream s m Char =>+ ParsecT s u m TransactionMonth+parseTransactionMonth =+ 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 TransactionDate =+ TransactionDate {+ _day1 ::+ DecDigit+ , _day2 ::+ DecDigit+ , _month ::+ TransactionMonth+ , _year1 ::+ DecDigit+ , _year2 ::+ DecDigit+ } deriving (Eq, Show)++makeLenses ''TransactionDate++instance Ord TransactionDate where+ TransactionDate d1 d2 m y1 y2 `compare` TransactionDate 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)++parseTransactionDate ::+ Stream s Identity Char =>+ ParsecT s u Identity TransactionDate+parseTransactionDate =+ TransactionDate <$>+ parseDecimal <*>+ parseDecimal <*+ char ' ' <*>+ parseTransactionMonth <*+ char ' ' <*>+ parseDecimal <*>+ parseDecimal++decodeTransactionDate ::+ Decode' ByteString TransactionDate+decodeTransactionDate =+ D.withParsec parseTransactionDate++encodeTransactionDate ::+ NameEncode TransactionDate+encodeTransactionDate =+ fromString "Date" =: E.mkEncodeBS (\(TransactionDate d1 d2 m y1 y2) ->+ L.fromString (concat [[charDecimal # d1, charDecimal # d2, ' '], show m, [' ', charDecimal # y1], [charDecimal # y2]]))++transactionDayDate ::+ Day+ -> TransactionDate+transactionDayDate 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 TransactionDate d1 d2 m' y1 y2++transactionDateDay ::+ TransactionDate+ -> Day+transactionDateDay (TransactionDate 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++data TransactionAmount =+ TransactionAmount {+ _negated ::+ Bool+ , _dollars ::+ NonEmpty DecDigit+ , _cents1 ::+ DecDigit+ , _cents2 ::+ DecDigit+ } deriving (Eq, Ord, Show)++makeLenses ''TransactionAmount++parseTransactionAmount ::+ Stream s Identity Char =>+ ParsecT s u Identity TransactionAmount+parseTransactionAmount =+ TransactionAmount <$>+ try (True <$ char '-' <|> pure False) <*>+ some1 parseDecimal <*+ char '.' <*>+ parseDecimal <*>+ parseDecimal++decodeTransactionAmount ::+ Decode' ByteString TransactionAmount+decodeTransactionAmount =+ D.withParsec parseTransactionAmount++encodeTransactionAmount ::+ String+ -> NameEncode TransactionAmount+encodeTransactionAmount label =+ fromString label =: E.mkEncodeBS (\(TransactionAmount n d c1 c2) ->+ L.fromString (concat [bool "" "-" n, fmap (charDecimal #) (toList d), ".", [charDecimal # c1], [charDecimal # c2]]))++realTransactionAmount ::+ Integral a =>+ TransactionAmount+ -> Ratio a+realTransactionAmount (TransactionAmount n ds d1 d2) =+ let neg =+ if n then Left else Right+ in (decDigitsIntegral (neg ds) * 100 + decDigitsIntegral (Right (d1 :| [d2]))) % 100++data Transaction =+ Transaction {+ _date ::+ TransactionDate+ , _amount ::+ TransactionAmount+ , _accountNumber ::+ String+ , _emptyField ::+ String+ , _transactionType ::+ String+ , _details ::+ String+ , _balance ::+ TransactionAmount+ , _category ::+ String+ , _merchantName ::+ String+ } deriving (Eq, Ord, Show)++makeLenses ''Transaction++encodeTransaction ::+ NameEncode Transaction+encodeTransaction =+ contramap _date encodeTransactionDate <>+ contramap _amount (encodeTransactionAmount "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") <>+ fromString "Category" =: contramap _category E.string <>+ fromString "Merchant Name" =: contramap _merchantName E.string++encodeTransactionNormalised ::+ NameEncode Transaction+encodeTransactionNormalised =+ contramap _date encodeTransactionDate <>+ contramap _amount (encodeTransactionAmount "Amount") <>+ fromString "Acc#" =: contramap _accountNumber E.string <>+ fromString "Type" =: contramap _transactionType E.string <>+ fromString "Details" =: contramap _details E.string <>+ contramap _balance (encodeTransactionAmount "Balance") <>+ fromString "Merchant" =: contramap _merchantName E.string++encodeTransactionencodeTransactionNormalisedOtherCat ::+ NameEncode (Transaction, Int)+encodeTransactionencodeTransactionNormalisedOtherCat =+ contramap (view _1) encodeTransactionNormalised <>+ fromString "Other Categories" =: contramap (view _2) E.int++decodeTransaction ::+ Decode ByteString ByteString Transaction+decodeTransaction =+ Transaction <$>+ decodeTransactionDate <*>+ decodeTransactionAmount <*>+ D.string <*>+ D.string <*>+ D.string <*>+ D.string <*>+ decodeTransactionAmount <*>+ D.string <*>+ D.string++type TransactionState f a =+ StateT Transaction f a++foldMap'TransactionState ::+ (Foldable t, Applicative f, Monoid b) =>+ (a -> f b)+ -> t a+ -> f b+foldMap'TransactionState f =+ foldl (\b a -> liftA2 (<>) (f a) b) (pure mempty)++(|>) ::+ (Semigroup a, Applicative f) =>+ f a+ -> f a+ -> f a+s |> t =+ liftA2 (<>) s t++infixr 6 |>++date' ::+ Monad f =>+ TransactionState f TransactionDate+date' =+ gets (view date)++dateDay' ::+ Monad f =>+ TransactionState f Day+dateDay' =+ fmap transactionDateDay date'++amount' ::+ Monad f =>+ TransactionState f TransactionAmount+amount' =+ gets (view amount)++amountRatio' ::+ (Monad f, Integral b) =>+ TransactionState f (Ratio b)+amountRatio' =+ fmap realTransactionAmount amount'++accountNumber' ::+ Monad f =>+ TransactionState f String+accountNumber' =+ gets (view accountNumber)++emptyField' ::+ Monad f =>+ TransactionState f String+emptyField' =+ gets (view emptyField)++transactionType' ::+ Monad f =>+ TransactionState f String+transactionType' =+ gets (view transactionType)++details' ::+ Monad f =>+ TransactionState f String+details' =+ gets (view details)++balance' ::+ Monad f =>+ TransactionState f TransactionAmount+balance' =+ gets (view balance)++balanceRatio' ::+ (Monad f, Integral b) =>+ TransactionState f (Ratio b)+balanceRatio' =+ fmap realTransactionAmount balance'++category' ::+ Monad f =>+ TransactionState f String+category' =+ gets (view category)++merchantName' ::+ Monad f =>+ TransactionState f String+merchantName' =+ gets (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 =+ let d1 =+ transactionDateDay (view date t1)+ d2 =+ transactionDateDay (view date t2)+ a1 =+ view accountNumber t1+ a2 =+ view accountNumber t2+ in d1 `compare` d2 <> a2 `compare` a1+ in sortBy comp+ in fmap sortTransactions (parseCSVDirectory decodeTransaction p)