module Data.Char.Block where

import Control.Applicative (Applicative, pure, (<*>), liftA2, )
import Data.Traversable (Traversable, traverse, foldMapDefault, )
import Data.Foldable (Foldable, foldMap, )


data Row a = Row {Row a -> a
left, Row a -> a
right :: a} deriving (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
/= :: 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, 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
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)
data Block a = Block {Block a -> Row a
upper, Block a -> Row a
lower :: Row a} deriving (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
/= :: 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, 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
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)


instance Functor Row where
   fmap :: (a -> b) -> Row a -> Row b
fmap a -> b
f (Row a
a a
b) = b -> b -> Row b
forall a. a -> a -> Row a
Row (a -> b
f a
a) (a -> b
f a
b)

instance Functor Block where
   fmap :: (a -> b) -> Block a -> Block b
fmap a -> b
f (Block Row a
a Row a
b) = Row b -> Row b -> Block b
forall a. Row a -> Row a -> Block a
Block ((a -> b) -> Row a -> Row b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Row a
a) ((a -> b) -> Row a -> Row b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Row a
b)


instance Foldable Row where
   foldMap :: (a -> m) -> Row a -> m
foldMap = (a -> m) -> Row a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault

instance Foldable Block where
   foldMap :: (a -> m) -> Block a -> m
foldMap = (a -> m) -> Block a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault


instance Traversable Row where
   traverse :: (a -> f b) -> Row a -> f (Row b)
traverse a -> f b
f (Row a
a a
b) = (b -> b -> Row b) -> f b -> f b -> f (Row b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> Row b
forall a. a -> a -> Row a
Row (a -> f b
f a
a) (a -> f b
f a
b)

instance Traversable Block where
   traverse :: (a -> f b) -> Block a -> f (Block b)
traverse a -> f b
f (Block Row a
a Row a
b) = (Row b -> Row b -> Block b)
-> f (Row b) -> f (Row b) -> f (Block b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Row b -> Row b -> Block b
forall a. Row a -> Row a -> Block a
Block ((a -> f b) -> Row a -> f (Row b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Row a
a) ((a -> f b) -> Row a -> f (Row b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Row a
b)


instance Applicative Row where
   pure :: a -> Row a
pure a
a = a -> a -> Row a
forall a. a -> a -> Row a
Row a
a a
a
   Row a -> b
fa a -> b
fb <*> :: Row (a -> b) -> Row a -> Row b
<*> Row a
a a
b = b -> b -> Row b
forall a. a -> a -> Row a
Row (a -> b
fa a
a) (a -> b
fb a
b)

instance Applicative Block where
   pure :: a -> Block a
pure a
a = Row a -> Row a -> Block a
forall a. Row a -> Row a -> Block a
Block (a -> Row a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) (a -> Row a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
   Block Row (a -> b)
fa Row (a -> b)
fb <*> :: Block (a -> b) -> Block a -> Block b
<*> Block Row a
a Row a
b =
      Row b -> Row b -> Block b
forall a. Row a -> Row a -> Block a
Block (Row (a -> b)
fa Row (a -> b) -> Row a -> Row b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Row a
a) (Row (a -> b)
fb Row (a -> b) -> Row a -> Row b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Row a
b)


filled :: Block Bool -> Char
filled :: Block Bool -> Char
filled Block Bool
set =
   case Block Bool
set of
      Block (Row Bool
False Bool
False) (Row Bool
False Bool
False) -> Char
' '
      Block (Row Bool
False Bool
False) (Row Bool
False Bool
True) -> Char
'\x2597'
      Block (Row Bool
False Bool
False) (Row Bool
True Bool
False) -> Char
'\x2596'
      Block (Row Bool
False Bool
False) (Row Bool
True Bool
True) -> Char
'\x2584'
      Block (Row Bool
False Bool
True) (Row Bool
False Bool
False) -> Char
'\x259D'
      Block (Row Bool
False Bool
True) (Row Bool
False Bool
True) -> Char
'\x2590'
      Block (Row Bool
False Bool
True) (Row Bool
True Bool
False) -> Char
'\x259E'
      Block (Row Bool
False Bool
True) (Row Bool
True Bool
True) -> Char
'\x259F'
      Block (Row Bool
True Bool
False) (Row Bool
False Bool
False) -> Char
'\x2598'
      Block (Row Bool
True Bool
False) (Row Bool
False Bool
True) -> Char
'\x259A'
      Block (Row Bool
True Bool
False) (Row Bool
True Bool
False) -> Char
'\x258C'
      Block (Row Bool
True Bool
False) (Row Bool
True Bool
True) -> Char
'\x2599'
      Block (Row Bool
True Bool
True) (Row Bool
False Bool
False) -> Char
'\x2580'
      Block (Row Bool
True Bool
True) (Row Bool
False Bool
True) -> Char
'\x259C'
      Block (Row Bool
True Bool
True) (Row Bool
True Bool
False) -> Char
'\x259B'
      Block (Row Bool
True Bool
True) (Row Bool
True Bool
True) -> Char
'\x2588'