{-# LANGUAGE CPP, DeriveDataTypeable, DeriveGeneric, DeriveTraversable, FlexibleInstances, PatternSynonyms, Safe, TypeApplications #-}

{-|
Module      : Data.Char.Block
Description : A module used to render blocks in unicode.
Maintainer  : hapytexeu+gh@gmail.com
Stability   : experimental
Portability : POSIX

Unicode has 2-by-2 blocks, this module aims to make it more convenient to render such blocks.
-}

module Data.Char.Block(
    -- * Datastructures to store the state of the frame.
    Row(Row, left, right), rowValue, toRow, toRow'
  , pattern EmptyRow, pattern FullRow, pattern LeftRow, pattern RightRow
  , Block(Block, upper, lower)
    -- * A unicode character that is (partially) filled block.
  , filled
    -- * Convert a 'Char'acter to a (partially) filled block.
  , fromBlock, fromBlock'
    -- * Pattern synonyms for blocks
  , pattern EmptyBlock, pattern FullBlock, pattern LeftHalfBlock, pattern RightHalfBlock
  ) where

import Control.DeepSeq(NFData, NFData1)

import Data.Bits((.|.))
import Data.Bool(bool)
import Data.Char.Core(MirrorHorizontal(mirrorHorizontal), MirrorVertical(mirrorVertical), UnicodeCharacter(toUnicodeChar, fromUnicodeChar, isInCharRange), UnicodeText(isInTextRange), generateIsInTextRange')
import Data.Data(Data)
import Data.Functor.Classes(Eq1(liftEq), Ord1(liftCompare))
import Data.Hashable(Hashable)
import Data.Hashable.Lifted(Hashable1)
import Data.Maybe(fromJust)
#if __GLASGOW_HASKELL__ < 803
import Data.Semigroup((<>))
#endif

import GHC.Generics(Generic, Generic1)

import Test.QuickCheck.Arbitrary(Arbitrary(arbitrary), Arbitrary1(liftArbitrary), arbitrary1)

-- | A pattern synonym for the /block/ 'Char'acter that will render a full block.
pattern FullBlock :: Char
pattern $bFullBlock :: Char
$mFullBlock :: forall {r}. Char -> ((# #) -> r) -> ((# #) -> r) -> r
FullBlock = '\x2588'

-- | A pattern synonym for a /block/ 'Char'acter that will render an empty block, this is equivalent to a space.
pattern EmptyBlock :: Char
pattern $bEmptyBlock :: Char
$mEmptyBlock :: forall {r}. Char -> ((# #) -> r) -> ((# #) -> r) -> r
EmptyBlock = ' '

-- | A pattern synonym for a /block/ 'Char'acter that will render a block where the /left/ half of the block is filled.
pattern LeftHalfBlock :: Char
pattern $bLeftHalfBlock :: Char
$mLeftHalfBlock :: forall {r}. Char -> ((# #) -> r) -> ((# #) -> r) -> r
LeftHalfBlock = '\x258c'

-- | A pattern synonym for a /block/ 'Char'acter that will render a block where the /right/ half of the block is filled.
pattern RightHalfBlock :: Char
pattern $bRightHalfBlock :: Char
$mRightHalfBlock :: forall {r}. Char -> ((# #) -> r) -> ((# #) -> r) -> r
RightHalfBlock = '\x2590'


-- | A data type that determines the state of the /row/ in a block.
-- it determines the left and the right part of the row of the block.
data Row a = Row {
    forall a. Row a -> a
left :: a  -- ^ The left part of a row of the block.
  , forall a. Row a -> a
right :: a  -- ^ The right part of the row of the block.
  } deriving (Row a
forall a. a -> a -> Bounded a
forall a. Bounded a => Row a
maxBound :: Row a
$cmaxBound :: forall a. Bounded a => Row a
minBound :: Row a
$cminBound :: forall a. Bounded a => Row a
Bounded, Row a -> DataType
Row a -> Constr
forall {a}. Data a => Typeable (Row a)
forall a. Data a => Row a -> DataType
forall a. Data a => Row a -> Constr
forall a. Data a => (forall b. Data b => b -> b) -> Row a -> Row a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Row a -> u
forall a u. Data a => (forall d. Data d => d -> u) -> Row a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Row a -> r
forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Row a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Row a -> m (Row a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Row a -> m (Row a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Row a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Row a -> c (Row a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Row a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Row a))
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 (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Row a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Row a -> c (Row a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Row a))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Row a -> m (Row a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Row a -> m (Row a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Row a -> m (Row a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Row a -> m (Row a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Row a -> m (Row a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Row a -> m (Row a)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Row a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Row a -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Row a -> [u]
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> Row a -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Row a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Row a -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Row a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Row a -> r
gmapT :: (forall b. Data b => b -> b) -> Row a -> Row a
$cgmapT :: forall a. Data a => (forall b. Data b => b -> b) -> Row a -> Row a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Row a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Row a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Row a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Row a))
dataTypeOf :: Row a -> DataType
$cdataTypeOf :: forall a. Data a => Row a -> DataType
toConstr :: Row a -> Constr
$ctoConstr :: forall a. Data a => Row a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Row a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Row a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Row a -> c (Row a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Row a -> c (Row a)
Data, Row a -> Row a -> Bool
forall a. Eq a => Row a -> Row a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Row a -> Row a -> Bool
$c/= :: forall a. Eq a => Row a -> Row a -> Bool
== :: Row a -> Row a -> Bool
$c== :: forall a. Eq a => Row a -> Row a -> Bool
Eq, forall a. Eq a => a -> Row a -> Bool
forall a. Num a => Row a -> a
forall a. Ord a => Row a -> a
forall m. Monoid m => Row m -> m
forall a. Row a -> Bool
forall a. Row a -> Int
forall a. Row a -> [a]
forall a. (a -> a -> a) -> Row a -> a
forall m a. Monoid m => (a -> m) -> Row a -> m
forall b a. (b -> a -> b) -> b -> Row a -> b
forall a b. (a -> b -> b) -> b -> Row a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Row a -> a
$cproduct :: forall a. Num a => Row a -> a
sum :: forall a. Num a => Row a -> a
$csum :: forall a. Num a => Row a -> a
minimum :: forall a. Ord a => Row a -> a
$cminimum :: forall a. Ord a => Row a -> a
maximum :: forall a. Ord a => Row a -> a
$cmaximum :: forall a. Ord a => Row a -> a
elem :: forall a. Eq a => a -> Row a -> Bool
$celem :: forall a. Eq a => a -> Row a -> Bool
length :: forall a. Row a -> Int
$clength :: forall a. Row a -> Int
null :: forall a. Row a -> Bool
$cnull :: forall a. Row a -> Bool
toList :: forall a. Row a -> [a]
$ctoList :: forall a. Row a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Row a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Row a -> a
foldr1 :: forall a. (a -> a -> a) -> Row a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Row a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Row a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Row a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Row a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Row a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Row a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Row a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Row a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Row a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Row a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Row a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Row a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Row a -> m
fold :: forall m. Monoid m => Row m -> m
$cfold :: forall m. Monoid m => Row m -> m
Foldable, forall a b. a -> Row b -> Row a
forall a b. (a -> b) -> Row a -> Row b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Row b -> Row a
$c<$ :: forall a b. a -> Row b -> Row a
fmap :: forall a b. (a -> b) -> Row a -> Row b
$cfmap :: forall a b. (a -> b) -> Row a -> Row b
Functor, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Row a) x -> Row a
forall a x. Row a -> Rep (Row a) x
$cto :: forall a x. Rep (Row a) x -> Row a
$cfrom :: forall a x. Row a -> Rep (Row a) x
Generic, forall a. Rep1 Row a -> Row a
forall a. Row a -> Rep1 Row a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 Row a -> Row a
$cfrom1 :: forall a. Row a -> Rep1 Row a
Generic1, Row a -> Row a -> Bool
Row a -> Row 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}. Ord a => Eq (Row a)
forall a. Ord a => Row a -> Row a -> Bool
forall a. Ord a => Row a -> Row a -> Ordering
forall a. Ord a => Row a -> Row a -> Row a
min :: Row a -> Row a -> Row a
$cmin :: forall a. Ord a => Row a -> Row a -> Row a
max :: Row a -> Row a -> Row a
$cmax :: forall a. Ord a => Row a -> Row a -> Row a
>= :: Row a -> Row a -> Bool
$c>= :: forall a. Ord a => Row a -> Row a -> Bool
> :: Row a -> Row a -> Bool
$c> :: forall a. Ord a => Row a -> Row a -> Bool
<= :: Row a -> Row a -> Bool
$c<= :: forall a. Ord a => Row a -> Row a -> Bool
< :: Row a -> Row a -> Bool
$c< :: forall a. Ord a => Row a -> Row a -> Bool
compare :: Row a -> Row a -> Ordering
$ccompare :: forall a. Ord a => Row a -> Row a -> Ordering
Ord, ReadPrec [Row a]
ReadPrec (Row a)
ReadS [Row a]
forall a. Read a => ReadPrec [Row a]
forall a. Read a => ReadPrec (Row a)
forall a. Read a => Int -> ReadS (Row a)
forall a. Read a => ReadS [Row a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Row a]
$creadListPrec :: forall a. Read a => ReadPrec [Row a]
readPrec :: ReadPrec (Row a)
$creadPrec :: forall a. Read a => ReadPrec (Row a)
readList :: ReadS [Row a]
$creadList :: forall a. Read a => ReadS [Row a]
readsPrec :: Int -> ReadS (Row a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Row a)
Read, Int -> Row a -> ShowS
forall a. Show a => Int -> Row a -> ShowS
forall a. Show a => [Row a] -> ShowS
forall a. Show a => Row a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Row a] -> ShowS
$cshowList :: forall a. Show a => [Row a] -> ShowS
show :: Row a -> String
$cshow :: forall a. Show a => Row a -> String
showsPrec :: Int -> Row a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Row a -> ShowS
Show, Functor Row
Foldable Row
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Row (m a) -> m (Row a)
forall (f :: * -> *) a. Applicative f => Row (f a) -> f (Row a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Row a -> m (Row b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Row a -> f (Row b)
sequence :: forall (m :: * -> *) a. Monad m => Row (m a) -> m (Row a)
$csequence :: forall (m :: * -> *) a. Monad m => Row (m a) -> m (Row a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Row a -> m (Row b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Row a -> m (Row b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Row (f a) -> f (Row a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Row (f a) -> f (Row a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Row a -> f (Row b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Row a -> f (Row b)
Traversable)

-- | A pattern synonym for a 'Row' where both the left and right subpart are 'True'.
pattern FullRow :: Row Bool
pattern $bFullRow :: Row Bool
$mFullRow :: forall {r}. Row Bool -> ((# #) -> r) -> ((# #) -> r) -> r
FullRow = Row True True

-- | A pattern synonym for a 'Row' where both the left and right subpart are 'False'.
pattern EmptyRow :: Row Bool
pattern $bEmptyRow :: Row Bool
$mEmptyRow :: forall {r}. Row Bool -> ((# #) -> r) -> ((# #) -> r) -> r
EmptyRow = Row False False

-- | A pattern synonym for a 'Row' where the left part is set to 'True', and the right part is set to 'False'.
pattern LeftRow :: Row Bool
pattern $bLeftRow :: Row Bool
$mLeftRow :: forall {r}. Row Bool -> ((# #) -> r) -> ((# #) -> r) -> r
LeftRow = Row True False

-- | A pattern synonym for a 'Row' where the left part is set to 'False', and the right part is set to 'True'.
pattern RightRow :: Row Bool
pattern $bRightRow :: Row Bool
$mRightRow :: forall {r}. Row Bool -> ((# #) -> r) -> ((# #) -> r) -> r
RightRow = Row False True

-- | Convert the given 'Row' of 'Bool'eans to an 'Int' where the left 'Bool' has value 1, and the right one has value two. The four different 'Row's thus are mapped to integers from zero to three (both inclusive).
rowValue
  :: Row Bool  -- ^ The given 'Row' of 'Bool's to convert.
  -> Int  -- ^ The corresponding numerical value.
rowValue :: Row Bool -> Int
rowValue ~(Row Bool
l Bool
r) = Int -> Bool -> Int
b0 Int
1 Bool
l forall a. Bits a => a -> a -> a
.|. Int -> Bool -> Int
b0 Int
2 Bool
r
  where b0 :: Int -> Bool -> Int
b0 = forall a. a -> a -> Bool -> a
bool Int
0

-- | Convert the given number to a 'Row' of 'Bool's. If the value
-- is out of bounds, it is unspecified what will happen.
toRow'
  :: Int  -- ^ The given number to convert.
  -> Row Bool  -- ^ The corresponding 'Row' of 'Bool's.
toRow' :: Int -> Row Bool
toRow' Int
i = forall a. a -> a -> Row a
Row (forall a. Integral a => a -> Bool
odd Int
i) (Int
i forall a. Ord a => a -> a -> Bool
>= Int
0x02)

-- | Convert the given number to a 'Row' of 'Bool's wrapped in a 'Just'.
-- if the value is out of bounds, 'Nothing' is returned.
toRow
  :: Int -- ^ The given number to convert.
  -> Maybe (Row Bool)  -- ^ The corresponding 'Row' of 'Bool's.
toRow :: Int -> Maybe (Row Bool)
toRow Int
i
  | Int
i forall a. Ord a => a -> a -> Bool
>= Int
0x00 Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
<= Int
0x03 = forall a. a -> Maybe a
Just (Int -> Row Bool
toRow' Int
i)
  | Bool
otherwise = forall a. Maybe a
Nothing

instance Eq1 Row where
  liftEq :: forall a b. (a -> b -> Bool) -> Row a -> Row b -> Bool
liftEq a -> b -> Bool
cmp ~(Row a
xa a
xb) ~(Row b
ya b
yb) = a -> b -> Bool
cmp a
xa b
ya Bool -> Bool -> Bool
&& a -> b -> Bool
cmp a
xb b
yb

instance Hashable1 Row

instance Hashable a => Hashable (Row a)

instance MirrorVertical (Row a) where
  mirrorVertical :: Row a -> Row a
mirrorVertical (Row a
l a
r) = forall a. a -> a -> Row a
Row a
r a
l

instance NFData a => NFData (Row a)

instance NFData1 Row

instance Ord1 Row where
  liftCompare :: forall a b. (a -> b -> Ordering) -> Row a -> Row b -> Ordering
liftCompare a -> b -> Ordering
cmp ~(Row a
xa a
xb) ~(Row b
ya b
yb) = a -> b -> Ordering
cmp a
xa b
ya forall a. Semigroup a => a -> a -> a
<> a -> b -> Ordering
cmp a
xb b
yb

-- | A data type that determines the state of the four subparts of the block.
data Block a = Block {
    forall a. Block a -> Row a
upper :: Row a  -- ^ The upper part of the block.
  , forall a. Block a -> Row a
lower :: Row a  -- ^ The lower part of the block.
  } deriving (Block a
forall a. a -> a -> Bounded a
forall a. Bounded a => Block a
maxBound :: Block a
$cmaxBound :: forall a. Bounded a => Block a
minBound :: Block a
$cminBound :: forall a. Bounded a => Block a
Bounded, Block a -> DataType
Block a -> Constr
forall {a}. Data a => Typeable (Block a)
forall a. Data a => Block a -> DataType
forall a. Data a => Block a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> Block a -> Block a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Block a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> Block a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Block a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Block a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Block a -> m (Block a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Block a -> m (Block a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Block a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Block a -> c (Block a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Block a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Block a))
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 (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Block a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Block a -> c (Block a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Block a))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Block a -> m (Block a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Block a -> m (Block a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Block a -> m (Block a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Block a -> m (Block a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Block a -> m (Block a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Block a -> m (Block a)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Block a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Block a -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Block a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Block a -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Block a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Block a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Block a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Block a -> r
gmapT :: (forall b. Data b => b -> b) -> Block a -> Block a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Block a -> Block a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Block a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Block a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Block a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Block a))
dataTypeOf :: Block a -> DataType
$cdataTypeOf :: forall a. Data a => Block a -> DataType
toConstr :: Block a -> Constr
$ctoConstr :: forall a. Data a => Block a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Block a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Block a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Block a -> c (Block a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Block a -> c (Block a)
Data, Block a -> Block a -> Bool
forall a. Eq a => Block a -> Block a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Block a -> Block a -> Bool
$c/= :: forall a. Eq a => Block a -> Block a -> Bool
== :: Block a -> Block a -> Bool
$c== :: forall a. Eq a => Block a -> Block a -> Bool
Eq, forall a. Eq a => a -> Block a -> Bool
forall a. Num a => Block a -> a
forall a. Ord a => Block a -> a
forall m. Monoid m => Block m -> m
forall a. Block a -> Bool
forall a. Block a -> Int
forall a. Block a -> [a]
forall a. (a -> a -> a) -> Block a -> a
forall m a. Monoid m => (a -> m) -> Block a -> m
forall b a. (b -> a -> b) -> b -> Block a -> b
forall a b. (a -> b -> b) -> b -> Block a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Block a -> a
$cproduct :: forall a. Num a => Block a -> a
sum :: forall a. Num a => Block a -> a
$csum :: forall a. Num a => Block a -> a
minimum :: forall a. Ord a => Block a -> a
$cminimum :: forall a. Ord a => Block a -> a
maximum :: forall a. Ord a => Block a -> a
$cmaximum :: forall a. Ord a => Block a -> a
elem :: forall a. Eq a => a -> Block a -> Bool
$celem :: forall a. Eq a => a -> Block a -> Bool
length :: forall a. Block a -> Int
$clength :: forall a. Block a -> Int
null :: forall a. Block a -> Bool
$cnull :: forall a. Block a -> Bool
toList :: forall a. Block a -> [a]
$ctoList :: forall a. Block a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Block a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Block a -> a
foldr1 :: forall a. (a -> a -> a) -> Block a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Block a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Block a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Block a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Block a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Block a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Block a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Block a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Block a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Block a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Block a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Block a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Block a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Block a -> m
fold :: forall m. Monoid m => Block m -> m
$cfold :: forall m. Monoid m => Block m -> m
Foldable, forall a b. a -> Block b -> Block a
forall a b. (a -> b) -> Block a -> Block b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Block b -> Block a
$c<$ :: forall a b. a -> Block b -> Block a
fmap :: forall a b. (a -> b) -> Block a -> Block b
$cfmap :: forall a b. (a -> b) -> Block a -> Block b
Functor, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Block a) x -> Block a
forall a x. Block a -> Rep (Block a) x
$cto :: forall a x. Rep (Block a) x -> Block a
$cfrom :: forall a x. Block a -> Rep (Block a) x
Generic, forall a. Rep1 Block a -> Block a
forall a. Block a -> Rep1 Block a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 Block a -> Block a
$cfrom1 :: forall a. Block a -> Rep1 Block a
Generic1, Block a -> Block a -> Bool
Block a -> Block 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}. Ord a => Eq (Block a)
forall a. Ord a => Block a -> Block a -> Bool
forall a. Ord a => Block a -> Block a -> Ordering
forall a. Ord a => Block a -> Block a -> Block a
min :: Block a -> Block a -> Block a
$cmin :: forall a. Ord a => Block a -> Block a -> Block a
max :: Block a -> Block a -> Block a
$cmax :: forall a. Ord a => Block a -> Block a -> Block a
>= :: Block a -> Block a -> Bool
$c>= :: forall a. Ord a => Block a -> Block a -> Bool
> :: Block a -> Block a -> Bool
$c> :: forall a. Ord a => Block a -> Block a -> Bool
<= :: Block a -> Block a -> Bool
$c<= :: forall a. Ord a => Block a -> Block a -> Bool
< :: Block a -> Block a -> Bool
$c< :: forall a. Ord a => Block a -> Block a -> Bool
compare :: Block a -> Block a -> Ordering
$ccompare :: forall a. Ord a => Block a -> Block a -> Ordering
Ord, ReadPrec [Block a]
ReadPrec (Block a)
ReadS [Block a]
forall a. Read a => ReadPrec [Block a]
forall a. Read a => ReadPrec (Block a)
forall a. Read a => Int -> ReadS (Block a)
forall a. Read a => ReadS [Block a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Block a]
$creadListPrec :: forall a. Read a => ReadPrec [Block a]
readPrec :: ReadPrec (Block a)
$creadPrec :: forall a. Read a => ReadPrec (Block a)
readList :: ReadS [Block a]
$creadList :: forall a. Read a => ReadS [Block a]
readsPrec :: Int -> ReadS (Block a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Block a)
Read, Int -> Block a -> ShowS
forall a. Show a => Int -> Block a -> ShowS
forall a. Show a => [Block a] -> ShowS
forall a. Show a => Block a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block a] -> ShowS
$cshowList :: forall a. Show a => [Block a] -> ShowS
show :: Block a -> String
$cshow :: forall a. Show a => Block a -> String
showsPrec :: Int -> Block a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Block a -> ShowS
Show, Functor Block
Foldable Block
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Block (m a) -> m (Block a)
forall (f :: * -> *) a. Applicative f => Block (f a) -> f (Block a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Block a -> m (Block b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Block a -> f (Block b)
sequence :: forall (m :: * -> *) a. Monad m => Block (m a) -> m (Block a)
$csequence :: forall (m :: * -> *) a. Monad m => Block (m a) -> m (Block a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Block a -> m (Block b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Block a -> m (Block b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Block (f a) -> f (Block a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Block (f a) -> f (Block a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Block a -> f (Block b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Block a -> f (Block b)
Traversable)

instance Eq1 Block where
  liftEq :: forall a b. (a -> b -> Bool) -> Block a -> Block b -> Bool
liftEq a -> b -> Bool
cmp ~(Block Row a
ua Row a
la) ~(Block Row b
ub Row b
lb) = Row a -> Row b -> Bool
cmp' Row a
ua Row b
ub Bool -> Bool -> Bool
&& Row a -> Row b -> Bool
cmp' Row a
la Row b
lb
    where cmp' :: Row a -> Row b -> Bool
cmp' = forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
cmp

instance Hashable a => Hashable (Block a)

instance Hashable1 Block

instance MirrorVertical (Block a) where
  mirrorVertical :: Block a -> Block a
mirrorVertical (Block Row a
u Row a
d) = forall a. Row a -> Row a -> Block a
Block (forall a. MirrorVertical a => a -> a
mirrorVertical Row a
u) (forall a. MirrorVertical a => a -> a
mirrorVertical Row a
d)

instance MirrorHorizontal (Block a) where
  mirrorHorizontal :: Block a -> Block a
mirrorHorizontal (Block Row a
u Row a
d) = forall a. Row a -> Row a -> Block a
Block Row a
d Row a
u

instance NFData a => NFData (Block a)

instance NFData1 Block

instance Ord1 Block where
  liftCompare :: forall a b. (a -> b -> Ordering) -> Block a -> Block b -> Ordering
liftCompare a -> b -> Ordering
cmp ~(Block Row a
ua Row a
la) ~(Block Row b
ub Row b
lb) = Row a -> Row b -> Ordering
cmp' Row a
ua Row b
ub forall a. Semigroup a => a -> a -> a
<> Row a -> Row b -> Ordering
cmp' Row a
la Row b
lb
    where cmp' :: Row a -> Row b -> Ordering
cmp' = forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp

instance Applicative Row where
    pure :: forall a. a -> Row a
pure a
x = forall a. a -> a -> Row a
Row a
x a
x
    Row a -> b
fl a -> b
fr <*> :: forall a b. Row (a -> b) -> Row a -> Row b
<*> Row a
l a
r = forall a. a -> a -> Row a
Row (a -> b
fl a
l) (a -> b
fr a
r)

instance Applicative Block where
    pure :: forall a. a -> Block a
pure a
x = forall a. Row a -> Row a -> Block a
Block Row a
px Row a
px
      where px :: Row a
px = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
    Block Row (a -> b)
fu Row (a -> b)
fl <*> :: forall a b. Block (a -> b) -> Block a -> Block b
<*> Block Row a
u Row a
l = forall a. Row a -> Row a -> Block a
Block (Row (a -> b)
fu forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Row a
u) (Row (a -> b)
fl forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Row a
l)

instance Arbitrary a => Arbitrary (Row a) where
    arbitrary :: Gen (Row a)
arbitrary = forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => Gen (f a)
arbitrary1

instance Arbitrary1 Row where
    liftArbitrary :: forall a. Gen a -> Gen (Row a)
liftArbitrary Gen a
arb = forall a. a -> a -> Row a
Row forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
arb forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
arb

instance Arbitrary a => Arbitrary (Block a) where
    arbitrary :: Gen (Block a)
arbitrary = forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => Gen (f a)
arbitrary1

instance Arbitrary1 Block where
    liftArbitrary :: forall a. Gen a -> Gen (Block a)
liftArbitrary Gen a
arb = forall a. Row a -> Row a -> Block a
Block forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Row a)
arb' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Row a)
arb'
        where arb' :: Gen (Row a)
arb' = forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary Gen a
arb

-- | Convert the given 'Char'acter to a 'Block' of 'Bool's wrapped in a 'Just'
-- if it exists; 'Nothing' otherwise.
fromBlock
  :: Char  -- ^ The given 'Char'acter to convert to a 'Block' of 'Bool's.
  -> Maybe (Block Bool)  -- The equivalent 'Block' of 'Bool's wrapped in a 'Just' if such block exists; 'Nothing' otherwise.
fromBlock :: Char -> Maybe (Block Bool)
fromBlock Char
EmptyBlock = forall a. a -> Maybe a
Just (forall a. Row a -> Row a -> Block a
Block (forall a. a -> a -> Row a
Row Bool
False Bool
False) (forall a. a -> a -> Row a
Row Bool
False Bool
False))
fromBlock Char
'\x2580' = forall a. a -> Maybe a
Just (forall a. Row a -> Row a -> Block a
Block (forall a. a -> a -> Row a
Row Bool
True  Bool
True ) (forall a. a -> a -> Row a
Row Bool
False Bool
False))
fromBlock Char
'\x2584' = forall a. a -> Maybe a
Just (forall a. Row a -> Row a -> Block a
Block (forall a. a -> a -> Row a
Row Bool
False Bool
False) (forall a. a -> a -> Row a
Row Bool
True  Bool
True ))
fromBlock Char
FullBlock = forall a. a -> Maybe a
Just (forall a. Row a -> Row a -> Block a
Block (forall a. a -> a -> Row a
Row Bool
True  Bool
True ) (forall a. a -> a -> Row a
Row Bool
True  Bool
True ))
fromBlock Char
LeftHalfBlock = forall a. a -> Maybe a
Just (forall a. Row a -> Row a -> Block a
Block (forall a. a -> a -> Row a
Row Bool
True  Bool
False) (forall a. a -> a -> Row a
Row Bool
True  Bool
False))
fromBlock Char
RightHalfBlock = forall a. a -> Maybe a
Just (forall a. Row a -> Row a -> Block a
Block (forall a. a -> a -> Row a
Row Bool
False Bool
True ) (forall a. a -> a -> Row a
Row Bool
False Bool
True ))
fromBlock Char
'\x2596' = forall a. a -> Maybe a
Just (forall a. Row a -> Row a -> Block a
Block (forall a. a -> a -> Row a
Row Bool
False Bool
False) (forall a. a -> a -> Row a
Row Bool
True  Bool
False))
fromBlock Char
'\x2597' = forall a. a -> Maybe a
Just (forall a. Row a -> Row a -> Block a
Block (forall a. a -> a -> Row a
Row Bool
False Bool
False) (forall a. a -> a -> Row a
Row Bool
False Bool
True ))
fromBlock Char
'\x2598' = forall a. a -> Maybe a
Just (forall a. Row a -> Row a -> Block a
Block (forall a. a -> a -> Row a
Row Bool
True  Bool
False) (forall a. a -> a -> Row a
Row Bool
False Bool
False))
fromBlock Char
'\x2599' = forall a. a -> Maybe a
Just (forall a. Row a -> Row a -> Block a
Block (forall a. a -> a -> Row a
Row Bool
True  Bool
False) (forall a. a -> a -> Row a
Row Bool
True  Bool
True ))
fromBlock Char
'\x259a' = forall a. a -> Maybe a
Just (forall a. Row a -> Row a -> Block a
Block (forall a. a -> a -> Row a
Row Bool
True  Bool
False) (forall a. a -> a -> Row a
Row Bool
False Bool
True ))
fromBlock Char
'\x259b' = forall a. a -> Maybe a
Just (forall a. Row a -> Row a -> Block a
Block (forall a. a -> a -> Row a
Row Bool
True  Bool
True ) (forall a. a -> a -> Row a
Row Bool
True  Bool
False))
fromBlock Char
'\x259c' = forall a. a -> Maybe a
Just (forall a. Row a -> Row a -> Block a
Block (forall a. a -> a -> Row a
Row Bool
True  Bool
True ) (forall a. a -> a -> Row a
Row Bool
False Bool
True ))
fromBlock Char
'\x259d' = forall a. a -> Maybe a
Just (forall a. Row a -> Row a -> Block a
Block (forall a. a -> a -> Row a
Row Bool
False Bool
True ) (forall a. a -> a -> Row a
Row Bool
False Bool
False))
fromBlock Char
'\x259e' = forall a. a -> Maybe a
Just (forall a. Row a -> Row a -> Block a
Block (forall a. a -> a -> Row a
Row Bool
False Bool
True ) (forall a. a -> a -> Row a
Row Bool
True  Bool
False))
fromBlock Char
'\x259f' = forall a. a -> Maybe a
Just (forall a. Row a -> Row a -> Block a
Block (forall a. a -> a -> Row a
Row Bool
False Bool
True ) (forall a. a -> a -> Row a
Row Bool
True  Bool
True ))
fromBlock Char
_ = forall a. Maybe a
Nothing

-- | Convert the given 'Char'acter to a 'Block' of 'Bool's if it exists; unspecified result otherwise.
fromBlock'
  :: Char  -- ^ The given 'Char'acter to convert to a 'Block' of 'Bool's.
  -> Block Bool  -- ^ The equivalent 'Block' of 'Bool's.
fromBlock' :: Char -> Block Bool
fromBlock' = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe (Block Bool)
fromBlock

-- | Convert the given 'Block' value to a block character in unicode.
-- 'True' means that part is filled, and 'False' means the part is not filled.
filled
    :: Block Bool  -- ^ The given 'Block' of 'Bool's to convert to a 'Char'acter.
    -> Char  -- ^ The equivalent Unicode 'Char'acter for the given 'Block' of 'Bool's.
filled :: Block Bool -> Char
filled (Block (Row Bool
False Bool
False) (Row Bool
False Bool
False)) = Char
EmptyBlock
filled (Block (Row Bool
True  Bool
True ) (Row Bool
False Bool
False)) = Char
'\x2580'
filled (Block (Row Bool
False Bool
False) (Row Bool
True  Bool
True )) = Char
'\x2584'
filled (Block (Row Bool
True  Bool
True ) (Row Bool
True  Bool
True )) = Char
FullBlock
filled (Block (Row Bool
True  Bool
False) (Row Bool
True  Bool
False)) = Char
LeftHalfBlock
filled (Block (Row Bool
False Bool
True ) (Row Bool
False Bool
True )) = Char
RightHalfBlock
filled (Block (Row Bool
False Bool
False) (Row Bool
True  Bool
False)) = Char
'\x2596'
filled (Block (Row Bool
False Bool
False) (Row Bool
False Bool
True )) = Char
'\x2597'
filled (Block (Row Bool
True  Bool
False) (Row Bool
False Bool
False)) = Char
'\x2598'
filled (Block (Row Bool
True  Bool
False) (Row Bool
True  Bool
True )) = Char
'\x2599'
filled (Block (Row Bool
True  Bool
False) (Row Bool
False Bool
True )) = Char
'\x259a'
filled (Block (Row Bool
True  Bool
True ) (Row Bool
True  Bool
False)) = Char
'\x259b'
filled (Block (Row Bool
True  Bool
True ) (Row Bool
False Bool
True )) = Char
'\x259c'
filled (Block (Row Bool
False Bool
True ) (Row Bool
False Bool
False)) = Char
'\x259d'
filled (Block (Row Bool
False Bool
True ) (Row Bool
True  Bool
False)) = Char
'\x259e'
filled (Block (Row Bool
False Bool
True ) (Row Bool
True  Bool
True )) = Char
'\x259f'

instance UnicodeCharacter (Block Bool) where
    toUnicodeChar :: Block Bool -> Char
toUnicodeChar = Block Bool -> Char
filled
    fromUnicodeChar :: Char -> Maybe (Block Bool)
fromUnicodeChar = Char -> Maybe (Block Bool)
fromBlock
    isInCharRange :: Char -> Bool
isInCharRange Char
c = (Char
'\x2596' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x259f') Bool -> Bool -> Bool
|| Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
" \x2588\x258c\x2590"

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