{-# OPTIONS_GHC -Wall #-}
module Data.Laxer (eitherL,condL,foldrL,maybeL,fairZipWith, fairZip) where
import Data.Lub
import Data.Glb
condL :: (HasLub a, HasGlb a) =>
a -> a -> Bool -> a
condL :: a -> a -> Bool -> a
condL a
a a
b = a -> Bool -> a
forall a b. a -> b -> a
const (a
a a -> a -> a
forall a. HasGlb a => a -> a -> a
`glb` a
b) (Bool -> a) -> (Bool -> a) -> Bool -> a
forall a. HasLub a => a -> a -> a
`lub` (\ Bool
c -> if Bool
c then a
a else a
b)
eitherL :: (HasLub c, HasGlb c) =>
(a -> c) -> (b -> c) -> (Either a b -> c)
eitherL :: (a -> c) -> (b -> c) -> Either a b -> c
eitherL a -> c
f b -> c
g = c -> Either a b -> c
forall a b. a -> b -> a
const (a -> c
f a
forall a. HasCallStack => a
undefined c -> c -> c
forall a. HasGlb a => a -> a -> a
`glb` b -> c
g b
forall a. HasCallStack => a
undefined) (Either a b -> c) -> (Either a b -> c) -> Either a b -> c
forall a. HasLub a => a -> a -> a
`lub` (a -> c) -> (b -> c) -> Either a b -> c
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> c
f b -> c
g
maybeL :: (HasLub b, HasGlb b) =>
b -> (a -> b) -> (Maybe a -> b)
maybeL :: b -> (a -> b) -> Maybe a -> b
maybeL b
n a -> b
j = b -> Maybe a -> b
forall a b. a -> b -> a
const (b
n b -> b -> b
forall a. HasGlb a => a -> a -> a
`glb` a -> b
j a
forall a. HasCallStack => a
undefined) (Maybe a -> b) -> (Maybe a -> b) -> Maybe a -> b
forall a. HasLub a => a -> a -> a
`lub` b -> (a -> b) -> Maybe a -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
n a -> b
j
foldrL :: (HasLub b, HasGlb b) => (a -> b -> b) -> b -> [a] -> b
foldrL :: (a -> b -> b) -> b -> [a] -> b
foldrL a -> b -> b
c b
n = b -> [a] -> b
forall a b. a -> b -> a
const b
fallback ([a] -> b) -> ([a] -> b) -> [a] -> b
forall a. HasLub a => a -> a -> a
`lub` [a] -> b
go
where
fallback :: b
fallback = b
n b -> b -> b
forall a. HasGlb a => a -> a -> a
`glb` a -> b -> b
c a
forall a. HasCallStack => a
undefined b
forall a. HasCallStack => a
undefined
go :: [a] -> b
go [] = b
n
go (a
x : [a]
xs) = a -> b -> b
c a
x (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ b
fallback b -> b -> b
forall a. HasLub a => a -> a -> a
`lub` [a] -> b
go [a]
xs
fairZipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
fairZipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
fairZipWith a -> b -> c
f [a]
as [b]
bs =
(() -> a -> b -> c) -> [()] -> [a] -> [b] -> [c]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3
((a -> b -> c) -> () -> a -> b -> c
forall a b. a -> b -> a
const a -> b -> c
f)
([()] -> [()] -> [()]
forall a. HasLub a => a -> a -> a
lub ((a -> b -> ()) -> [a] -> [b] -> [()]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> b -> ()
forall p p. p -> p -> ()
discard [a]
as [b]
bs) ((b -> a -> ()) -> [b] -> [a] -> [()]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith b -> a -> ()
forall p p. p -> p -> ()
discard [b]
bs [a]
as))
[a]
as
[b]
bs
where
discard :: p -> p -> ()
discard p
_ p
_ = ()
fairZip :: [a] -> [b] -> [(a, b)]
fairZip :: [a] -> [b] -> [(a, b)]
fairZip = (a -> b -> (a, b)) -> [a] -> [b] -> [(a, b)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
fairZipWith (,)