module Generics.Pointless.Combinators where
import Prelude hiding (or,and)
_L :: a
_L = undefined
data One
instance Show One where
show _ = "_L"
instance Eq One where
(==) _ _ = True
bang :: a -> One
bang = const _L
pnt :: a -> One -> a
pnt = const
infix 6 /\
(/\) :: (a -> b) -> (a -> c) -> a -> (b,c)
(/\) f g x = (f x, g x)
infix 7 ><
(><) :: (a -> b) -> (c -> d) -> (a,c) -> (b,d)
f >< g = f . fst /\ g . snd
inl :: a -> Either a b
inl = Left
inr :: b -> Either a b
inr = Right
infix 4 \/
(\/) :: (b -> a) -> (c -> a) -> Either b c -> a
(\/) = either
infix 5 -|-
(-|-) :: (a -> b) -> (c -> d) -> Either a c -> Either b d
f -|- g = inl . f \/ inr . g
infix 5 <>
(<>) :: (a -> b) -> (c -> d) -> Either a c -> Either b d
(<>) = (-|-)
app :: (a -> b, a) -> b
app (f,x) = f x
lexp :: (a -> b) -> (b -> c) -> (a -> c)
lexp f = curry (app . (id >< f))
rexp :: (b -> c) -> (a -> b) -> (a -> c)
rexp f = curry (f . app)
infix 0 !
(!) :: a -> b -> a
(!) = const
grd :: (a -> Bool) -> a -> Either a a
grd p x = if p x then inl x else inr x
(?) :: (a -> Bool) -> a -> Either a a
(?) = grd
split :: (a -> b, a -> c) -> (a -> (b,c))
split = curry ((app >< app) . ((fst >< id) /\ (snd >< id)))
eithr :: (a -> c, b -> c) -> Either a b -> c
eithr = curry ((app \/ app) . (fst >< id -|- snd >< id) . distr)
comp :: (b -> c, a -> b) -> (a -> c)
comp = curry (app . (id >< app) . assocr)
orf :: (a -> Bool,a -> Bool) -> (a -> Bool)
orf = curry (or . (app . (fst >< id) /\ app . (snd >< id)))
andf :: (a -> Bool,a -> Bool) -> (a -> Bool)
andf = curry (and . (app . (fst >< id) /\ app . (snd >< id)))
or :: (Bool,Bool) -> Bool
or = uncurry (||)
and :: (Bool,Bool) -> Bool
and = uncurry (&&)
eq :: Eq a => (a,a) -> Bool
eq = uncurry (==)
neq :: Eq a => (a,a) -> Bool
neq = not . eq
swap :: (a,b) -> (b,a)
swap = snd /\ fst
coswap :: Either a b -> Either b a
coswap = inr \/ inl
distl :: (Either a b, c) -> Either (a,c) (b,c)
distl = app . ((curry inl \/ curry inr) >< id)
undistl :: Either (a,c) (b,c) -> (Either a b, c)
undistl = inl >< id \/ inr >< id
distr :: (c, Either a b) -> Either (c,a) (c,b)
distr = (swap -|- swap) . distl . swap
undistr :: Either (c,a) (c,b) -> (c, Either a b)
undistr = (id >< inl) \/ (id >< inr)
assocl :: (a,(b,c)) -> ((a,b),c)
assocl = id >< fst /\ snd . snd
assocr :: ((a,b),c) -> (a,(b,c))
assocr = fst . fst /\ snd >< id
coassocl :: Either a (Either b c) -> Either (Either a b) c
coassocl = (inl . inl) \/ (inr -|- id)
coassocr :: Either (Either a b) c -> Either a (Either b c)
coassocr = (id -|- inl) \/ (inr . inr)
distp :: ((c,d),(a,b)) -> ((c,a),(d,b))
distp = fst >< fst /\ snd >< snd
dists :: (Either a b,Either c d) -> Either (Either (a,c) (a,d)) (Either (b,c) (b,d))
dists = (distr -|- distr) . distl