{-# 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
, fromBool
, toBool
, choice
, 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
, 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)
data Label (a :: Symbol) = Label deriving (Label a -> Label a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
Eq, Label a -> Label a -> Bool
Label a -> Label a -> Ordering
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
min :: Label a -> Label a -> Label a
$cmin :: forall (a :: Symbol). Label a -> Label a -> Label a
max :: Label a -> Label a -> Label a
$cmax :: forall (a :: Symbol). Label a -> Label a -> Label a
>= :: 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
$c< :: forall (a :: Symbol). Label a -> Label a -> Bool
compare :: Label a -> Label a -> Ordering
$ccompare :: forall (a :: Symbol). Label a -> Label a -> Ordering
Ord, Int -> Label a -> ShowS
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
showList :: [Label a] -> ShowS
$cshowList :: forall (a :: Symbol). [Label a] -> ShowS
show :: Label a -> String
$cshow :: forall (a :: Symbol). Label a -> String
showsPrec :: Int -> Label a -> ShowS
$cshowsPrec :: forall (a :: Symbol). Int -> Label a -> ShowS
Show)
#if MIN_VERSION_base(4,10,0)
instance x ~ x' => IsLabel x (Label x') where
fromLabel :: Label x'
fromLabel = forall (a :: Symbol). Label a
Label
#elif MIN_VERSION_base(4,9,0)
instance x ~ x' => IsLabel x (Label x') where
fromLabel _ = Label
#endif
data Choice (a :: Symbol)
= Off {-# UNPACK #-} !(Label a)
| On {-# UNPACK #-} !(Label a)
deriving (Choice a -> Choice a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
Eq, Choice a -> Choice a -> Bool
Choice a -> Choice a -> Ordering
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
min :: Choice a -> Choice a -> Choice a
$cmin :: forall (a :: Symbol). Choice a -> Choice a -> Choice a
max :: Choice a -> Choice a -> Choice a
$cmax :: forall (a :: Symbol). Choice a -> Choice a -> Choice a
>= :: 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
$c< :: forall (a :: Symbol). Choice a -> Choice a -> Bool
compare :: Choice a -> Choice a -> Ordering
$ccompare :: forall (a :: Symbol). Choice a -> Choice a -> Ordering
Ord, 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
$cto :: forall (a :: Symbol) x. Rep (Choice a) x -> Choice a
$cfrom :: forall (a :: Symbol) x. Choice a -> Rep (Choice a) x
Generic, Typeable)
instance Show (Choice a) where
show :: Choice a -> String
show Choice a
x = String
"fromBool " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (a :: Symbol). Choice a -> Bool
toBool Choice a
x)
instance Enum (Choice a) where
toEnum :: Int -> Choice a
toEnum Int
0 = forall (a :: Symbol). Label a -> Choice a
Off forall (a :: Symbol). Label a
Label
toEnum Int
1 = forall (a :: Symbol). Label a -> Choice a
On forall (a :: Symbol). Label a
Label
toEnum Int
_ = 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 = forall (a :: Symbol). Label a -> Choice a
Off forall (a :: Symbol). Label a
Label
maxBound :: Choice a
maxBound = forall (a :: Symbol). Label a -> Choice a
On forall (a :: Symbol). Label a
Label
pattern Do :: Label a -> Choice a
pattern $bDo :: forall (a :: Symbol). Label a -> Choice a
$mDo :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
Do x = On x
pattern Don't :: Label a -> Choice a
pattern $bDon't :: forall (a :: Symbol). Label a -> Choice a
$mDon't :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
Don't x = Off x
{-# COMPLETE Do, Don't #-}
pattern Is :: Label a -> Choice a
pattern $bIs :: forall (a :: Symbol). Label a -> Choice a
$mIs :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
Is x = On x
pattern Isn't :: Label a -> Choice a
pattern $bIsn't :: forall (a :: Symbol). Label a -> Choice a
$mIsn't :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
Isn't x = Off x
{-# COMPLETE Is, Isn't #-}
pattern With :: Label a -> Choice a
pattern $bWith :: forall (a :: Symbol). Label a -> Choice a
$mWith :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
With x = On x
pattern Without :: Label a -> Choice a
pattern $bWithout :: forall (a :: Symbol). Label a -> Choice a
$mWithout :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
Without x = Off x
{-# COMPLETE With, Without #-}
pattern Must :: Label a -> Choice a
pattern $bMust :: forall (a :: Symbol). Label a -> Choice a
$mMust :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
Must x = On x
pattern Mustn't :: Label a -> Choice a
pattern $bMustn't :: forall (a :: Symbol). Label a -> Choice a
$mMustn't :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
Mustn't x = Off x
{-# COMPLETE Must, Mustn't #-}
pattern $bNeedn't :: forall (a :: Symbol). Label a -> Choice a
$mNeedn't :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
Needn't x = Off x
{-# DEPRECATED Needn't "Use Can or Can't." #-}
pattern Can :: Label a -> Choice a
pattern $bCan :: forall (a :: Symbol). Label a -> Choice a
$mCan :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
Can x = On x
pattern Can't :: Label a -> Choice a
pattern $bCan't :: forall (a :: Symbol). Label a -> Choice a
$mCan't :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
Can't x = Off x
{-# COMPLETE Can, Can't #-}
pattern Should :: Label a -> Choice a
pattern $bShould :: forall (a :: Symbol). Label a -> Choice a
$mShould :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
Should x = On x
pattern Shouldn't :: Label a -> Choice a
pattern $bShouldn't :: forall (a :: Symbol). Label a -> Choice a
$mShouldn't :: forall {r} {a :: Symbol}.
Choice a -> (Label a -> r) -> ((# #) -> r) -> r
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 = forall (a :: Symbol). Label a -> Choice a
Off forall (a :: Symbol). Label a
Label
fromBool Bool
True = forall (a :: Symbol). Label a -> Choice a
On forall (a :: Symbol). Label a
Label
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