{- |
Module      : Control.Lens.Grammar.Boole
Description : Boolean algebras
Copyright   : (C) 2026 - Eitan Chatav
License     : BSD-style (see the file LICENSE)
Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>
Stability   : provisional
Portability : non-portable

See Boole, [The Mathematical Analysis of Logic]
(https://www.gutenberg.org/files/36884/36884-pdf.pdf).
-}

module Control.Lens.Grammar.Boole
  ( -- * BooleanAlgebra
    BooleanAlgebra (..)
  , andB, orB, allB, anyB
  ) where

import Data.Foldable
import Data.Monoid

-- | A `BooleanAlgebra`, like `Bool`, supporting classical logical operations.
class BooleanAlgebra b where

  -- | conjunction
  (>&&<) :: b -> b -> b
  default (>&&<)
    :: (b ~ f bool, BooleanAlgebra bool, Applicative f) => b -> b -> b
  (>&&<) = (bool -> bool -> bool) -> f bool -> f bool -> f bool
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 bool -> bool -> bool
forall b. BooleanAlgebra b => b -> b -> b
(>&&<)

  -- | disjunction
  (>||<) :: b -> b -> b
  default (>||<)
    :: (b ~ f bool, BooleanAlgebra bool, Applicative f) => b -> b -> b
  (>||<) = (bool -> bool -> bool) -> f bool -> f bool -> f bool
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 bool -> bool -> bool
forall b. BooleanAlgebra b => b -> b -> b
(>||<)

  -- | negation
  notB :: b -> b
  default notB
    :: (b ~ f bool, BooleanAlgebra bool, Functor f) => b -> b
  notB = (bool -> bool) -> f bool -> f bool
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap bool -> bool
forall b. BooleanAlgebra b => b -> b
notB

  -- | true
  trueB :: b
  default trueB
    :: (b ~ f bool, BooleanAlgebra bool, Applicative f) => b
  trueB = bool -> f bool
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure bool
forall b. BooleanAlgebra b => b
trueB

  -- | false
  falseB :: b
  default falseB
    :: (b ~ f bool, BooleanAlgebra bool, Applicative f) => b
  falseB = bool -> f bool
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure bool
forall b. BooleanAlgebra b => b
falseB

-- | cumulative conjunction
andB :: (Foldable f, BooleanAlgebra b) => f b -> b
andB :: forall (f :: * -> *) b. (Foldable f, BooleanAlgebra b) => f b -> b
andB = (b -> b -> b) -> b -> f b -> b
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> b -> b
forall b. BooleanAlgebra b => b -> b -> b
(>&&<) b
forall b. BooleanAlgebra b => b
trueB

-- | cumulative disjunction
orB :: (Foldable f, BooleanAlgebra b) => f b -> b
orB :: forall (f :: * -> *) b. (Foldable f, BooleanAlgebra b) => f b -> b
orB = (b -> b -> b) -> b -> f b -> b
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> b -> b
forall b. BooleanAlgebra b => b -> b -> b
(>||<) b
forall b. BooleanAlgebra b => b
falseB

-- | universal
allB :: (Foldable f, BooleanAlgebra b) => (a -> b) -> f a -> b
allB :: forall (f :: * -> *) b a.
(Foldable f, BooleanAlgebra b) =>
(a -> b) -> f a -> b
allB a -> b
f = (b -> a -> b) -> b -> f a -> b
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\b
b a
a -> b
b b -> b -> b
forall b. BooleanAlgebra b => b -> b -> b
>&&< a -> b
f a
a) b
forall b. BooleanAlgebra b => b
trueB

-- | existential
anyB :: (Foldable f, BooleanAlgebra b) => (a -> b) -> f a -> b
anyB :: forall (f :: * -> *) b a.
(Foldable f, BooleanAlgebra b) =>
(a -> b) -> f a -> b
anyB a -> b
f = (b -> a -> b) -> b -> f a -> b
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\b
b a
a -> b
b b -> b -> b
forall b. BooleanAlgebra b => b -> b -> b
>||< a -> b
f a
a) b
forall b. BooleanAlgebra b => b
falseB

--instances
instance BooleanAlgebra (x -> Bool)
instance (Applicative f, BooleanAlgebra bool)
  => BooleanAlgebra (Ap f bool)
instance BooleanAlgebra Bool where
  falseB :: Bool
falseB = Bool
False
  trueB :: Bool
trueB = Bool
True
  notB :: Bool -> Bool
notB = Bool -> Bool
not
  >&&< :: Bool -> Bool -> Bool
(>&&<) = Bool -> Bool -> Bool
(&&)
  >||< :: Bool -> Bool -> Bool
(>||<) = Bool -> Bool -> Bool
(||)