{-# LANGUAGE NoMonomorphismRestriction, ExplicitForAll #-}

module Hextra.Conditional where

import Hextra.Function

if' :: Bool -> p -> p -> p
if' Bool
a p
b p
c = if Bool
a then p
b else p
c
$? :: Bool -> (d, d) -> d
($?) = (Bool -> d -> d -> d) -> Bool -> (d, d) -> d
forall a b c d. (a -> b -> c -> d) -> a -> (b, c) -> d
uncurry3' Bool -> d -> d -> d
forall p. Bool -> p -> p -> p
if'

wrapunwrap :: forall a b. (a -> b, b -> a) -> (b -> b) -> a -> a
wrapunwrap :: (a -> b, b -> a) -> (b -> b) -> a -> a
wrapunwrap (a -> b
wrap, b -> a
unwrap) b -> b
f = b -> a
unwrap (b -> a) -> (a -> b) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
f (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
wrap

symmetrical :: forall a b. (a -> b) -> (a -> b -> Bool) -> a -> Bool
symmetrical :: (a -> b) -> (a -> b -> Bool) -> a -> Bool
symmetrical a -> b
f a -> b -> Bool
g a
a = a -> b -> Bool
g a
a (a -> b
f a
a)

replace :: forall a. Eq a => a -> a -> a -> a
replace :: a -> a -> a -> a
replace a
a a
b = (a -> Bool) -> (a -> a) -> a -> a
forall a. (a -> Bool) -> (a -> a) -> a -> a
applyIf (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a) (a -> a -> a
forall a b. a -> b -> a
const a
b)

applyIf :: forall a. (a -> Bool) -> (a -> a) -> a -> a
applyIf :: (a -> Bool) -> (a -> a) -> a -> a
applyIf a -> Bool
p a -> a
f = (a -> Bool) -> (a -> a) -> (a -> a) -> a -> a
forall a b. (a -> Bool) -> (a -> b) -> (a -> b) -> a -> b
applyEither a -> Bool
p a -> a
f a -> a
forall a. a -> a
id

applyEither :: forall a b. (a -> Bool) -> (a -> b) -> (a -> b) -> a -> b
applyEither :: (a -> Bool) -> (a -> b) -> (a -> b) -> a -> b
applyEither a -> Bool
p a -> b
f a -> b
g a
a
    | a -> Bool
p a
a = a -> b
f a
a
    | Bool
True = a -> b
g a
a

ifCondition :: forall a b. (a -> Bool) -> b -> b -> a -> b
ifCondition :: (a -> Bool) -> b -> b -> a -> b
ifCondition a -> Bool
p b
a b
b a
x
    | a -> Bool
p a
x = b
a
    | Bool
True = b
b

-- TODO Think about implementing this as applyEither p (const a) (const b)