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'