choice-0.1.1.0: A solution to boolean blindness.

Safe HaskellNone
LanguageHaskell2010

Data.Choice

Contents

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, Do, 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 Source #

A labeled boolean choice.

Instances

Bounded (Choice a) Source # 

Methods

minBound :: Choice a #

maxBound :: Choice a #

Enum (Choice a) Source # 

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] #

Eq (Choice a) Source # 

Methods

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

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

Ord (Choice a) Source # 

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 #

Show (Choice a) Source # 

Methods

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

show :: Choice a -> String #

showList :: [Choice a] -> ShowS #

Conversion

Choice aliases

pattern Do :: forall t. Label t -> Choice t Source #

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

pattern Don't :: forall t. Label t -> Choice t Source #

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

pattern Is :: forall t. Label t -> Choice t Source #

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

pattern Isn't :: forall t. Label t -> Choice t Source #

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

pattern With :: forall t. Label t -> Choice t Source #

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

pattern Without :: forall t. Label t -> Choice t Source #

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

Internal

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

data Label a Source #

A synonym for Proxy.

Constructors

Label 

Instances

(~) Symbol x x' => IsLabel x (Label x') Source # 

Methods

fromLabel :: Proxy# Symbol x -> Label x' #

Eq (Label a) Source # 

Methods

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

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

Ord (Label a) Source # 

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 #

Show (Label a) Source # 

Methods

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

show :: Label a -> String #

showList :: [Label a] -> ShowS #