Search.hs

{-# 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 ...&&