-- | Represent do\/don't, is\/isn't, with\/without flags with 'Choice'.
--
-- <https://existentialtype.wordpress.com/2011/03/15/boolean-blindness/ 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.

{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

#if __GLASGOW_HASKELL__ >= 800
{-# OPTIONS_GHC -fno-warn-missing-pattern-synonym-signatures #-}
#endif

module Data.Choice
  ( Choice
  -- * Conversion
  , fromBool
  , toBool
  , isFalse
  , isTrue
  , choice
  -- * Choice aliases
  , pattern Do
  , pattern Don't
  , pattern Is
  , pattern Isn't
  , pattern With
  , pattern Without
  , pattern Must
  , pattern Mustn't
  , pattern Needn't
  , pattern Can
  , pattern Can't
  , pattern Should
  , pattern Shouldn't
  -- * Internal
  -- $label-export
  , Label(..)
  ) where

#if MIN_VERSION_base(4,9,0)
import GHC.OverloadedLabels (IsLabel(..))
#endif
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import GHC.TypeLits (Symbol)

-- $label-export
--
-- The 'Label' data type is only exported in full for compatibility with
-- versions of GHC older than 8.0.

-- | A synonym for 'Data.Proxy.Proxy'.
data Label (a :: Symbol) = Label deriving (Label a -> Label a -> Bool
(Label a -> Label a -> Bool)
-> (Label a -> Label a -> Bool) -> Eq (Label a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: Symbol). Label a -> Label a -> Bool
$c== :: forall (a :: Symbol). Label a -> Label a -> Bool
== :: Label a -> Label a -> Bool
$c/= :: forall (a :: Symbol). Label a -> Label a -> Bool
/= :: Label a -> Label a -> Bool
Eq, Eq (Label a)
Eq (Label a) =>
(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)
-> (Label a -> Label a -> Label a)
-> (Label a -> Label a -> Label a)
-> Ord (Label a)
Label a -> Label a -> Bool
Label a -> Label a -> Ordering
Label a -> Label a -> Label a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (a :: Symbol). Eq (Label a)
forall (a :: Symbol). Label a -> Label a -> Bool
forall (a :: Symbol). Label a -> Label a -> Ordering
forall (a :: Symbol). Label a -> Label a -> Label a
$ccompare :: forall (a :: Symbol). Label a -> Label a -> Ordering
compare :: Label a -> Label a -> Ordering
$c< :: forall (a :: Symbol). Label a -> Label a -> Bool
< :: Label a -> Label a -> Bool
$c<= :: forall (a :: Symbol). Label a -> Label a -> Bool
<= :: Label a -> Label a -> Bool
$c> :: forall (a :: Symbol). Label a -> Label a -> Bool
> :: Label a -> Label a -> Bool
$c>= :: forall (a :: Symbol). Label a -> Label a -> Bool
>= :: Label a -> Label a -> Bool
$cmax :: forall (a :: Symbol). Label a -> Label a -> Label a
max :: Label a -> Label a -> Label a
$cmin :: forall (a :: Symbol). Label a -> Label a -> Label a
min :: Label a -> Label a -> Label a
Ord, Int -> Label a -> ShowS
[Label a] -> ShowS
Label a -> String
(Int -> Label a -> ShowS)
-> (Label a -> String) -> ([Label a] -> ShowS) -> Show (Label a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (a :: Symbol). Int -> Label a -> ShowS
forall (a :: Symbol). [Label a] -> ShowS
forall (a :: Symbol). Label a -> String
$cshowsPrec :: forall (a :: Symbol). Int -> Label a -> ShowS
showsPrec :: Int -> Label a -> ShowS
$cshow :: forall (a :: Symbol). Label a -> String
show :: Label a -> String
$cshowList :: forall (a :: Symbol). [Label a] -> ShowS
showList :: [Label a] -> ShowS
Show)

#if MIN_VERSION_base(4,10,0)
instance x ~ x' => IsLabel x (Label x') where
  fromLabel :: Label x'
fromLabel = Label x'
forall (a :: Symbol). Label a
Label
#elif MIN_VERSION_base(4,9,0)
instance x ~ x' => IsLabel x (Label x') where
  fromLabel _ = Label
#endif

-- | A labeled boolean choice.
data Choice (a :: Symbol)
  = Off {-# UNPACK #-} !(Label a)
  | On {-# UNPACK #-} !(Label a)
  deriving (Choice a -> Choice a -> Bool
(Choice a -> Choice a -> Bool)
-> (Choice a -> Choice a -> Bool) -> Eq (Choice a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: Symbol). Choice a -> Choice a -> Bool
$c== :: forall (a :: Symbol). Choice a -> Choice a -> Bool
== :: Choice a -> Choice a -> Bool
$c/= :: forall (a :: Symbol). Choice a -> Choice a -> Bool
/= :: Choice a -> Choice a -> Bool
Eq, Eq (Choice a)
Eq (Choice a) =>
(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)
-> (Choice a -> Choice a -> Choice a)
-> (Choice a -> Choice a -> Choice a)
-> Ord (Choice a)
Choice a -> Choice a -> Bool
Choice a -> Choice a -> Ordering
Choice a -> Choice a -> Choice a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (a :: Symbol). Eq (Choice a)
forall (a :: Symbol). Choice a -> Choice a -> Bool
forall (a :: Symbol). Choice a -> Choice a -> Ordering
forall (a :: Symbol). Choice a -> Choice a -> Choice a
$ccompare :: forall (a :: Symbol). Choice a -> Choice a -> Ordering
compare :: Choice a -> Choice a -> Ordering
$c< :: forall (a :: Symbol). Choice a -> Choice a -> Bool
< :: Choice a -> Choice a -> Bool
$c<= :: forall (a :: Symbol). Choice a -> Choice a -> Bool
<= :: Choice a -> Choice a -> Bool
$c> :: forall (a :: Symbol). Choice a -> Choice a -> Bool
> :: Choice a -> Choice a -> Bool
$c>= :: forall (a :: Symbol). Choice a -> Choice a -> Bool
>= :: Choice a -> Choice a -> Bool
$cmax :: forall (a :: Symbol). Choice a -> Choice a -> Choice a
max :: Choice a -> Choice a -> Choice a
$cmin :: forall (a :: Symbol). Choice a -> Choice a -> Choice a
min :: Choice a -> Choice a -> Choice a
Ord, (forall x. Choice a -> Rep (Choice a) x)
-> (forall x. Rep (Choice a) x -> Choice a) -> Generic (Choice a)
forall x. Rep (Choice a) x -> Choice a
forall x. Choice a -> Rep (Choice a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (a :: Symbol) x. Rep (Choice a) x -> Choice a
forall (a :: Symbol) x. Choice a -> Rep (Choice a) x
$cfrom :: forall (a :: Symbol) x. Choice a -> Rep (Choice a) x
from :: forall x. Choice a -> Rep (Choice a) x
$cto :: forall (a :: Symbol) x. Rep (Choice a) x -> Choice a
to :: forall x. Rep (Choice a) x -> Choice a
Generic, Typeable)

instance Show (Choice a) where
  show :: Choice a -> String
show Choice a
x = String
"fromBool " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show (Choice a -> Bool
forall (a :: Symbol). Choice a -> Bool
toBool Choice a
x)

instance Enum (Choice a) where
  toEnum :: Int -> Choice a
toEnum Int
0 = Label a -> Choice a
forall (a :: Symbol). Label a -> Choice a
Off Label a
forall (a :: Symbol). Label a
Label
  toEnum Int
1 = Label a -> Choice a
forall (a :: Symbol). Label a -> Choice a
On Label a
forall (a :: Symbol). Label a
Label
  toEnum Int
_ = String -> Choice a
forall a. HasCallStack => String -> a
error String
"Prelude.Enum.Choice.toEnum: bad argument"

  fromEnum :: Choice a -> Int
fromEnum (Off Label a
_) = Int
0
  fromEnum (On Label a
_) = Int
1

instance Bounded (Choice a) where
  minBound :: Choice a
minBound = Label a -> Choice a
forall (a :: Symbol). Label a -> Choice a
Off Label a
forall (a :: Symbol). Label a
Label
  maxBound :: Choice a
maxBound = Label a -> Choice a
forall (a :: Symbol). Label a -> Choice a
On Label a
forall (a :: Symbol). Label a
Label

-- | Alias for 'True', e.g. @Do #block@.
pattern Do :: Label a -> Choice a
pattern $mDo :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
$bDo :: forall (a :: Symbol). Label a -> Choice a
Do x = On x

-- | Alias for 'False', e.g. @Don't #block@.
pattern Don't :: Label a -> Choice a
pattern $mDon't :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
$bDon't :: forall (a :: Symbol). Label a -> Choice a
Don't x = Off x

{-# COMPLETE Do, Don't #-}

-- | Alias for 'True', e.g. @Is #ordered@.
pattern Is :: Label a -> Choice a
pattern $mIs :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
$bIs :: forall (a :: Symbol). Label a -> Choice a
Is x = On x

-- | Alias for 'False', e.g. @Isn't #ordered@.
pattern Isn't :: Label a -> Choice a
pattern $mIsn't :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
$bIsn't :: forall (a :: Symbol). Label a -> Choice a
Isn't x = Off x

{-# COMPLETE Is, Isn't #-}

-- | Alias for 'True', e.g. @With #ownDirectory@.
pattern With :: Label a -> Choice a
pattern $mWith :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
$bWith :: forall (a :: Symbol). Label a -> Choice a
With x = On x

-- | Alias for 'False', e.g. @Without #ownDirectory@.
pattern Without :: Label a -> Choice a
pattern $mWithout :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
$bWithout :: forall (a :: Symbol). Label a -> Choice a
Without x = Off x

{-# COMPLETE With, Without #-}

-- | Alias for 'True', e.g. @Must #succeed@.
pattern Must :: Label a -> Choice a
pattern $mMust :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
$bMust :: forall (a :: Symbol). Label a -> Choice a
Must x = On x

-- | Alias for 'False', e.g. @Mustn't #succeed@.
pattern Mustn't :: Label a -> Choice a
pattern $mMustn't :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
$bMustn't :: forall (a :: Symbol). Label a -> Choice a
Mustn't x = Off x

{-# COMPLETE Must, Mustn't #-}

-- | Alias for 'False', e.g. @Needn't #succeed@.
pattern $mNeedn't :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
$bNeedn't :: forall (a :: Symbol). Label a -> Choice a
Needn't x = Off x

{-# DEPRECATED Needn't "Use Can or Can't." #-}

-- | Alias for 'True', e.g. @Can #fail@.
pattern Can :: Label a -> Choice a
pattern $mCan :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
$bCan :: forall (a :: Symbol). Label a -> Choice a
Can x = On x

-- | Alias for 'False', e.g. @Can't #fail@.
pattern Can't :: Label a -> Choice a
pattern $mCan't :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
$bCan't :: forall (a :: Symbol). Label a -> Choice a
Can't x = Off x

{-# COMPLETE Can, Can't #-}

-- | Alias for 'True', e.g. @Should #succeed@.
pattern Should :: Label a -> Choice a
pattern $mShould :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
$bShould :: forall (a :: Symbol). Label a -> Choice a
Should x = On x

-- | Alias for 'False', e.g. @Shouldn't #succeed@.
pattern Shouldn't :: Label a -> Choice a
pattern $mShouldn't :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
$bShouldn't :: forall (a :: Symbol). Label a -> Choice a
Shouldn't x = Off x

{-# COMPLETE Should, Shouldn't #-}

toBool :: Choice a -> Bool
toBool :: forall (a :: Symbol). Choice a -> Bool
toBool (Off Label a
_) = Bool
False
toBool (On Label a
_) = Bool
True

fromBool :: Bool -> Choice a
fromBool :: forall (a :: Symbol). Bool -> Choice a
fromBool Bool
False = Label a -> Choice a
forall (a :: Symbol). Label a -> Choice a
Off Label a
forall (a :: Symbol). Label a
Label
fromBool Bool
True = Label a -> Choice a
forall (a :: Symbol). Label a -> Choice a
On Label a
forall (a :: Symbol). Label a
Label

isTrue :: Choice a -> Bool
isTrue :: forall (a :: Symbol). Choice a -> Bool
isTrue (Off Label a
_) = Bool
False
isTrue (On Label a
_) = Bool
True

isFalse :: Choice a -> Bool
isFalse :: forall (a :: Symbol). Choice a -> Bool
isFalse (Off Label a
_) = Bool
True
isFalse (On Label a
_) = Bool
False

-- | 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 @'Data.Bool.bool' x y ('toBool' p)@.
choice :: a -> a -> Choice b -> a
choice :: forall a (b :: Symbol). a -> a -> Choice b -> a
choice a
x a
_ (Off Label b
_) = a
x
choice a
_ a
y (On Label b
_) = a
y