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

-- |
-- Module      : Data.Char.Block.Sextant
-- Description : A module used to render blocks divided in three horizontal rows in unicode.
-- Maintainer  : hapytexeu+gh@gmail.com
-- Stability   : experimental
-- Portability : POSIX
--
-- Unicode has 3-by-2 blocks, this module aims to make it more convenient to render such blocks.
module Data.Char.Block.Sextant
  ( -- * Datastructures to store the state of the sextant.
    Sextant (Sextant, upper, middle, lower),
    isSextant,

    -- * A unicode character that is (partially) filled sextant.
    filled,

    -- * Convert a 'Char'acter to a (partially) filled sextant.
    fromSextant,
    fromSextant',
  )
where

import Control.DeepSeq (NFData, NFData1)
import Data.Bits (shiftL, shiftR, (.&.), (.|.))
import Data.Char (chr, ord)
import Data.Char.Block (Row, rowValue, toRow', pattern EmptyBlock, pattern EmptyRow, pattern FullBlock, pattern FullRow, pattern LeftHalfBlock, pattern LeftRow, pattern RightHalfBlock, pattern RightRow)
import Data.Char.Core (MirrorHorizontal (mirrorHorizontal), MirrorVertical (mirrorVertical), UnicodeCharacter (fromUnicodeChar, 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)
#if __GLASGOW_HASKELL__ < 803
import Data.Semigroup((<>))
#endif

import GHC.Generics (Generic, Generic1)
import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary), Arbitrary1 (liftArbitrary), arbitrary1)

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

instance Eq1 Sextant where
  liftEq :: forall a b. (a -> b -> Bool) -> Sextant a -> Sextant b -> Bool
liftEq a -> b -> Bool
cmp ~(Sextant Row a
ua Row a
ma Row a
la) ~(Sextant Row b
ub Row b
mb 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
ma Row b
mb 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 (Sextant a)

instance Hashable1 Sextant

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

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

instance NFData a => NFData (Sextant a)

instance NFData1 Sextant

instance Ord1 Sextant where
  liftCompare :: forall a b.
(a -> b -> Ordering) -> Sextant a -> Sextant b -> Ordering
liftCompare a -> b -> Ordering
cmp ~(Sextant Row a
ua Row a
ma Row a
la) ~(Sextant Row b
ub Row b
mb 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
ma Row b
mb 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 Sextant where
  pure :: forall a. a -> Sextant a
pure a
x = forall a. Row a -> Row a -> Row a -> Sextant a
Sextant Row a
px Row a
px Row a
px
    where
      px :: Row a
px = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
  Sextant Row (a -> b)
fu Row (a -> b)
fm Row (a -> b)
fl <*> :: forall a b. Sextant (a -> b) -> Sextant a -> Sextant b
<*> Sextant Row a
u Row a
m Row a
l = forall a. Row a -> Row a -> Row a -> Sextant a
Sextant (Row (a -> b)
fu forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Row a
u) (Row (a -> b)
fm forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Row a
m) (Row (a -> b)
fl forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Row a
l)

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

instance Arbitrary1 Sextant where
  liftArbitrary :: forall a. Gen a -> Gen (Sextant a)
liftArbitrary Gen a
arb = forall a. Row a -> Row a -> Row a -> Sextant a
Sextant 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' 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

instance UnicodeCharacter (Sextant Bool) where
  toUnicodeChar :: Sextant Bool -> Char
toUnicodeChar = Sextant Bool -> Char
filled
  fromUnicodeChar :: Char -> Maybe (Sextant Bool)
fromUnicodeChar = Char -> Maybe (Sextant Bool)
fromSextant
  fromUnicodeChar' :: Char -> Sextant Bool
fromUnicodeChar' = Char -> Sextant Bool
fromSextant'
  isInCharRange :: Char -> Bool
isInCharRange = Char -> Bool
isSextant

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

-- | Check if the given 'Char'acter is a 'Char'acter that maps on a 'Sextant' value.
isSextant ::
  -- | The given 'Char'acter to test.
  Char ->
  -- | 'True' if the given 'Char'acter is a /sextant/ 'Char'acter; otherwise 'False'.
  Bool
isSextant :: Char -> Bool
isSextant Char
ci = Bool
c1 Bool -> Bool -> Bool
|| Bool
c2
  where
    c1 :: Bool
c1 = Char
'\x1FB00' forall a. Ord a => a -> a -> Bool
<= Char
ci Bool -> Bool -> Bool
&& Char
ci forall a. Ord a => a -> a -> Bool
<= Char
'\x1fb3b'
    c2 :: Bool
c2 = Char
ci forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
EmptyBlock, Char
LeftHalfBlock, Char
RightHalfBlock, Char
FullBlock]

-- | Convert the given 'Char' to the corresponding 'Sextant' object wrapped
-- in a 'Just' data constructor. If the given 'Char' is not a sextant character,
-- 'Nothing' is returned.
fromSextant ::
  -- | The 'Char' we wish to convert to a 'Sextant' object.
  Char ->
  -- | The corresponding 'Sextant' object wrapped in a 'Just'; 'Nothing' if the given 'Char' is not a sextant character.
  Maybe (Sextant Bool)
fromSextant :: Char -> Maybe (Sextant Bool)
fromSextant Char
ci
  | Char -> Bool
isSextant Char
ci = forall a. a -> Maybe a
Just (Char -> Sextant Bool
fromSextant' Char
ci)
  | Bool
otherwise = forall a. Maybe a
Nothing

-- | Convert the given 'Char' to the corresponding 'Sextant' object wrapped
-- If the given 'Char' is not a sextant character, it is unspecified what
-- will happen.
fromSextant' ::
  -- | The 'Char' we wish to convert to a 'Sextant' object.
  Char ->
  -- | The corresponding 'Sextant'; unspecified behavior if the given 'Char' is not a sextant character.
  Sextant Bool
fromSextant' :: Char -> Sextant Bool
fromSextant' Char
EmptyBlock = forall a. Row a -> Row a -> Row a -> Sextant a
Sextant Row Bool
EmptyRow Row Bool
EmptyRow Row Bool
EmptyRow
fromSextant' Char
LeftHalfBlock = forall a. Row a -> Row a -> Row a -> Sextant a
Sextant Row Bool
LeftRow Row Bool
LeftRow Row Bool
LeftRow
fromSextant' Char
RightHalfBlock = forall a. Row a -> Row a -> Row a -> Sextant a
Sextant Row Bool
RightRow Row Bool
RightRow Row Bool
RightRow
fromSextant' Char
FullBlock = forall a. Row a -> Row a -> Row a -> Sextant a
Sextant Row Bool
FullRow Row Bool
FullRow Row Bool
FullRow
fromSextant' Char
ch = forall a. Row a -> Row a -> Row a -> Sextant a
Sextant Row Bool
u Row Bool
m Row Bool
l
  where
    ci :: Int
ci = Char -> Int
ord Char
ch forall a. Bits a => a -> a -> a
.&. Int
0x3f
    ch' :: Int
ch'
      | Int
ci forall a. Ord a => a -> a -> Bool
>= Int
0x28 = Int
ci forall a. Num a => a -> a -> a
+ Int
3
      | Int
ci forall a. Ord a => a -> a -> Bool
> Int
0x13 = Int
ci forall a. Num a => a -> a -> a
+ Int
2
      | Bool
otherwise = Int
ci forall a. Num a => a -> a -> a
+ Int
1
    u :: Row Bool
u = Int -> Row Bool
toRow' (Int
ch' forall a. Bits a => a -> a -> a
.&. Int
3)
    m :: Row Bool
m = Int -> Row Bool
toRow' (forall a. Bits a => a -> Int -> a
shiftR Int
ch' Int
2 forall a. Bits a => a -> a -> a
.&. Int
3)
    l :: Row Bool
l = Int -> Row Bool
toRow' (forall a. Bits a => a -> Int -> a
shiftR Int
ch' Int
4)

-- | Convert the given 'Sextant' of 'Bool's to a 'Char' where raster items of the 'Sextant'
-- are written in black, and the rest in white.
filled ::
  -- | The given 'Sextant' of 'Bool's to convert to a 'Char'.
  Sextant Bool ->
  -- | The corresponding 'Char'acter that presents the sextant.
  Char
filled :: Sextant Bool -> Char
filled (Sextant Row Bool
u Row Bool
m Row Bool
d) = Int -> Char
go (forall a. Bits a => a -> Int -> a
shiftL (Row Bool -> Int
rowValue Row Bool
d) Int
4 forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (Row Bool -> Int
rowValue Row Bool
m) Int
2 forall a. Bits a => a -> a -> a
.|. Row Bool -> Int
rowValue Row Bool
u)
  where
    go :: Int -> Char
go Int
0x00 = Char
EmptyBlock
    go Int
0x15 = Char
LeftHalfBlock
    go Int
0x2a = Char
RightHalfBlock
    go Int
0x3f = Char
FullBlock
    go Int
i
      | Int
i forall a. Ord a => a -> a -> Bool
>= Int
0x2a = Int -> Char
chr (Int
0x1fb00 forall a. Bits a => a -> a -> a
.|. (Int
i forall a. Num a => a -> a -> a
- Int
0x03))
      | Int
i forall a. Ord a => a -> a -> Bool
>= Int
0x15 = Int -> Char
chr (Int
0x1fb00 forall a. Bits a => a -> a -> a
.|. (Int
i forall a. Num a => a -> a -> a
- Int
0x02))
      | Bool
otherwise = Int -> Char
chr (Int
0x1fb00 forall a. Bits a => a -> a -> a
.|. (Int
i forall a. Num a => a -> a -> a
- Int
0x01))