{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE 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 (fromUnicodeChar, isInCharRange, toUnicodeChar), 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 $mFullBlock :: forall {r}. Char -> ((# #) -> r) -> ((# #) -> r) -> r
$bFullBlock :: Char
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 $mEmptyBlock :: forall {r}. Char -> ((# #) -> r) -> ((# #) -> r) -> r
$bEmptyBlock :: Char
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 $mLeftHalfBlock :: forall {r}. Char -> ((# #) -> r) -> ((# #) -> r) -> r
$bLeftHalfBlock :: Char
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 $mRightHalfBlock :: forall {r}. Char -> ((# #) -> r) -> ((# #) -> r) -> r
$bRightHalfBlock :: Char
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
  { -- | The left part of a row of the block.
    forall a. Row a -> a
left :: a,
    -- | The right part of the row of the block.
    forall a. Row a -> a
right :: a
  }
  deriving (Row a
Row a -> Row a -> Bounded (Row a)
forall a. a -> a -> Bounded a
forall a. Bounded a => Row a
$cminBound :: forall a. Bounded a => Row a
minBound :: Row a
$cmaxBound :: forall a. Bounded a => Row a
maxBound :: Row a
Bounded, Typeable (Row a)
Typeable (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 (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Row a))
-> (Row a -> Constr)
-> (Row a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Row a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Row a)))
-> ((forall b. Data b => b -> b) -> Row a -> Row a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Row a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Row a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Row a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Row a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Row a -> m (Row a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Row a -> m (Row a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Row a -> m (Row a))
-> Data (Row a)
Row a -> Constr
Row a -> DataType
(forall b. Data b => b -> b) -> Row a -> Row a
forall {a}. Data a => Typeable (Row a)
forall a. Data a => Row a -> Constr
forall a. Data a => Row a -> DataType
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 u. Int -> (forall d. Data d => d -> u) -> Row a -> u
forall u. (forall d. Data d => d -> u) -> Row a -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Row a -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Row a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Row a -> m (Row a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Row a -> m (Row 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))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (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)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Row a -> 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)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Row a)
$ctoConstr :: forall a. Data a => Row a -> Constr
toConstr :: Row a -> Constr
$cdataTypeOf :: forall a. Data a => Row a -> DataType
dataTypeOf :: Row a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Row a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> 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))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Row a))
$cgmapT :: forall a. Data a => (forall b. Data b => b -> b) -> Row a -> Row a
gmapT :: (forall b. Data b => b -> b) -> Row a -> Row a
$cgmapQl :: 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
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Row a -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Row a -> r
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> Row a -> [u]
gmapQ :: forall u. (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
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Row a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad 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)
$cgmapMp :: 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)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Row a -> m (Row a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Row a -> m (Row a)
Data, Row a -> Row a -> Bool
(Row a -> Row a -> Bool) -> (Row a -> Row a -> Bool) -> Eq (Row a)
forall a. Eq a => Row a -> Row a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: Row a -> Row a -> Bool
Eq, (forall m. Monoid m => Row m -> m)
-> (forall m a. Monoid m => (a -> m) -> Row a -> m)
-> (forall m a. Monoid m => (a -> m) -> Row a -> m)
-> (forall a b. (a -> b -> b) -> b -> Row a -> b)
-> (forall a b. (a -> b -> b) -> b -> Row a -> b)
-> (forall b a. (b -> a -> b) -> b -> Row a -> b)
-> (forall b a. (b -> a -> b) -> b -> Row a -> b)
-> (forall a. (a -> a -> a) -> Row a -> a)
-> (forall a. (a -> a -> a) -> Row a -> a)
-> (forall a. Row a -> [a])
-> (forall a. Row a -> Bool)
-> (forall a. Row a -> Int)
-> (forall a. Eq a => a -> Row a -> Bool)
-> (forall a. Ord a => Row a -> a)
-> (forall a. Ord a => Row a -> a)
-> (forall a. Num a => Row a -> a)
-> (forall a. Num a => Row a -> a)
-> Foldable Row
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
$cfold :: forall m. Monoid m => Row m -> m
fold :: forall m. Monoid m => Row m -> 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
foldMap' :: forall m a. Monoid m => (a -> m) -> Row a -> m
$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
foldr' :: forall a b. (a -> b -> 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
foldl' :: forall b a. (b -> a -> b) -> b -> Row a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Row a -> a
foldr1 :: forall a. (a -> a -> a) -> Row a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Row a -> a
foldl1 :: forall a. (a -> a -> a) -> Row a -> a
$ctoList :: forall a. Row a -> [a]
toList :: forall a. Row a -> [a]
$cnull :: forall a. Row a -> Bool
null :: forall a. Row a -> Bool
$clength :: forall a. Row a -> Int
length :: forall a. Row a -> Int
$celem :: forall a. Eq a => a -> Row a -> Bool
elem :: forall a. Eq a => a -> Row a -> Bool
$cmaximum :: forall a. Ord a => Row a -> a
maximum :: forall a. Ord a => Row a -> a
$cminimum :: forall a. Ord a => Row a -> a
minimum :: forall a. Ord a => Row a -> a
$csum :: forall a. Num a => Row a -> a
sum :: forall a. Num a => Row a -> a
$cproduct :: forall a. Num a => Row a -> a
product :: forall a. Num a => Row a -> a
Foldable, (forall a b. (a -> b) -> Row a -> Row b)
-> (forall a b. a -> Row b -> Row a) -> Functor Row
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
$cfmap :: forall a b. (a -> b) -> Row a -> Row b
fmap :: forall a b. (a -> b) -> Row a -> Row b
$c<$ :: forall a b. a -> Row b -> Row a
<$ :: forall a b. a -> Row b -> Row a
Functor, (forall x. Row a -> Rep (Row a) x)
-> (forall x. Rep (Row a) x -> Row a) -> Generic (Row a)
forall x. Rep (Row a) x -> Row a
forall x. Row a -> Rep (Row a) x
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
$cfrom :: forall a x. Row a -> Rep (Row a) x
from :: forall x. Row a -> Rep (Row a) x
$cto :: forall a x. Rep (Row a) x -> Row a
to :: forall x. Rep (Row a) x -> Row a
Generic, (forall a. Row a -> Rep1 Row a)
-> (forall a. Rep1 Row a -> Row a) -> Generic1 Row
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
$cfrom1 :: forall a. Row a -> Rep1 Row a
from1 :: forall a. Row a -> Rep1 Row a
$cto1 :: forall a. Rep1 Row a -> Row a
to1 :: forall a. Rep1 Row a -> Row a
Generic1, Eq (Row a)
Eq (Row a)
-> (Row a -> Row a -> Ordering)
-> (Row a -> Row a -> Bool)
-> (Row a -> Row a -> Bool)
-> (Row a -> Row a -> Bool)
-> (Row a -> Row a -> Bool)
-> (Row a -> Row a -> Row a)
-> (Row a -> Row a -> Row a)
-> Ord (Row a)
Row a -> Row a -> Bool
Row a -> Row a -> Ordering
Row a -> Row a -> Row 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}. 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
$ccompare :: forall a. Ord a => Row a -> Row a -> Ordering
compare :: Row a -> Row a -> Ordering
$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
>= :: Row a -> Row a -> Bool
$cmax :: forall a. Ord a => Row a -> Row a -> Row a
max :: Row a -> Row a -> Row a
$cmin :: forall a. Ord a => Row a -> Row a -> Row a
min :: Row a -> Row a -> Row a
Ord, ReadPrec [Row a]
ReadPrec (Row a)
Int -> ReadS (Row a)
ReadS [Row a]
(Int -> ReadS (Row a))
-> ReadS [Row a]
-> ReadPrec (Row a)
-> ReadPrec [Row a]
-> Read (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
$creadsPrec :: forall a. Read a => Int -> ReadS (Row a)
readsPrec :: Int -> ReadS (Row a)
$creadList :: forall a. Read a => ReadS [Row a]
readList :: ReadS [Row a]
$creadPrec :: forall a. Read a => ReadPrec (Row a)
readPrec :: ReadPrec (Row a)
$creadListPrec :: forall a. Read a => ReadPrec [Row a]
readListPrec :: ReadPrec [Row a]
Read, Int -> Row a -> ShowS
[Row a] -> ShowS
Row a -> String
(Int -> Row a -> ShowS)
-> (Row a -> String) -> ([Row a] -> ShowS) -> Show (Row a)
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
$cshowsPrec :: forall a. Show a => Int -> Row a -> ShowS
showsPrec :: Int -> Row a -> ShowS
$cshow :: forall a. Show a => Row a -> String
show :: Row a -> String
$cshowList :: forall a. Show a => [Row a] -> ShowS
showList :: [Row a] -> ShowS
Show, Functor Row
Foldable Row
Functor Row
-> Foldable Row
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Row a -> f (Row b))
-> (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 (m :: * -> *) a. Monad m => Row (m a) -> m (Row a))
-> Traversable 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)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Row a -> f (Row b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Row a -> f (Row b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Row (f a) -> f (Row a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Row (f a) -> f (Row a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Row a -> m (Row b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Row a -> m (Row b)
$csequence :: forall (m :: * -> *) a. Monad m => Row (m a) -> m (Row a)
sequence :: forall (m :: * -> *) a. Monad m => Row (m a) -> m (Row a)
Traversable)

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

-- | A pattern synonym for a 'Row' where both the left and right subpart are 'False'.
pattern EmptyRow :: Row Bool
pattern $mEmptyRow :: forall {r}. Row Bool -> ((# #) -> r) -> ((# #) -> r) -> r
$bEmptyRow :: Row Bool
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 $mLeftRow :: forall {r}. Row Bool -> ((# #) -> r) -> ((# #) -> r) -> r
$bLeftRow :: Row Bool
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 $mRightRow :: forall {r}. Row Bool -> ((# #) -> r) -> ((# #) -> r) -> r
$bRightRow :: Row Bool
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 ::
  -- | The given 'Row' of 'Bool's to convert.
  Row Bool ->
  -- | The corresponding numerical value.
  Int
rowValue :: Row Bool -> Int
rowValue ~(Row Bool
l Bool
r) = Int -> Bool -> Int
b0 Int
1 Bool
l Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int -> Bool -> Int
b0 Int
2 Bool
r
  where
    b0 :: Int -> Bool -> Int
b0 = Int -> Int -> Bool -> Int
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' ::
  -- | The given number to convert.
  Int ->
  -- | The corresponding 'Row' of 'Bool's.
  Row Bool
toRow' :: Int -> Row Bool
toRow' Int
i = Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row (Int -> Bool
forall a. Integral a => a -> Bool
odd Int
i) (Int
i Int -> Int -> Bool
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 ::
  -- | The given number to convert.
  Int ->
  -- | The corresponding 'Row' of 'Bool's.
  Maybe (Row Bool)
toRow :: Int -> Maybe (Row Bool)
toRow Int
i
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x00 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x03 = Row Bool -> Maybe (Row Bool)
forall a. a -> Maybe a
Just (Int -> Row Bool
toRow' Int
i)
  | Bool
otherwise = Maybe (Row Bool)
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) = a -> a -> Row a
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 Ordering -> Ordering -> Ordering
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
  { -- | The upper part of the block.
    forall a. Block a -> Row a
upper :: Row a,
    -- | The lower part of the block.
    forall a. Block a -> Row a
lower :: Row a
  }
  deriving (Block a
Block a -> Block a -> Bounded (Block a)
forall a. a -> a -> Bounded a
forall a. Bounded a => Block a
$cminBound :: forall a. Bounded a => Block a
minBound :: Block a
$cmaxBound :: forall a. Bounded a => Block a
maxBound :: Block a
Bounded, Typeable (Block a)
Typeable (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 (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Block a))
-> (Block a -> Constr)
-> (Block a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Block a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Block a)))
-> ((forall b. Data b => b -> b) -> Block a -> Block a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Block a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Block a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Block a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Block a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Block a -> m (Block a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Block a -> m (Block a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Block a -> m (Block a))
-> Data (Block a)
Block a -> Constr
Block a -> DataType
(forall b. Data b => b -> b) -> Block a -> Block a
forall {a}. Data a => Typeable (Block a)
forall a. Data a => Block a -> Constr
forall a. Data a => Block a -> DataType
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 u. Int -> (forall d. Data d => d -> u) -> Block a -> u
forall u. (forall d. Data d => d -> u) -> Block a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Block a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Block a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Block a -> m (Block a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Block a -> m (Block 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))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (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)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Block a -> 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)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Block a)
$ctoConstr :: forall a. Data a => Block a -> Constr
toConstr :: Block a -> Constr
$cdataTypeOf :: forall a. Data a => Block a -> DataType
dataTypeOf :: Block a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Block a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> 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))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Block a))
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Block a -> Block a
gmapT :: (forall b. Data b => b -> b) -> Block a -> Block a
$cgmapQl :: 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
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Block a -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Block a -> r
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Block a -> [u]
gmapQ :: forall u. (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
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Block a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad 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)
$cgmapMp :: 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)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Block a -> m (Block a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Block a -> m (Block a)
Data, Block a -> Block a -> Bool
(Block a -> Block a -> Bool)
-> (Block a -> Block a -> Bool) -> Eq (Block a)
forall a. Eq a => Block a -> Block a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: Block a -> Block a -> Bool
Eq, (forall m. Monoid m => Block m -> m)
-> (forall m a. Monoid m => (a -> m) -> Block a -> m)
-> (forall m a. Monoid m => (a -> m) -> Block a -> m)
-> (forall a b. (a -> b -> b) -> b -> Block a -> b)
-> (forall a b. (a -> b -> b) -> b -> Block a -> b)
-> (forall b a. (b -> a -> b) -> b -> Block a -> b)
-> (forall b a. (b -> a -> b) -> b -> Block a -> b)
-> (forall a. (a -> a -> a) -> Block a -> a)
-> (forall a. (a -> a -> a) -> Block a -> a)
-> (forall a. Block a -> [a])
-> (forall a. Block a -> Bool)
-> (forall a. Block a -> Int)
-> (forall a. Eq a => a -> Block a -> Bool)
-> (forall a. Ord a => Block a -> a)
-> (forall a. Ord a => Block a -> a)
-> (forall a. Num a => Block a -> a)
-> (forall a. Num a => Block a -> a)
-> Foldable Block
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
$cfold :: forall m. Monoid m => Block m -> m
fold :: forall m. Monoid m => Block m -> 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
foldMap' :: forall m a. Monoid m => (a -> m) -> Block a -> m
$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
foldr' :: forall a b. (a -> b -> 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
foldl' :: forall b a. (b -> a -> b) -> b -> Block a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Block a -> a
foldr1 :: forall a. (a -> a -> a) -> Block a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Block a -> a
foldl1 :: forall a. (a -> a -> a) -> Block a -> a
$ctoList :: forall a. Block a -> [a]
toList :: forall a. Block a -> [a]
$cnull :: forall a. Block a -> Bool
null :: forall a. Block a -> Bool
$clength :: forall a. Block a -> Int
length :: forall a. Block a -> Int
$celem :: forall a. Eq a => a -> Block a -> Bool
elem :: forall a. Eq a => a -> Block a -> Bool
$cmaximum :: forall a. Ord a => Block a -> a
maximum :: forall a. Ord a => Block a -> a
$cminimum :: forall a. Ord a => Block a -> a
minimum :: forall a. Ord a => Block a -> a
$csum :: forall a. Num a => Block a -> a
sum :: forall a. Num a => Block a -> a
$cproduct :: forall a. Num a => Block a -> a
product :: forall a. Num a => Block a -> a
Foldable, (forall a b. (a -> b) -> Block a -> Block b)
-> (forall a b. a -> Block b -> Block a) -> Functor Block
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
$cfmap :: forall a b. (a -> b) -> Block a -> Block b
fmap :: forall a b. (a -> b) -> Block a -> Block b
$c<$ :: forall a b. a -> Block b -> Block a
<$ :: forall a b. a -> Block b -> Block a
Functor, (forall x. Block a -> Rep (Block a) x)
-> (forall x. Rep (Block a) x -> Block a) -> Generic (Block a)
forall x. Rep (Block a) x -> Block a
forall x. Block a -> Rep (Block a) x
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
$cfrom :: forall a x. Block a -> Rep (Block a) x
from :: forall x. Block a -> Rep (Block a) x
$cto :: forall a x. Rep (Block a) x -> Block a
to :: forall x. Rep (Block a) x -> Block a
Generic, (forall a. Block a -> Rep1 Block a)
-> (forall a. Rep1 Block a -> Block a) -> Generic1 Block
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
$cfrom1 :: forall a. Block a -> Rep1 Block a
from1 :: forall a. Block a -> Rep1 Block a
$cto1 :: forall a. Rep1 Block a -> Block a
to1 :: forall a. Rep1 Block a -> Block a
Generic1, Eq (Block a)
Eq (Block a)
-> (Block a -> Block a -> Ordering)
-> (Block a -> Block a -> Bool)
-> (Block a -> Block a -> Bool)
-> (Block a -> Block a -> Bool)
-> (Block a -> Block a -> Bool)
-> (Block a -> Block a -> Block a)
-> (Block a -> Block a -> Block a)
-> Ord (Block a)
Block a -> Block a -> Bool
Block a -> Block a -> Ordering
Block a -> Block a -> Block 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}. 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
$ccompare :: forall a. Ord a => Block a -> Block a -> Ordering
compare :: Block a -> Block a -> Ordering
$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
>= :: Block a -> Block a -> Bool
$cmax :: forall a. Ord a => Block a -> Block a -> Block a
max :: Block a -> Block a -> Block a
$cmin :: forall a. Ord a => Block a -> Block a -> Block a
min :: Block a -> Block a -> Block a
Ord, ReadPrec [Block a]
ReadPrec (Block a)
Int -> ReadS (Block a)
ReadS [Block a]
(Int -> ReadS (Block a))
-> ReadS [Block a]
-> ReadPrec (Block a)
-> ReadPrec [Block a]
-> Read (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
$creadsPrec :: forall a. Read a => Int -> ReadS (Block a)
readsPrec :: Int -> ReadS (Block a)
$creadList :: forall a. Read a => ReadS [Block a]
readList :: ReadS [Block a]
$creadPrec :: forall a. Read a => ReadPrec (Block a)
readPrec :: ReadPrec (Block a)
$creadListPrec :: forall a. Read a => ReadPrec [Block a]
readListPrec :: ReadPrec [Block a]
Read, Int -> Block a -> ShowS
[Block a] -> ShowS
Block a -> String
(Int -> Block a -> ShowS)
-> (Block a -> String) -> ([Block a] -> ShowS) -> Show (Block a)
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
$cshowsPrec :: forall a. Show a => Int -> Block a -> ShowS
showsPrec :: Int -> Block a -> ShowS
$cshow :: forall a. Show a => Block a -> String
show :: Block a -> String
$cshowList :: forall a. Show a => [Block a] -> ShowS
showList :: [Block a] -> ShowS
Show, Functor Block
Foldable Block
Functor Block
-> Foldable Block
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Block a -> f (Block b))
-> (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 (m :: * -> *) a. Monad m => Block (m a) -> m (Block a))
-> Traversable 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)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Block a -> f (Block b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Block a -> f (Block b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Block (f a) -> f (Block a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Block (f a) -> f (Block a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Block a -> m (Block b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Block a -> m (Block b)
$csequence :: forall (m :: * -> *) a. Monad m => Block (m a) -> m (Block a)
sequence :: forall (m :: * -> *) a. Monad m => Block (m a) -> m (Block a)
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' = (a -> b -> Bool) -> Row a -> Row b -> Bool
forall a b. (a -> b -> Bool) -> Row a -> Row b -> Bool
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) = Row a -> Row a -> Block a
forall a. Row a -> Row a -> Block a
Block (Row a -> Row a
forall a. MirrorVertical a => a -> a
mirrorVertical Row a
u) (Row a -> Row a
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) = Row a -> Row a -> Block a
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 Ordering -> Ordering -> Ordering
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' = (a -> b -> Ordering) -> Row a -> Row b -> Ordering
forall a b. (a -> b -> Ordering) -> Row a -> Row b -> Ordering
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 = a -> a -> Row a
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 = b -> b -> Row b
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 = Row a -> Row a -> Block a
forall a. Row a -> Row a -> Block a
Block Row a
px Row a
px
    where
      px :: Row a
px = a -> Row a
forall a. a -> Row a
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 = Row b -> Row b -> Block b
forall a. Row a -> Row a -> Block a
Block (Row (a -> b)
fu Row (a -> b) -> Row a -> Row b
forall a b. Row (a -> b) -> Row a -> Row b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Row a
u) (Row (a -> b)
fl Row (a -> b) -> Row a -> Row b
forall a b. Row (a -> b) -> Row a -> Row b
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 = Gen (Row a)
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 = a -> a -> Row a
forall a. a -> a -> Row a
Row (a -> a -> Row a) -> Gen a -> Gen (a -> Row a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
arb Gen (a -> Row a) -> Gen a -> Gen (Row a)
forall a b. Gen (a -> b) -> Gen a -> Gen b
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 = Gen (Block a)
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 = Row a -> Row a -> Block a
forall a. Row a -> Row a -> Block a
Block (Row a -> Row a -> Block a)
-> Gen (Row a) -> Gen (Row a -> Block a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Row a)
arb' Gen (Row a -> Block a) -> Gen (Row a) -> Gen (Block a)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Row a)
arb'
    where
      arb' :: Gen (Row a)
arb' = Gen a -> Gen (Row a)
forall a. Gen a -> Gen (Row a)
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 ::
  -- | The given 'Char'acter to convert to a 'Block' of 'Bool's.
  Char ->
  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 = Block Bool -> Maybe (Block Bool)
forall a. a -> Maybe a
Just (Row Bool -> Row Bool -> Block Bool
forall a. Row a -> Row a -> Block a
Block (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
False Bool
False) (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
False Bool
False))
fromBlock Char
'\x2580' = Block Bool -> Maybe (Block Bool)
forall a. a -> Maybe a
Just (Row Bool -> Row Bool -> Block Bool
forall a. Row a -> Row a -> Block a
Block (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
True Bool
True) (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
False Bool
False))
fromBlock Char
'\x2584' = Block Bool -> Maybe (Block Bool)
forall a. a -> Maybe a
Just (Row Bool -> Row Bool -> Block Bool
forall a. Row a -> Row a -> Block a
Block (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
False Bool
False) (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
True Bool
True))
fromBlock Char
FullBlock = Block Bool -> Maybe (Block Bool)
forall a. a -> Maybe a
Just (Row Bool -> Row Bool -> Block Bool
forall a. Row a -> Row a -> Block a
Block (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
True Bool
True) (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
True Bool
True))
fromBlock Char
LeftHalfBlock = Block Bool -> Maybe (Block Bool)
forall a. a -> Maybe a
Just (Row Bool -> Row Bool -> Block Bool
forall a. Row a -> Row a -> Block a
Block (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
True Bool
False) (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
True Bool
False))
fromBlock Char
RightHalfBlock = Block Bool -> Maybe (Block Bool)
forall a. a -> Maybe a
Just (Row Bool -> Row Bool -> Block Bool
forall a. Row a -> Row a -> Block a
Block (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
False Bool
True) (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
False Bool
True))
fromBlock Char
'\x2596' = Block Bool -> Maybe (Block Bool)
forall a. a -> Maybe a
Just (Row Bool -> Row Bool -> Block Bool
forall a. Row a -> Row a -> Block a
Block (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
False Bool
False) (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
True Bool
False))
fromBlock Char
'\x2597' = Block Bool -> Maybe (Block Bool)
forall a. a -> Maybe a
Just (Row Bool -> Row Bool -> Block Bool
forall a. Row a -> Row a -> Block a
Block (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
False Bool
False) (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
False Bool
True))
fromBlock Char
'\x2598' = Block Bool -> Maybe (Block Bool)
forall a. a -> Maybe a
Just (Row Bool -> Row Bool -> Block Bool
forall a. Row a -> Row a -> Block a
Block (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
True Bool
False) (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
False Bool
False))
fromBlock Char
'\x2599' = Block Bool -> Maybe (Block Bool)
forall a. a -> Maybe a
Just (Row Bool -> Row Bool -> Block Bool
forall a. Row a -> Row a -> Block a
Block (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
True Bool
False) (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
True Bool
True))
fromBlock Char
'\x259a' = Block Bool -> Maybe (Block Bool)
forall a. a -> Maybe a
Just (Row Bool -> Row Bool -> Block Bool
forall a. Row a -> Row a -> Block a
Block (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
True Bool
False) (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
False Bool
True))
fromBlock Char
'\x259b' = Block Bool -> Maybe (Block Bool)
forall a. a -> Maybe a
Just (Row Bool -> Row Bool -> Block Bool
forall a. Row a -> Row a -> Block a
Block (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
True Bool
True) (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
True Bool
False))
fromBlock Char
'\x259c' = Block Bool -> Maybe (Block Bool)
forall a. a -> Maybe a
Just (Row Bool -> Row Bool -> Block Bool
forall a. Row a -> Row a -> Block a
Block (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
True Bool
True) (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
False Bool
True))
fromBlock Char
'\x259d' = Block Bool -> Maybe (Block Bool)
forall a. a -> Maybe a
Just (Row Bool -> Row Bool -> Block Bool
forall a. Row a -> Row a -> Block a
Block (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
False Bool
True) (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
False Bool
False))
fromBlock Char
'\x259e' = Block Bool -> Maybe (Block Bool)
forall a. a -> Maybe a
Just (Row Bool -> Row Bool -> Block Bool
forall a. Row a -> Row a -> Block a
Block (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
False Bool
True) (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
True Bool
False))
fromBlock Char
'\x259f' = Block Bool -> Maybe (Block Bool)
forall a. a -> Maybe a
Just (Row Bool -> Row Bool -> Block Bool
forall a. Row a -> Row a -> Block a
Block (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
False Bool
True) (Bool -> Bool -> Row Bool
forall a. a -> a -> Row a
Row Bool
True Bool
True))
fromBlock Char
_ = Maybe (Block Bool)
forall a. Maybe a
Nothing

-- | Convert the given 'Char'acter to a 'Block' of 'Bool's if it exists; unspecified result otherwise.
fromBlock' ::
  -- | The given 'Char'acter to convert to a 'Block' of 'Bool's.
  Char ->
  -- | The equivalent 'Block' of 'Bool's.
  Block Bool
fromBlock' :: Char -> Block Bool
fromBlock' = Maybe (Block Bool) -> Block Bool
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Block Bool) -> Block Bool)
-> (Char -> Maybe (Block Bool)) -> Char -> Block Bool
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 ::
  -- | The given 'Block' of 'Bool's to convert to a 'Char'acter.
  Block Bool ->
  -- | The equivalent Unicode 'Char'acter for the given 'Block' of 'Bool's.
  Char
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' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x259f') Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
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)