{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      : Data.Char.BallotBox
-- Description : Support for the ballot box characters in unicode.
-- Maintainer  : hapytexeu+gh@gmail.com
-- Stability   : experimental
-- Portability : POSIX
--
-- Unicode has a <https://www.unicode.org/charts/PDF/U2600.pdf block> named /Miscellaneous Symbols/ that includes unicode characters for boxes that are empty, contain a check or a cross, this module aims to make it more convenient to render these.
module Data.Char.BallotBox
  ( -- * Represent a ballot box.
    BallotBox (Empty, Check, Cross),

    -- * Convert a boolean to a ballot box.
    toCheckBox,
    toCrossBox,
  )
where

import Control.DeepSeq (NFData)
import Data.Char.Core (UnicodeCharacter (fromUnicodeChar, fromUnicodeChar', isInCharRange, toUnicodeChar), UnicodeText (isInTextRange), generateIsInTextRange', mapFromEnum, mapToEnum, mapToEnumSafe)
import Data.Data (Data)
import Data.Hashable (Hashable)
import GHC.Generics (Generic)
import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary), arbitraryBoundedEnum)

_ballotOffset :: Int
_ballotOffset :: Int
_ballotOffset = Int
0x2610

-- | Check if the given 'Char'acter is a character that maps on a 'BallotBox' object.
isBallotBox ::
  -- | The given 'Char'acter to check.
  Char ->
  -- | 'True' if the given 'Char'acter corresponds to a 'BallotBox' object; 'False' otherwise.
  Bool
isBallotBox :: Char -> Bool
isBallotBox Char
c = Char
'\x2610' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x2612'

-- | A datatype that represents the different types of ballot boxes.
data BallotBox
  = -- | The box is /empty/, this is represented with ☐.
    Empty
  | -- | The box has a /check/, this is represented with ☑.
    Check
  | -- | The box has a /cross/, this is represented with ☒.
    Cross
  deriving (BallotBox
forall a. a -> a -> Bounded a
maxBound :: BallotBox
$cmaxBound :: BallotBox
minBound :: BallotBox
$cminBound :: BallotBox
Bounded, Typeable BallotBox
BallotBox -> DataType
BallotBox -> Constr
(forall b. Data b => b -> b) -> BallotBox -> BallotBox
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> BallotBox -> u
forall u. (forall d. Data d => d -> u) -> BallotBox -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BallotBox -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BallotBox -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BallotBox -> m BallotBox
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BallotBox -> m BallotBox
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BallotBox
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BallotBox -> c BallotBox
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BallotBox)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BallotBox)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BallotBox -> m BallotBox
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BallotBox -> m BallotBox
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BallotBox -> m BallotBox
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BallotBox -> m BallotBox
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BallotBox -> m BallotBox
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BallotBox -> m BallotBox
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BallotBox -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BallotBox -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> BallotBox -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BallotBox -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BallotBox -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BallotBox -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BallotBox -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BallotBox -> r
gmapT :: (forall b. Data b => b -> b) -> BallotBox -> BallotBox
$cgmapT :: (forall b. Data b => b -> b) -> BallotBox -> BallotBox
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BallotBox)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BallotBox)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BallotBox)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BallotBox)
dataTypeOf :: BallotBox -> DataType
$cdataTypeOf :: BallotBox -> DataType
toConstr :: BallotBox -> Constr
$ctoConstr :: BallotBox -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BallotBox
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BallotBox
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BallotBox -> c BallotBox
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BallotBox -> c BallotBox
Data, Int -> BallotBox
BallotBox -> Int
BallotBox -> [BallotBox]
BallotBox -> BallotBox
BallotBox -> BallotBox -> [BallotBox]
BallotBox -> BallotBox -> BallotBox -> [BallotBox]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BallotBox -> BallotBox -> BallotBox -> [BallotBox]
$cenumFromThenTo :: BallotBox -> BallotBox -> BallotBox -> [BallotBox]
enumFromTo :: BallotBox -> BallotBox -> [BallotBox]
$cenumFromTo :: BallotBox -> BallotBox -> [BallotBox]
enumFromThen :: BallotBox -> BallotBox -> [BallotBox]
$cenumFromThen :: BallotBox -> BallotBox -> [BallotBox]
enumFrom :: BallotBox -> [BallotBox]
$cenumFrom :: BallotBox -> [BallotBox]
fromEnum :: BallotBox -> Int
$cfromEnum :: BallotBox -> Int
toEnum :: Int -> BallotBox
$ctoEnum :: Int -> BallotBox
pred :: BallotBox -> BallotBox
$cpred :: BallotBox -> BallotBox
succ :: BallotBox -> BallotBox
$csucc :: BallotBox -> BallotBox
Enum, BallotBox -> BallotBox -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BallotBox -> BallotBox -> Bool
$c/= :: BallotBox -> BallotBox -> Bool
== :: BallotBox -> BallotBox -> Bool
$c== :: BallotBox -> BallotBox -> Bool
Eq, forall x. Rep BallotBox x -> BallotBox
forall x. BallotBox -> Rep BallotBox x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BallotBox x -> BallotBox
$cfrom :: forall x. BallotBox -> Rep BallotBox x
Generic, Eq BallotBox
BallotBox -> BallotBox -> Bool
BallotBox -> BallotBox -> Ordering
BallotBox -> BallotBox -> BallotBox
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
min :: BallotBox -> BallotBox -> BallotBox
$cmin :: BallotBox -> BallotBox -> BallotBox
max :: BallotBox -> BallotBox -> BallotBox
$cmax :: BallotBox -> BallotBox -> BallotBox
>= :: BallotBox -> BallotBox -> Bool
$c>= :: BallotBox -> BallotBox -> Bool
> :: BallotBox -> BallotBox -> Bool
$c> :: BallotBox -> BallotBox -> Bool
<= :: BallotBox -> BallotBox -> Bool
$c<= :: BallotBox -> BallotBox -> Bool
< :: BallotBox -> BallotBox -> Bool
$c< :: BallotBox -> BallotBox -> Bool
compare :: BallotBox -> BallotBox -> Ordering
$ccompare :: BallotBox -> BallotBox -> Ordering
Ord, ReadPrec [BallotBox]
ReadPrec BallotBox
Int -> ReadS BallotBox
ReadS [BallotBox]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BallotBox]
$creadListPrec :: ReadPrec [BallotBox]
readPrec :: ReadPrec BallotBox
$creadPrec :: ReadPrec BallotBox
readList :: ReadS [BallotBox]
$creadList :: ReadS [BallotBox]
readsPrec :: Int -> ReadS BallotBox
$creadsPrec :: Int -> ReadS BallotBox
Read, Int -> BallotBox -> ShowS
[BallotBox] -> ShowS
BallotBox -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BallotBox] -> ShowS
$cshowList :: [BallotBox] -> ShowS
show :: BallotBox -> String
$cshow :: BallotBox -> String
showsPrec :: Int -> BallotBox -> ShowS
$cshowsPrec :: Int -> BallotBox -> ShowS
Show)

instance Hashable BallotBox

instance NFData BallotBox

-- | Convert the given 'Bool'ean to a 'BallotBox' that is 'Empty', or contains a 'Check'.
toCheckBox ::
  -- | The given 'Bool' that determines if the box contains a 'Check'.
  Bool ->
  -- | The corresponding 'BallotBox'.
  BallotBox
toCheckBox :: Bool -> BallotBox
toCheckBox = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

-- | Convert the given 'Bool'ean to a 'BallotBox' that is 'Empty', or contains a 'Cross'.
toCrossBox ::
  -- | The given 'Bool' that determines if the box contains a 'Cross'.
  Bool ->
  -- | The corresponding 'BallotBox'.
  BallotBox
toCrossBox :: Bool -> BallotBox
toCrossBox = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
2 forall a. Num a => a -> a -> a
*) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

instance Arbitrary BallotBox where
  arbitrary :: Gen BallotBox
arbitrary = forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance UnicodeCharacter BallotBox where
  toUnicodeChar :: BallotBox -> Char
toUnicodeChar = forall a. Enum a => Int -> a -> Char
mapFromEnum Int
_ballotOffset
  fromUnicodeChar :: Char -> Maybe BallotBox
fromUnicodeChar = forall a. (Bounded a, Enum a) => Int -> Char -> Maybe a
mapToEnumSafe Int
_ballotOffset
  fromUnicodeChar' :: Char -> BallotBox
fromUnicodeChar' = forall a. Enum a => Int -> Char -> a
mapToEnum Int
_ballotOffset
  isInCharRange :: Char -> Bool
isInCharRange = Char -> Bool
isBallotBox

instance UnicodeText BallotBox where
  isInTextRange :: Text -> Bool
isInTextRange = forall a. UnicodeCharacter a => Text -> Bool
generateIsInTextRange' @BallotBox