diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,8 @@ +0.0.3 + +* Remove `Combinators` module +* Use `MonadReader` for transaction fields instead of anticipating use of state + 0.0.2 * Add combinators for processing bank transactions diff --git a/national-australia-bank.cabal b/national-australia-bank.cabal --- a/national-australia-bank.cabal +++ b/national-australia-bank.cabal @@ -1,12 +1,12 @@ name: national-australia-bank -version: 0.0.2 +version: 0.0.3 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 +copyright: Copyright (C) 2023-2024 Tony Morris category: Test build-type: Simple extra-source-files: changelog.md @@ -21,7 +21,6 @@ library exposed-modules: - Data.Bank.Combinators Data.Bank.NationalAustraliaBank.NationalAustraliaBank build-depends: base >= 4.9 && < 4.15 diff --git a/src/Data/Bank/Combinators.hs b/src/Data/Bank/Combinators.hs deleted file mode 100644 --- a/src/Data/Bank/Combinators.hs +++ /dev/null @@ -1,142 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE FlexibleContexts #-} - -module Data.Bank.Combinators where - -import Control.Applicative (Applicative(liftA2)) -import Control.Category (Category(..) ) -import Control.Lens - ( _Left, - isn't ) -import Control.Monad.State - ( Monad((>>=)) ) -import Data.Bool(bool) -import qualified Data.List as List ( isInfixOf ) -import Data.Functor( Functor(..) ) -import Data.Functor.Identity ( Identity(..) ) -import Data.Set(Set) -import qualified Data.Set as Set(singleton) -import Data.List.NonEmpty ( some1 ) -import Text.Parsec - ( char, - noneOf, - string, - eof, - parse, - try, - Parsec, - ParsecT, - Stream ) -import Prelude hiding (id, (.) ) - -contains :: - (Eq a, Functor f) => - [a] - -> f [a] - -> f Bool -contains = - fmap . List.isInfixOf - -equals :: - (Eq a, Functor f) => - a - -> f a - -> f Bool -equals = - fmap . (==) - -(~~) :: - a - -> (a -> b) - -> b -a ~~ f = - f a - -infixl 8 ~~ - -(~>) :: - (Functor f, Monoid c) => - f Bool - -> c - -> f c -b ~> c = - fmap (bool mempty c) b - -infixr 7 ~> - -(~>>) :: - (Ord c, Functor f) => - f Bool - -> c - -> f (Set c) -b ~>> c = - b ~> Set.singleton c - -infixl 7 ~>> - -parses :: - (Functor f, Stream s Identity t) => - Parsec s () c - -> f s - -> f Bool -parses p = - fmap (isn't _Left . parse (try p) "parses") - -parenthesisedParser :: - Stream s m Char => - String - -> ParsecT s u m () -parenthesisedParser s = - string s *> string " (" *> some1 (noneOf ")") *> char ')' *> eof - -parenthesised :: - (Functor f, Stream s Identity Char) => - String - -> f s - -> f Bool -parenthesised = - parses . parenthesisedParser - -(...) :: - (Monad f, Foldable g) => - (a -> f a -> f Bool) - -> g a - -> (f a -> f Bool) -f ... t = - \x -> - foldr (\a b -> f a x .||. b) (pure False) t - -infixl 9 ... - -(.||.) :: - Monad f => - f Bool - -> f Bool - -> f Bool -p .||. q = - p >>= bool q (pure True) - -(.|||.) :: - (Applicative f, Applicative g, Monad h) => - f (g (h Bool)) - -> f (g (h Bool)) - -> f (g (h Bool)) -(.|||.) = - liftA2 (liftA2 (.||.)) - -(.&&.) :: - Monad f => - f Bool - -> f Bool - -> f Bool -p .&&. q = - p >>= bool (pure False) q - -(.&&&.) :: - (Applicative f, Applicative g, Monad h) => - f (g (h Bool)) - -> f (g (h Bool)) - -> f (g (h Bool)) -(.&&&.) = - liftA2 (liftA2 (.&&.)) diff --git a/src/Data/Bank/NationalAustraliaBank/NationalAustraliaBank.hs b/src/Data/Bank/NationalAustraliaBank/NationalAustraliaBank.hs --- a/src/Data/Bank/NationalAustraliaBank/NationalAustraliaBank.hs +++ b/src/Data/Bank/NationalAustraliaBank/NationalAustraliaBank.hs @@ -4,18 +4,15 @@ module Data.Bank.NationalAustraliaBank.NationalAustraliaBank where -import Control.Applicative (Applicative(liftA2), Alternative((<|>))) +import Control.Applicative (Alternative((<|>))) import Control.Category (Category(..) ) import Control.Lens ( view, makePrisms, (#), - makeLenses, - Field1(_1), - Field2(_2) ) + makeLenses ) import Control.Monad.IO.Class ( MonadIO(..) ) -import Control.Monad.State - ( mapM, StateT, gets ) +import Control.Monad.Reader.Class ( MonadReader ) import Control.Monad.Trans.Except ( ExceptT(..) ) import Data.Bool(bool) import Data.List ( sortBy ) @@ -30,8 +27,9 @@ integralDecDigits, integralDecimal, DecDigit(DecDigit0) ) -import Data.Foldable ( Foldable, asum, toList ) +import Data.Foldable ( asum, toList ) import Data.List.NonEmpty ( NonEmpty(..), some1 ) +import Data.Ord import Data.String ( IsString(fromString) ) import Data.Sv ( parseDecodeFromFile, @@ -276,23 +274,6 @@ 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 = @@ -307,98 +288,77 @@ 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 + MonadReader Transaction f => + f TransactionDate date' = - gets (view date) + view date dateDay' :: - Monad f => - TransactionState f Day + MonadReader Transaction f => + f Day dateDay' = fmap transactionDateDay date' amount' :: - Monad f => - TransactionState f TransactionAmount + MonadReader Transaction f => + f TransactionAmount amount' = - gets (view amount) + view amount amountRatio' :: - (Monad f, Integral b) => - TransactionState f (Ratio b) + (MonadReader Transaction f, Integral b) => + f (Ratio b) amountRatio' = fmap realTransactionAmount amount' accountNumber' :: - Monad f => - TransactionState f String + MonadReader Transaction f => + f String accountNumber' = - gets (view accountNumber) + view accountNumber emptyField' :: - Monad f => - TransactionState f String + MonadReader Transaction f => + f String emptyField' = - gets (view emptyField) + view emptyField transactionType' :: - Monad f => - TransactionState f String + MonadReader Transaction f => + f String transactionType' = - gets (view transactionType) + view transactionType details' :: - Monad f => - TransactionState f String + MonadReader Transaction f => + f String details' = - gets (view details) + view details balance' :: - Monad f => - TransactionState f TransactionAmount + MonadReader Transaction f => + f TransactionAmount balance' = - gets (view balance) + view balance balanceRatio' :: - (Monad f, Integral b) => - TransactionState f (Ratio b) + (MonadReader Transaction f, Integral b) => + f (Ratio b) balanceRatio' = fmap realTransactionAmount balance' category' :: - Monad f => - TransactionState f String + MonadReader Transaction f => + f String category' = - gets (view category) + view category merchantName' :: - Monad f => - TransactionState f String + MonadReader Transaction f => + f String merchantName' = - gets (view merchantName) + view merchantName parseTransactionDirectory :: MonadIO m => @@ -427,16 +387,7 @@ [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 + let comp t1 t2 = + comparing dateDay' t1 t2 <> comparing accountNumber' t1 t2 in sortBy comp in fmap sortTransactions (parseCSVDirectory decodeTransaction p)