{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- | This module provides linear functions on the standard 'Bool' type.
module Data.Bool.Linear
  ( -- * The Boolean type
    Bool (..),

    -- * Operators
    (&&),
    (||),
    not,
    otherwise,
  )
where

import Prelude (Bool (..), otherwise)

-- | @True@ iff both are @True@.
-- __NOTE:__ this is strict and not lazy!
(&&) :: Bool %1 -> Bool %1 -> Bool
Bool
False && :: Bool %1 -> Bool %1 -> Bool
&& Bool
False = Bool
False
Bool
False && Bool
True = Bool
False
Bool
True && Bool
x = Bool
x

infixr 3 && -- same as base.&&

-- | @True@ iff either is @True@
-- __NOTE:__ this is strict and not lazy!
(||) :: Bool %1 -> Bool %1 -> Bool
Bool
True || :: Bool %1 -> Bool %1 -> Bool
|| Bool
False = Bool
True
Bool
True || Bool
True = Bool
True
Bool
False || Bool
x = Bool
x

infixr 2 || -- same as base.||

-- | @not b@ is @True@ iff b is @False@
-- __NOTE:__ this is strict and not lazy!
not :: Bool %1 -> Bool
not :: Bool %1 -> Bool
not Bool
False = Bool
True
not Bool
True = Bool
False