Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
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 DataKinds #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE PatternSynonyms #-} 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
- data Choice (a :: Symbol)
- fromBool :: Bool -> Choice a
- toBool :: Choice a -> Bool
- isFalse :: Choice a -> Bool
- isTrue :: Choice a -> Bool
- choice :: a -> a -> Choice b -> a
- pattern Do :: Label a -> Choice a
- pattern Don't :: Label a -> Choice a
- pattern Is :: Label a -> Choice a
- pattern Isn't :: Label a -> Choice a
- pattern With :: Label a -> Choice a
- pattern Without :: Label a -> Choice a
- pattern Must :: Label a -> Choice a
- pattern Mustn't :: Label a -> Choice a
- pattern Needn't :: Label a -> Choice a
- pattern Can :: Label a -> Choice a
- pattern Can't :: Label a -> Choice a
- pattern Should :: Label a -> Choice a
- pattern Shouldn't :: Label a -> Choice a
- data Label (a :: Symbol) = Label
Documentation
data Choice (a :: Symbol) Source #
A labeled boolean choice.
Instances
Bounded (Choice a) Source # | |
Enum (Choice a) Source # | |
Generic (Choice a) Source # | |
Show (Choice a) Source # | |
Eq (Choice a) Source # | |
Ord (Choice a) Source # | |
Defined in Data.Choice | |
type Rep (Choice a) Source # | |
Defined in Data.Choice type Rep (Choice a) = D1 ('MetaData "Choice" "Data.Choice" "choice-0.2.4.1-FUkfTze8MSo4eiXXA7m9Zn" '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 aliases
pattern Needn't :: Label a -> Choice a Source #
Deprecated: Use Can or Can't.
Alias for False
, e.g. Needn't #succeed
.
Internal
The Label
data type is only exported in full for compatibility with
versions of GHC older than 8.0.