strict-data-0.2.0.2: A collection of commonly used strict data structures

Safe HaskellSafe
LanguageHaskell2010

Data.Choice

Synopsis

Documentation

data Choice a b Source #

Choice is a version of Either that is strict on both the Left side (called This) and the Right side (called That).

Note: Choice is not used as an error monad. Use Fail for that.

Constructors

This !a 
That !b 

Instances

Bifunctor Choice Source # 

Methods

bimap :: (a -> b) -> (c -> d) -> Choice a c -> Choice b d #

first :: (a -> b) -> Choice a c -> Choice b c #

second :: (b -> c) -> Choice a b -> Choice a c #

Monad (Choice e) Source # 

Methods

(>>=) :: Choice e a -> (a -> Choice e b) -> Choice e b #

(>>) :: Choice e a -> Choice e b -> Choice e b #

return :: a -> Choice e a #

fail :: String -> Choice e a #

Functor (Choice a) Source # 

Methods

fmap :: (a -> b) -> Choice a a -> Choice a b #

(<$) :: a -> Choice a b -> Choice a a #

Applicative (Choice e) Source # 

Methods

pure :: a -> Choice e a #

(<*>) :: Choice e (a -> b) -> Choice e a -> Choice e b #

(*>) :: Choice e a -> Choice e b -> Choice e b #

(<*) :: Choice e a -> Choice e b -> Choice e a #

(Eq b, Eq a) => Eq (Choice a b) Source # 

Methods

(==) :: Choice a b -> Choice a b -> Bool #

(/=) :: Choice a b -> Choice a b -> Bool #

(Data b, Data a) => Data (Choice a b) Source # 

Methods

gfoldl :: (forall d c. Data d => c (d -> c) -> d -> c c) -> (forall g. g -> c g) -> Choice a b -> c (Choice a b) #

gunfold :: (forall c r. Data c => c (c -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Choice a b) #

toConstr :: Choice a b -> Constr #

dataTypeOf :: Choice a b -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c (Choice a b)) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Choice a b)) #

gmapT :: (forall c. Data c => c -> c) -> Choice a b -> Choice a b #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Choice a b -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Choice a b -> r #

gmapQ :: (forall d. Data d => d -> u) -> Choice a b -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Choice a b -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Choice a b -> m (Choice a b) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Choice a b -> m (Choice a b) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Choice a b -> m (Choice a b) #

(Ord b, Ord a) => Ord (Choice a b) Source # 

Methods

compare :: Choice a b -> Choice a b -> Ordering #

(<) :: Choice a b -> Choice a b -> Bool #

(<=) :: Choice a b -> Choice a b -> Bool #

(>) :: Choice a b -> Choice a b -> Bool #

(>=) :: Choice a b -> Choice a b -> Bool #

max :: Choice a b -> Choice a b -> Choice a b #

min :: Choice a b -> Choice a b -> Choice a b #

(Read b, Read a) => Read (Choice a b) Source # 
(Show b, Show a) => Show (Choice a b) Source # 

Methods

showsPrec :: Int -> Choice a b -> ShowS #

show :: Choice a b -> String #

showList :: [Choice a b] -> ShowS #

(Arbitrary a, Arbitrary b) => Arbitrary (Choice a b) Source # 

Methods

arbitrary :: Gen (Choice a b) #

shrink :: Choice a b -> [Choice a b] #

(Hashable a, Hashable b) => Hashable (Choice a b) Source # 

Methods

hashWithSalt :: Int -> Choice a b -> Int #

hash :: Choice a b -> Int #

(NFData a, NFData b) => NFData (Choice a b) Source # 

Methods

rnf :: Choice a b -> () #

choice :: (a -> c) -> (b -> c) -> Choice a b -> c Source #

Choice's version of either

this :: Monad m => Choice a b -> m a Source #

>>> this (This "foo") :: Maybe String
Just "foo"
>>> this (That "bar") :: Maybe String
Nothing

that :: Monad m => Choice a b -> m b Source #

>>> that (This "foo") :: Maybe String
Nothing
>>> that (That "bar") :: Maybe String
Just "bar"

these :: [Choice a b] -> [a] Source #

>>> these [This "foo", This "bar", That "baz", This "quux"]
["foo","bar","quux"]

those :: [Choice a b] -> [b] Source #

>>> those [This "foo", This "bar", That "baz", This "quux"]
["baz"]

eitherToChoice :: Either a b -> Choice a b Source #

>>> eitherToChoice (Left 1)
This 1
>>> eitherToChoice (Right 5)
That 5

mergeChoice :: Choice a a -> a Source #

>>> mergeChoice (This 5 :: Choice Int Int)
5
>>> mergeChoice (That 'c' :: Choice Char Char)
'c'