choice-0.2.3: A solution to boolean blindness.
Safe HaskellSafe-Inferred
LanguageHaskell2010

Data.Choice

Description

Represent do/don't, is/isn't, with/without flags with Choice.

Boolean blindness refers to the problem that boolean literals on their own aren't very informative. In any given context, what does True mean? What does False mean? Instead of passing arguments of type Bool to functions, consider using Choice.

Choice is the type of labeled booleans. Use it as follows:

{-# LANGUAGE OverloadedLabels #-}

import Data.Choice (Choice, pattern Do, pattern Don't)

-- Blocking read: block until N bytes available.
-- Non-blocking: return as many bytes as are available.
readBytes :: Handle -> Choice "block" -> Int -> IO ByteString
readBytes = ...

action1 = print =<< readBytes h (Don't #block) 1024

For GHC < 8.0, where overloaded labels are not available, substitute (Label :: Label "block") for #block.

A comment on labels: why use labels? We could as well ask the user to define ad hoc constructors. But unlike constructors, labels are guaranteed to be singletons. That's exactly what we want: a label doesn't carry any runtime information, it's just a type annotation. Better yet, with labels, there is no need to ensure that constructor names are unique, nor to pollute the precious constructor namespace in a large module with many flags.

Synopsis

Documentation

data Choice (a :: Symbol) Source #

A labeled boolean choice.

Instances

Instances details
Bounded (Choice a) Source # 
Instance details

Defined in Data.Choice

Methods

minBound :: Choice a #

maxBound :: Choice a #

Enum (Choice a) Source # 
Instance details

Defined in Data.Choice

Methods

succ :: Choice a -> Choice a #

pred :: Choice a -> Choice a #

toEnum :: Int -> Choice a #

fromEnum :: Choice a -> Int #

enumFrom :: Choice a -> [Choice a] #

enumFromThen :: Choice a -> Choice a -> [Choice a] #

enumFromTo :: Choice a -> Choice a -> [Choice a] #

enumFromThenTo :: Choice a -> Choice a -> Choice a -> [Choice a] #

Generic (Choice a) Source # 
Instance details

Defined in Data.Choice

Associated Types

type Rep (Choice a) :: Type -> Type #

Methods

from :: Choice a -> Rep (Choice a) x #

to :: Rep (Choice a) x -> Choice a #

Show (Choice a) Source # 
Instance details

Defined in Data.Choice

Methods

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

show :: Choice a -> String #

showList :: [Choice a] -> ShowS #

Eq (Choice a) Source # 
Instance details

Defined in Data.Choice

Methods

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

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

Ord (Choice a) Source # 
Instance details

Defined in Data.Choice

Methods

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

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

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

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

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

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

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

type Rep (Choice a) Source # 
Instance details

Defined in Data.Choice

type Rep (Choice a) = D1 ('MetaData "Choice" "Data.Choice" "choice-0.2.3-6eCmfKfBsCmF4VCKVnu34K" 'False) (C1 ('MetaCons "Off" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'SourceUnpack 'SourceStrict 'DecidedStrict) (Rec0 (Label a))) :+: C1 ('MetaCons "On" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'SourceUnpack 'SourceStrict 'DecidedStrict) (Rec0 (Label a))))

Conversion

choice :: a -> a -> Choice b -> a Source #

Case analysis for the Choice type. choice x y p evaluates to x when p is false, and evaluates to y when p is true.

This is equivalent to bool x y (toBool p).

Choice aliases

pattern Do :: Label a -> Choice a Source #

Alias for True, e.g. Do #block.

pattern Don't :: Label a -> Choice a Source #

Alias for False, e.g. Don't #block.

pattern Is :: Label a -> Choice a Source #

Alias for True, e.g. Is #ordered.

pattern Isn't :: Label a -> Choice a Source #

Alias for False, e.g. Isn't #ordered.

pattern With :: Label a -> Choice a Source #

Alias for True, e.g. With #ownDirectory.

pattern Without :: Label a -> Choice a Source #

Alias for False, e.g. Without #ownDirectory.

pattern Must :: Label a -> Choice a Source #

Alias for True, e.g. Must #succeed.

pattern Mustn't :: Label a -> Choice a Source #

Alias for False, e.g. Mustn't #succeed.

pattern Needn't :: Label a -> Choice a Source #

Deprecated: Use Can or Can't.

Alias for False, e.g. Needn't #succeed.

pattern Can :: Label a -> Choice a Source #

Alias for True, e.g. Can #fail.

pattern Can't :: Label a -> Choice a Source #

Alias for False, e.g. Can't #fail.

pattern Should :: Label a -> Choice a Source #

Alias for True, e.g. Should #succeed.

pattern Shouldn't :: Label a -> Choice a Source #

Alias for False, e.g. Shouldn't #succeed.

Internal

The Label data type is only exported in full for compatibility with versions of GHC older than 8.0.

data Label (a :: Symbol) Source #

A synonym for Proxy.

Constructors

Label 

Instances

Instances details
x ~ x' => IsLabel x (Label x') Source # 
Instance details

Defined in Data.Choice

Methods

fromLabel :: Label x' #

Show (Label a) Source # 
Instance details

Defined in Data.Choice

Methods

showsPrec :: Int -> Label a -> ShowS #

show :: Label a -> String #

showList :: [Label a] -> ShowS #

Eq (Label a) Source # 
Instance details

Defined in Data.Choice

Methods

(==) :: Label a -> Label a -> Bool #

(/=) :: Label a -> Label a -> Bool #

Ord (Label a) Source # 
Instance details

Defined in Data.Choice

Methods

compare :: Label a -> Label a -> Ordering #

(<) :: Label a -> Label a -> Bool #

(<=) :: Label a -> Label a -> Bool #

(>) :: Label a -> Label a -> Bool #

(>=) :: Label a -> Label a -> Bool #

max :: Label a -> Label a -> Label a #

min :: Label a -> Label a -> Label a #