module SpEither where
import SP
import EitherUtils(stripLeft,stripRight)
import Spops(concatMapSP)

mapFilterSP :: (t -> Maybe b) -> SP t b
mapFilterSP t -> Maybe b
f = SP t b
m
  where m :: SP t b
m = (t -> SP t b) -> SP t b
forall a b. (a -> SP a b) -> SP a b
GetSP ((t -> SP t b) -> SP t b) -> (t -> SP t b) -> SP t b
forall a b. (a -> b) -> a -> b
$ \t
x->
	    case t -> Maybe b
f t
x of
	      Just b
y  -> b -> SP t b -> SP t b
forall a b. b -> SP a b -> SP a b
PutSP b
y SP t b
m
	      Maybe b
Nothing -> SP t b
m

filterLeftSP :: SP (Either b b) b
filterLeftSP = (Either b b -> Maybe b) -> SP (Either b b) b
forall t b. (t -> Maybe b) -> SP t b
mapFilterSP Either b b -> Maybe b
forall a b. Either a b -> Maybe a
stripLeft
filterRightSP :: SP (Either a1 b) b
filterRightSP = (Either a1 b -> Maybe b) -> SP (Either a1 b) b
forall t b. (t -> Maybe b) -> SP t b
mapFilterSP Either a1 b -> Maybe b
forall a1 a2. Either a1 a2 -> Maybe a2
stripRight

filterJustSP :: SP (Maybe b) b
filterJustSP = (Maybe b -> Maybe b) -> SP (Maybe b) b
forall t b. (t -> Maybe b) -> SP t b
mapFilterSP Maybe b -> Maybe b
forall a. a -> a
id

splitSP :: SP (a, b) (Either a b)
splitSP = ((a, b) -> [Either a b]) -> SP (a, b) (Either a b)
forall t b. (t -> [b]) -> SP t b
concatMapSP (\(a
x, b
y) -> [a -> Either a b
forall a b. a -> Either a b
Left a
x, b -> Either a b
forall a b. b -> Either a b
Right b
y])

toBothSP :: SP b (Either b b)
toBothSP = (b -> [Either b b]) -> SP b (Either b b)
forall t b. (t -> [b]) -> SP t b
concatMapSP (\b
x -> [b -> Either b b
forall a b. a -> Either a b
Left b
x, b -> Either b b
forall a b. b -> Either a b
Right b
x])