diff --git a/LICENCE b/LICENCE new file mode 100644 --- /dev/null +++ b/LICENCE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple +main = defaultMain + diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,3 @@ +0.0.1 + +* This change log starts diff --git a/national-australia-bank.cabal b/national-australia-bank.cabal new file mode 100644 --- /dev/null +++ b/national-australia-bank.cabal @@ -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 diff --git a/src/Data/Bank/NationalAustraliaBank/NationalAustraliaBank.hs b/src/Data/Bank/NationalAustraliaBank/NationalAustraliaBank.hs new file mode 100644 --- /dev/null +++ b/src/Data/Bank/NationalAustraliaBank/NationalAustraliaBank.hs @@ -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)