national-australia-bank-0.0.2: src/Data/Bank/Combinators.hs

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