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

{-|
Module      : Data.Char.Frame
Description : A module used to render frames with light and heavy lines.
Maintainer  : hapytexeu+gh@gmail.com
Stability   : experimental
Portability : POSIX

A frame is represented as a pair of horizontal and vertical lines. These can be any items, but currently only booleans and weight objects are covered to convert the item to a corresponding character.
-}

module Data.Char.Frame(
    -- * Line weight
    Weight(Empty, Light, Heavy)
    -- * Datastructures to store the four directions
  , Horizontal(Horizontal, left, right)
  , Vertical(Vertical, up, down)
  , Parts(Parts)
    -- * Type aliasses and pattern synonyms for convenient 'Parts'
  , Simple, Weighted
  , pattern Frame
    -- * Functions to render specific frame values
  , simple, simple', simpleWithArc, weighted
    -- * Convert a 'Simple' to a 'Weighted'
  , simpleToWeighted, simpleToLight, simpleToHeavy, weightedToSimple
    -- * Convert a 'Char'acter to a frame
  , fromWeighted, fromWeighted', fromLight, fromLight', fromHeavy, fromHeavy', fromSimple, fromSimple'
  ) where

import Control.DeepSeq(NFData, NFData1)

import Data.Bool(bool)
import Data.Char.Core(MirrorHorizontal(mirrorHorizontal), MirrorVertical(mirrorVertical), UnicodeCharacter(toUnicodeChar, fromUnicodeChar, fromUnicodeChar'), UnicodeText)
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(Semigroup((<>)))
#endif

import GHC.Generics(Generic, Generic1)

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

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

instance Eq1 Horizontal where
  liftEq :: (a -> b -> Bool) -> Horizontal a -> Horizontal b -> Bool
liftEq a -> b -> Bool
cmp ~(Horizontal a
la a
ra) ~(Horizontal b
lb b
rb) = a -> b -> Bool
cmp a
la b
lb Bool -> Bool -> Bool
&& a -> b -> Bool
cmp a
ra b
rb

instance Hashable1 Horizontal

instance Hashable a => Hashable (Horizontal a)

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

instance NFData a => NFData (Horizontal a)

instance NFData1 Horizontal

instance Ord1 Horizontal where
  liftCompare :: (a -> b -> Ordering) -> Horizontal a -> Horizontal b -> Ordering
liftCompare a -> b -> Ordering
cmp ~(Horizontal a
la a
ra) ~(Horizontal b
lb b
rb) = a -> b -> Ordering
cmp a
la b
lb Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> a -> b -> Ordering
cmp a
ra b
rb

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

instance Eq1 Vertical where
  liftEq :: (a -> b -> Bool) -> Vertical a -> Vertical b -> Bool
liftEq a -> b -> Bool
cmp ~(Vertical a
la a
ra) ~(Vertical b
lb b
rb) = a -> b -> Bool
cmp a
la b
lb Bool -> Bool -> Bool
&& a -> b -> Bool
cmp a
ra b
rb

instance Hashable1 Vertical

instance Hashable a => Hashable (Vertical a)

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

instance NFData a => NFData (Vertical a)

instance NFData1 Vertical

instance Ord1 Vertical where
  liftCompare :: (a -> b -> Ordering) -> Vertical a -> Vertical b -> Ordering
liftCompare a -> b -> Ordering
cmp ~(Vertical a
la a
ra) ~(Vertical b
lb b
rb) = a -> b -> Ordering
cmp a
la b
lb Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> a -> b -> Ordering
cmp a
ra b
rb

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

instance Eq1 Parts where
  liftEq :: (a -> b -> Bool) -> Parts a -> Parts b -> Bool
liftEq a -> b -> Bool
cmp ~(Parts Vertical a
la Horizontal a
ra) ~(Parts Vertical b
lb Horizontal b
rb) = (a -> b -> Bool) -> Vertical a -> Vertical b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
cmp Vertical a
la Vertical b
lb Bool -> Bool -> Bool
&& (a -> b -> Bool) -> Horizontal a -> Horizontal b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
cmp Horizontal a
ra Horizontal b
rb

instance Hashable1 Parts

instance Hashable a => Hashable (Parts a)

instance MirrorHorizontal (Parts a) where
  mirrorHorizontal :: Parts a -> Parts a
mirrorHorizontal (Parts Vertical a
v Horizontal a
h) = Vertical a -> Horizontal a -> Parts a
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Vertical a -> Vertical a
forall a. MirrorHorizontal a => a -> a
mirrorHorizontal Vertical a
v) Horizontal a
h

instance MirrorVertical (Parts a) where
  mirrorVertical :: Parts a -> Parts a
mirrorVertical (Parts Vertical a
v Horizontal a
h) = Vertical a -> Horizontal a -> Parts a
forall a. Vertical a -> Horizontal a -> Parts a
Parts Vertical a
v (Horizontal a -> Horizontal a
forall a. MirrorVertical a => a -> a
mirrorVertical Horizontal a
h)

instance NFData a => NFData (Parts a)

instance NFData1 Parts

instance Ord1 Parts where
  liftCompare :: (a -> b -> Ordering) -> Parts a -> Parts b -> Ordering
liftCompare a -> b -> Ordering
cmp ~(Parts Vertical a
la Horizontal a
ra) ~(Parts Vertical b
lb Horizontal b
rb) = (a -> b -> Ordering) -> Vertical a -> Vertical b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp Vertical a
la Vertical b
lb Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (a -> b -> Ordering) -> Horizontal a -> Horizontal b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp Horizontal a
ra Horizontal b
rb

-- | The weights of the frame lines, these can be 'Empty', 'Light' or 'Heavy'.
data Weight
  = Empty  -- ^ The frame does not contain such line.
  | Light  -- ^ The frame contains such line.
  | Heavy  -- ^ The frame contains such line, in /boldface/.
  deriving (Weight
Weight -> Weight -> Bounded Weight
forall a. a -> a -> Bounded a
maxBound :: Weight
$cmaxBound :: Weight
minBound :: Weight
$cminBound :: Weight
Bounded, Typeable Weight
DataType
Constr
Typeable Weight
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Weight -> c Weight)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Weight)
-> (Weight -> Constr)
-> (Weight -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Weight))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Weight))
-> ((forall b. Data b => b -> b) -> Weight -> Weight)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Weight -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Weight -> r)
-> (forall u. (forall d. Data d => d -> u) -> Weight -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Weight -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Weight -> m Weight)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Weight -> m Weight)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Weight -> m Weight)
-> Data Weight
Weight -> DataType
Weight -> Constr
(forall b. Data b => b -> b) -> Weight -> Weight
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Weight -> c Weight
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Weight
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) -> Weight -> u
forall u. (forall d. Data d => d -> u) -> Weight -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Weight -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Weight -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Weight -> m Weight
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Weight -> m Weight
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Weight
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Weight -> c Weight
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Weight)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Weight)
$cHeavy :: Constr
$cLight :: Constr
$cEmpty :: Constr
$tWeight :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Weight -> m Weight
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Weight -> m Weight
gmapMp :: (forall d. Data d => d -> m d) -> Weight -> m Weight
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Weight -> m Weight
gmapM :: (forall d. Data d => d -> m d) -> Weight -> m Weight
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Weight -> m Weight
gmapQi :: Int -> (forall d. Data d => d -> u) -> Weight -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Weight -> u
gmapQ :: (forall d. Data d => d -> u) -> Weight -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Weight -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Weight -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Weight -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Weight -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Weight -> r
gmapT :: (forall b. Data b => b -> b) -> Weight -> Weight
$cgmapT :: (forall b. Data b => b -> b) -> Weight -> Weight
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Weight)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Weight)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Weight)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Weight)
dataTypeOf :: Weight -> DataType
$cdataTypeOf :: Weight -> DataType
toConstr :: Weight -> Constr
$ctoConstr :: Weight -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Weight
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Weight
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Weight -> c Weight
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Weight -> c Weight
$cp1Data :: Typeable Weight
Data, Int -> Weight
Weight -> Int
Weight -> [Weight]
Weight -> Weight
Weight -> Weight -> [Weight]
Weight -> Weight -> Weight -> [Weight]
(Weight -> Weight)
-> (Weight -> Weight)
-> (Int -> Weight)
-> (Weight -> Int)
-> (Weight -> [Weight])
-> (Weight -> Weight -> [Weight])
-> (Weight -> Weight -> [Weight])
-> (Weight -> Weight -> Weight -> [Weight])
-> Enum Weight
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Weight -> Weight -> Weight -> [Weight]
$cenumFromThenTo :: Weight -> Weight -> Weight -> [Weight]
enumFromTo :: Weight -> Weight -> [Weight]
$cenumFromTo :: Weight -> Weight -> [Weight]
enumFromThen :: Weight -> Weight -> [Weight]
$cenumFromThen :: Weight -> Weight -> [Weight]
enumFrom :: Weight -> [Weight]
$cenumFrom :: Weight -> [Weight]
fromEnum :: Weight -> Int
$cfromEnum :: Weight -> Int
toEnum :: Int -> Weight
$ctoEnum :: Int -> Weight
pred :: Weight -> Weight
$cpred :: Weight -> Weight
succ :: Weight -> Weight
$csucc :: Weight -> Weight
Enum, Weight -> Weight -> Bool
(Weight -> Weight -> Bool)
-> (Weight -> Weight -> Bool) -> Eq Weight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Weight -> Weight -> Bool
$c/= :: Weight -> Weight -> Bool
== :: Weight -> Weight -> Bool
$c== :: Weight -> Weight -> Bool
Eq, (forall x. Weight -> Rep Weight x)
-> (forall x. Rep Weight x -> Weight) -> Generic Weight
forall x. Rep Weight x -> Weight
forall x. Weight -> Rep Weight x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Weight x -> Weight
$cfrom :: forall x. Weight -> Rep Weight x
Generic, Eq Weight
Eq Weight
-> (Weight -> Weight -> Ordering)
-> (Weight -> Weight -> Bool)
-> (Weight -> Weight -> Bool)
-> (Weight -> Weight -> Bool)
-> (Weight -> Weight -> Bool)
-> (Weight -> Weight -> Weight)
-> (Weight -> Weight -> Weight)
-> Ord Weight
Weight -> Weight -> Bool
Weight -> Weight -> Ordering
Weight -> Weight -> Weight
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
min :: Weight -> Weight -> Weight
$cmin :: Weight -> Weight -> Weight
max :: Weight -> Weight -> Weight
$cmax :: Weight -> Weight -> Weight
>= :: Weight -> Weight -> Bool
$c>= :: Weight -> Weight -> Bool
> :: Weight -> Weight -> Bool
$c> :: Weight -> Weight -> Bool
<= :: Weight -> Weight -> Bool
$c<= :: Weight -> Weight -> Bool
< :: Weight -> Weight -> Bool
$c< :: Weight -> Weight -> Bool
compare :: Weight -> Weight -> Ordering
$ccompare :: Weight -> Weight -> Ordering
$cp1Ord :: Eq Weight
Ord, ReadPrec [Weight]
ReadPrec Weight
Int -> ReadS Weight
ReadS [Weight]
(Int -> ReadS Weight)
-> ReadS [Weight]
-> ReadPrec Weight
-> ReadPrec [Weight]
-> Read Weight
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Weight]
$creadListPrec :: ReadPrec [Weight]
readPrec :: ReadPrec Weight
$creadPrec :: ReadPrec Weight
readList :: ReadS [Weight]
$creadList :: ReadS [Weight]
readsPrec :: Int -> ReadS Weight
$creadsPrec :: Int -> ReadS Weight
Read, Int -> Weight -> ShowS
[Weight] -> ShowS
Weight -> String
(Int -> Weight -> ShowS)
-> (Weight -> String) -> ([Weight] -> ShowS) -> Show Weight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Weight] -> ShowS
$cshowList :: [Weight] -> ShowS
show :: Weight -> String
$cshow :: Weight -> String
showsPrec :: Int -> Weight -> ShowS
$cshowsPrec :: Int -> Weight -> ShowS
Show)

instance Hashable Weight

instance NFData Weight

instance Semigroup a => Semigroup (Horizontal a) where
    Horizontal a
a1 a
a2 <> :: Horizontal a -> Horizontal a -> Horizontal a
<> Horizontal a
b1 a
b2 = a -> a -> Horizontal a
forall a. a -> a -> Horizontal a
Horizontal (a
a1 a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b1) (a
a2 a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b2)

instance Semigroup a => Semigroup (Vertical a) where
    Vertical a
a1 a
a2 <> :: Vertical a -> Vertical a -> Vertical a
<> Vertical a
b1 a
b2 = a -> a -> Vertical a
forall a. a -> a -> Vertical a
Vertical (a
a1 a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b1) (a
a2 a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b2)

instance Semigroup a => Semigroup (Parts a) where
    Parts Vertical a
a1 Horizontal a
a2 <> :: Parts a -> Parts a -> Parts a
<> Parts Vertical a
b1 Horizontal a
b2 = Vertical a -> Horizontal a -> Parts a
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Vertical a
a1 Vertical a -> Vertical a -> Vertical a
forall a. Semigroup a => a -> a -> a
<> Vertical a
b1) (Horizontal a
a2 Horizontal a -> Horizontal a -> Horizontal a
forall a. Semigroup a => a -> a -> a
<> Horizontal a
b2)

instance (Monoid a, Semigroup a) => Monoid (Horizontal a) where
    mempty :: Horizontal a
mempty = a -> a -> Horizontal a
forall a. a -> a -> Horizontal a
Horizontal a
forall a. Monoid a => a
mempty a
forall a. Monoid a => a
mempty
    mappend :: Horizontal a -> Horizontal a -> Horizontal a
mappend = Horizontal a -> Horizontal a -> Horizontal a
forall a. Semigroup a => a -> a -> a
(<>)

instance (Monoid a, Semigroup a) => Monoid (Vertical a) where
    mempty :: Vertical a
mempty = a -> a -> Vertical a
forall a. a -> a -> Vertical a
Vertical a
forall a. Monoid a => a
mempty a
forall a. Monoid a => a
mempty
    mappend :: Vertical a -> Vertical a -> Vertical a
mappend = Vertical a -> Vertical a -> Vertical a
forall a. Semigroup a => a -> a -> a
(<>)

instance (Monoid a, Semigroup a) => Monoid (Parts a) where
    mempty :: Parts a
mempty = Vertical a -> Horizontal a -> Parts a
forall a. Vertical a -> Horizontal a -> Parts a
Parts Vertical a
forall a. Monoid a => a
mempty Horizontal a
forall a. Monoid a => a
mempty
    mappend :: Parts a -> Parts a -> Parts a
mappend = Parts a -> Parts a -> Parts a
forall a. Semigroup a => a -> a -> a
(<>)

instance Arbitrary Weight where
    arbitrary :: Gen Weight
arbitrary = Gen Weight
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

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

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

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

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

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

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

instance Applicative Horizontal where
    pure :: a -> Horizontal a
pure a
x = a -> a -> Horizontal a
forall a. a -> a -> Horizontal a
Horizontal a
x a
x
    Horizontal a -> b
fa a -> b
fb <*> :: Horizontal (a -> b) -> Horizontal a -> Horizontal b
<*> Horizontal a
xa a
xb = b -> b -> Horizontal b
forall a. a -> a -> Horizontal a
Horizontal (a -> b
fa a
xa) (a -> b
fb a
xb)

instance Applicative Vertical where
    pure :: a -> Vertical a
pure a
x = a -> a -> Vertical a
forall a. a -> a -> Vertical a
Vertical a
x a
x
    Vertical a -> b
fa a -> b
fb <*> :: Vertical (a -> b) -> Vertical a -> Vertical b
<*> Vertical a
xa a
xb = b -> b -> Vertical b
forall a. a -> a -> Vertical a
Vertical (a -> b
fa a
xa) (a -> b
fb a
xb)

instance Applicative Parts where
    pure :: a -> Parts a
pure a
x = Vertical a -> Horizontal a -> Parts a
forall a. Vertical a -> Horizontal a -> Parts a
Parts (a -> Vertical a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x) (a -> Horizontal a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
    Parts Vertical (a -> b)
fa Horizontal (a -> b)
fb <*> :: Parts (a -> b) -> Parts a -> Parts b
<*> Parts Vertical a
xa Horizontal a
xb = Vertical b -> Horizontal b -> Parts b
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Vertical (a -> b)
fa Vertical (a -> b) -> Vertical a -> Vertical b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Vertical a
xa) (Horizontal (a -> b)
fb Horizontal (a -> b) -> Horizontal a -> Horizontal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Horizontal a
xb)

-- | A pattern that makes pattern matching and expressions with 'Parts' more convenient.
pattern Frame
  :: a  -- ^ The state of the line in the /up/ direction.
  -> a  -- ^ The state of the line in the /down/ direction.
  -> a  -- ^ The state of the line in the /left/ direction.
  -> a  -- ^ The state of the line in the /right/ direction.
  -> Parts a  -- ^ The 'Parts' pattern with the state of the given lines.
pattern $bFrame :: a -> a -> a -> a -> Parts a
$mFrame :: forall r a. Parts a -> (a -> a -> a -> a -> r) -> (Void# -> r) -> r
Frame u d l r = Parts (Vertical u d) (Horizontal l r)

-- | A type synonym that makes it more convenient to work with a 'Parts' object
-- that wraps 'Bool's. Usually 'True' means it should draw a line, and 'False'
-- that there is no line in that direction. The 'UnicodeCharacter' instance of a
-- 'Simple' works by converting 'True' to a 'Light', and vice versa.
type Simple = Parts Bool

-- | A type synonym that makes it more convenient to work with a 'Parts' object
-- that wraps 'Weight' objects. These specify the weight .
type Weighted = Parts Weight

-- | Convert a 'Weighted' object to a 'Simple' object by converting the 'Light'
-- and 'Heavy' parts to 'True' and the 'Empty' parts to 'False'.
weightedToSimple
  :: Weighted  -- ^ The 'Weighted' object to convert.
  -> Simple  -- ^ The 'Simple' object that takes "True' for parts that were 'Light' and 'Heavy'; and 'False' for 'Empty' parts.
weightedToSimple :: Weighted -> Simple
weightedToSimple = (Weight -> Bool) -> Weighted -> Simple
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Weight
Empty Weight -> Weight -> Bool
forall a. Ord a => a -> a -> Bool
<)

-- | Convert a 'Simple' frame to a 'Weighted' frame by converting 'True' to the
-- given 'Weight' value.
simpleToWeighted
  :: Weight  -- ^ The 'Weight' that is used for 'True' values.
  -> Simple  -- ^ The 'Simple' frame to convert.
  -> Weighted  -- ^ The resulting 'Weighted' frame.
simpleToWeighted :: Weight -> Simple -> Weighted
simpleToWeighted = (Bool -> Weight) -> Simple -> Weighted
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Bool -> Weight) -> Simple -> Weighted)
-> (Weight -> Bool -> Weight) -> Weight -> Simple -> Weighted
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Weight -> Weight -> Bool -> Weight
forall a. a -> a -> Bool -> a
bool Weight
Empty

-- | Convert a 'Simple' frame to a 'Weighted' frame by converting 'True' to
-- 'Light'.
simpleToLight
  :: Simple  -- ^ The 'Simple' frame to convert.
  -> Weighted  -- ^ The resulting 'Weighted' frame.
simpleToLight :: Simple -> Weighted
simpleToLight = Weight -> Simple -> Weighted
simpleToWeighted Weight
Light

-- | Convert a 'Simple' frame to a 'Weighted' frame by converting 'True' to
-- 'Heavy'.
simpleToHeavy
  :: Simple  -- ^ The 'Simple frame to convert.
  -> Weighted  -- ^ The resulting 'Weighted' frame.
simpleToHeavy :: Simple -> Weighted
simpleToHeavy = Weight -> Simple -> Weighted
simpleToWeighted Weight
Heavy

-- | Convert a 'Simple' frame to a corresponding 'Char'. Here 'True' is
-- mapped to a 'Light' line.
simple
  :: Simple  -- ^ The given 'Simple' frame to convert.
  -> Char  -- ^ The corresponding characer for this 'Simple' frame.
simple :: Simple -> Char
simple = Weighted -> Char
weighted (Weighted -> Char) -> (Simple -> Weighted) -> Simple -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Simple -> Weighted
simpleToLight

-- | Convert a 'Simple' frame to a corresponding 'Char'. Here 'True' is mapped
-- to a 'Heavy' line.
simple'
  :: Simple  -- ^ The given 'Simple' frame to convert.
  -> Char  -- ^ The corresponding characer for this 'Simple' frame.
simple' :: Simple -> Char
simple' = Weighted -> Char
weighted (Weighted -> Char) -> (Simple -> Weighted) -> Simple -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Simple -> Weighted
simpleToHeavy

-- | Generate a 'Char' where turns are done with an /arc/ instead of a corner.
-- This can only be done for 'Light' lines.
simpleWithArc
  :: Simple  -- ^ The given 'Simple' frame to convert.
  -> Char  -- ^ The corresponding characer for this 'Simple' frame.
simpleWithArc :: Simple -> Char
simpleWithArc (Parts (Vertical Bool
False Bool
True) (Horizontal Bool
False Bool
True)) = Char
'\x256d'
simpleWithArc (Parts (Vertical Bool
False Bool
True) (Horizontal Bool
True Bool
False)) = Char
'\x256e'
simpleWithArc (Parts (Vertical Bool
True Bool
False) (Horizontal Bool
False Bool
True)) = Char
'\x256f'
simpleWithArc (Parts (Vertical Bool
True Bool
False) (Horizontal Bool
True Bool
False)) = Char
'\x2570'
simpleWithArc Simple
x = Simple -> Char
simple Simple
x

-- | Converts a given 'Weighted' to the char that can be used to render frames.
weighted
  :: Weighted  -- ^ The 'Weighted' object that specifies how the lines on the four directions should look like.
  -> Char  -- ^ The character that represents these lines.
weighted :: Weighted -> Char
weighted (Parts (Vertical Weight
Empty Weight
Empty) (Horizontal Weight
Empty Weight
Empty)) = Char
' '
weighted (Parts (Vertical Weight
Empty Weight
Empty) (Horizontal Weight
Light Weight
Light)) = Char
'\x2500'
weighted (Parts (Vertical Weight
Empty Weight
Empty) (Horizontal Weight
Heavy Weight
Heavy)) = Char
'\x2501'
weighted (Parts (Vertical Weight
Light Weight
Light) (Horizontal Weight
Empty Weight
Empty)) = Char
'\x2502'
weighted (Parts (Vertical Weight
Heavy Weight
Heavy) (Horizontal Weight
Empty Weight
Empty)) = Char
'\x2503'
weighted (Parts (Vertical Weight
Empty Weight
Light) (Horizontal Weight
Empty Weight
Light)) = Char
'\x250c'
weighted (Parts (Vertical Weight
Empty Weight
Light) (Horizontal Weight
Empty Weight
Heavy)) = Char
'\x250d'
weighted (Parts (Vertical Weight
Empty Weight
Heavy) (Horizontal Weight
Empty Weight
Light)) = Char
'\x250e'
weighted (Parts (Vertical Weight
Empty Weight
Heavy) (Horizontal Weight
Empty Weight
Heavy)) = Char
'\x250f'
weighted (Parts (Vertical Weight
Empty Weight
Light) (Horizontal Weight
Light Weight
Empty)) = Char
'\x2510'
weighted (Parts (Vertical Weight
Empty Weight
Light) (Horizontal Weight
Heavy Weight
Empty)) = Char
'\x2511'
weighted (Parts (Vertical Weight
Empty Weight
Heavy) (Horizontal Weight
Light Weight
Empty)) = Char
'\x2512'
weighted (Parts (Vertical Weight
Empty Weight
Heavy) (Horizontal Weight
Heavy Weight
Empty)) = Char
'\x2513'
weighted (Parts (Vertical Weight
Light Weight
Empty) (Horizontal Weight
Empty Weight
Light)) = Char
'\x2514'
weighted (Parts (Vertical Weight
Light Weight
Empty) (Horizontal Weight
Empty Weight
Heavy)) = Char
'\x2515'
weighted (Parts (Vertical Weight
Heavy Weight
Empty) (Horizontal Weight
Empty Weight
Light)) = Char
'\x2516'
weighted (Parts (Vertical Weight
Heavy Weight
Empty) (Horizontal Weight
Empty Weight
Heavy)) = Char
'\x2517'
weighted (Parts (Vertical Weight
Light Weight
Empty) (Horizontal Weight
Light Weight
Empty)) = Char
'\x2518'
weighted (Parts (Vertical Weight
Light Weight
Empty) (Horizontal Weight
Heavy Weight
Empty)) = Char
'\x2519'
weighted (Parts (Vertical Weight
Heavy Weight
Empty) (Horizontal Weight
Light Weight
Empty)) = Char
'\x251a'
weighted (Parts (Vertical Weight
Heavy Weight
Empty) (Horizontal Weight
Heavy Weight
Empty)) = Char
'\x251b'
weighted (Parts (Vertical Weight
Light Weight
Light) (Horizontal Weight
Empty Weight
Light)) = Char
'\x251c'
weighted (Parts (Vertical Weight
Light Weight
Light) (Horizontal Weight
Empty Weight
Heavy)) = Char
'\x251d'
weighted (Parts (Vertical Weight
Heavy Weight
Light) (Horizontal Weight
Empty Weight
Light)) = Char
'\x251e'
weighted (Parts (Vertical Weight
Light Weight
Heavy) (Horizontal Weight
Empty Weight
Light)) = Char
'\x251f'
weighted (Parts (Vertical Weight
Heavy Weight
Heavy) (Horizontal Weight
Empty Weight
Light)) = Char
'\x2520'
weighted (Parts (Vertical Weight
Heavy Weight
Light) (Horizontal Weight
Empty Weight
Heavy)) = Char
'\x2521'
weighted (Parts (Vertical Weight
Light Weight
Heavy) (Horizontal Weight
Empty Weight
Heavy)) = Char
'\x2522'
weighted (Parts (Vertical Weight
Heavy Weight
Heavy) (Horizontal Weight
Empty Weight
Heavy)) = Char
'\x2523'
weighted (Parts (Vertical Weight
Light Weight
Light) (Horizontal Weight
Light Weight
Empty)) = Char
'\x2524'
weighted (Parts (Vertical Weight
Light Weight
Light) (Horizontal Weight
Heavy Weight
Empty)) = Char
'\x2525'
weighted (Parts (Vertical Weight
Heavy Weight
Light) (Horizontal Weight
Light Weight
Empty)) = Char
'\x2526'
weighted (Parts (Vertical Weight
Light Weight
Heavy) (Horizontal Weight
Light Weight
Empty)) = Char
'\x2527'
weighted (Parts (Vertical Weight
Heavy Weight
Heavy) (Horizontal Weight
Light Weight
Empty)) = Char
'\x2528'
weighted (Parts (Vertical Weight
Heavy Weight
Light) (Horizontal Weight
Heavy Weight
Empty)) = Char
'\x2529'
weighted (Parts (Vertical Weight
Light Weight
Heavy) (Horizontal Weight
Heavy Weight
Empty)) = Char
'\x252a'
weighted (Parts (Vertical Weight
Heavy Weight
Heavy) (Horizontal Weight
Heavy Weight
Empty)) = Char
'\x252b'
weighted (Parts (Vertical Weight
Empty Weight
Light) (Horizontal Weight
Light Weight
Light)) = Char
'\x252c'
weighted (Parts (Vertical Weight
Empty Weight
Light) (Horizontal Weight
Heavy Weight
Light)) = Char
'\x252d'
weighted (Parts (Vertical Weight
Empty Weight
Light) (Horizontal Weight
Light Weight
Heavy)) = Char
'\x252e'
weighted (Parts (Vertical Weight
Empty Weight
Light) (Horizontal Weight
Heavy Weight
Heavy)) = Char
'\x252f'
weighted (Parts (Vertical Weight
Empty Weight
Heavy) (Horizontal Weight
Light Weight
Light)) = Char
'\x2530'
weighted (Parts (Vertical Weight
Empty Weight
Heavy) (Horizontal Weight
Heavy Weight
Light)) = Char
'\x2531'
weighted (Parts (Vertical Weight
Empty Weight
Heavy) (Horizontal Weight
Light Weight
Heavy)) = Char
'\x2532'
weighted (Parts (Vertical Weight
Empty Weight
Heavy) (Horizontal Weight
Heavy Weight
Heavy)) = Char
'\x2533'
weighted (Parts (Vertical Weight
Light Weight
Empty) (Horizontal Weight
Light Weight
Light)) = Char
'\x2534'
weighted (Parts (Vertical Weight
Light Weight
Empty) (Horizontal Weight
Heavy Weight
Light)) = Char
'\x2535'
weighted (Parts (Vertical Weight
Light Weight
Empty) (Horizontal Weight
Light Weight
Heavy)) = Char
'\x2536'
weighted (Parts (Vertical Weight
Light Weight
Empty) (Horizontal Weight
Heavy Weight
Heavy)) = Char
'\x2537'
weighted (Parts (Vertical Weight
Heavy Weight
Empty) (Horizontal Weight
Light Weight
Light)) = Char
'\x2538'
weighted (Parts (Vertical Weight
Heavy Weight
Empty) (Horizontal Weight
Heavy Weight
Light)) = Char
'\x2539'
weighted (Parts (Vertical Weight
Heavy Weight
Empty) (Horizontal Weight
Light Weight
Heavy)) = Char
'\x253a'
weighted (Parts (Vertical Weight
Heavy Weight
Empty) (Horizontal Weight
Heavy Weight
Heavy)) = Char
'\x253b'
weighted (Parts (Vertical Weight
Light Weight
Light) (Horizontal Weight
Light Weight
Light)) = Char
'\x253c'
weighted (Parts (Vertical Weight
Light Weight
Light) (Horizontal Weight
Heavy Weight
Light)) = Char
'\x253d'
weighted (Parts (Vertical Weight
Light Weight
Light) (Horizontal Weight
Light Weight
Heavy)) = Char
'\x253e'
weighted (Parts (Vertical Weight
Light Weight
Light) (Horizontal Weight
Heavy Weight
Heavy)) = Char
'\x253f'
weighted (Parts (Vertical Weight
Heavy Weight
Light) (Horizontal Weight
Light Weight
Light)) = Char
'\x2540'
weighted (Parts (Vertical Weight
Light Weight
Heavy) (Horizontal Weight
Light Weight
Light)) = Char
'\x2541'
weighted (Parts (Vertical Weight
Heavy Weight
Heavy) (Horizontal Weight
Light Weight
Light)) = Char
'\x2542'
weighted (Parts (Vertical Weight
Heavy Weight
Light) (Horizontal Weight
Heavy Weight
Light)) = Char
'\x2543'
weighted (Parts (Vertical Weight
Heavy Weight
Light) (Horizontal Weight
Light Weight
Heavy)) = Char
'\x2544'
weighted (Parts (Vertical Weight
Light Weight
Heavy) (Horizontal Weight
Heavy Weight
Light)) = Char
'\x2545'
weighted (Parts (Vertical Weight
Light Weight
Heavy) (Horizontal Weight
Light Weight
Heavy)) = Char
'\x2546'
weighted (Parts (Vertical Weight
Heavy Weight
Light) (Horizontal Weight
Heavy Weight
Heavy)) = Char
'\x2547'
weighted (Parts (Vertical Weight
Light Weight
Heavy) (Horizontal Weight
Heavy Weight
Heavy)) = Char
'\x2548'
weighted (Parts (Vertical Weight
Heavy Weight
Heavy) (Horizontal Weight
Heavy Weight
Light)) = Char
'\x2549'
weighted (Parts (Vertical Weight
Heavy Weight
Heavy) (Horizontal Weight
Light Weight
Heavy)) = Char
'\x254a'
weighted (Parts (Vertical Weight
Heavy Weight
Heavy) (Horizontal Weight
Heavy Weight
Heavy)) = Char
'\x254b'
weighted (Parts (Vertical Weight
Empty Weight
Empty) (Horizontal Weight
Light Weight
Empty)) = Char
'\x2574'
weighted (Parts (Vertical Weight
Light Weight
Empty) (Horizontal Weight
Empty Weight
Empty)) = Char
'\x2575'
weighted (Parts (Vertical Weight
Empty Weight
Empty) (Horizontal Weight
Empty Weight
Light)) = Char
'\x2576'
weighted (Parts (Vertical Weight
Empty Weight
Light) (Horizontal Weight
Empty Weight
Empty)) = Char
'\x2577'
weighted (Parts (Vertical Weight
Empty Weight
Empty) (Horizontal Weight
Heavy Weight
Empty)) = Char
'\x2578'
weighted (Parts (Vertical Weight
Heavy Weight
Empty) (Horizontal Weight
Empty Weight
Empty)) = Char
'\x2579'
weighted (Parts (Vertical Weight
Empty Weight
Empty) (Horizontal Weight
Empty Weight
Heavy)) = Char
'\x257a'
weighted (Parts (Vertical Weight
Empty Weight
Heavy) (Horizontal Weight
Empty Weight
Empty)) = Char
'\x257b'
weighted (Parts (Vertical Weight
Empty Weight
Empty) (Horizontal Weight
Light Weight
Heavy)) = Char
'\x257c'
weighted (Parts (Vertical Weight
Light Weight
Heavy) (Horizontal Weight
Empty Weight
Empty)) = Char
'\x257d'
weighted (Parts (Vertical Weight
Empty Weight
Empty) (Horizontal Weight
Heavy Weight
Light)) = Char
'\x257e'
weighted (Parts (Vertical Weight
Heavy Weight
Light) (Horizontal Weight
Empty Weight
Empty)) = Char
'\x257f'

-- | Convert the given 'Char'acter to a 'Parts' object of 'Weight' objects.
-- If the given 'Char'acter is not a /frame/ of 'Weight's, the result is
-- unspecified.
fromWeighted'
  :: Char  -- ^ The given 'Char'acter to convert.
  -> Weighted  -- ^ The equivalent 'Weighted' object.
fromWeighted' :: Char -> Weighted
fromWeighted' = Maybe Weighted -> Weighted
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Weighted -> Weighted)
-> (Char -> Maybe Weighted) -> Char -> Weighted
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe Weighted
fromWeighted

-- | Convert the given 'Char'acter to the equivalent 'Simple' object wrapped in
-- a 'Just' data constructor if it exists; 'Nothing' otherwise. The parts of the
-- frame should only be 'Empty' or 'Light', if it contains a 'Heavy' object
-- 'Nothing' is returned.
fromLight
  :: Char  -- ^ The given 'Char'acter to convert to a 'Simple'.
  -> Maybe Simple  -- ^ The equivalent 'Simple' object wrapped in a 'Just' data constructor if it exists; 'Nothing' otherwise.
fromLight :: Char -> Maybe Simple
fromLight Char
' ' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
False Bool
False) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
False Bool
False))
fromLight Char
'\x2500' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
False Bool
False) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
True Bool
True))
fromLight Char
'\x2502' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
True Bool
True) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
False Bool
False))
fromLight Char
'\x250c' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
False Bool
True) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
False Bool
True))
fromLight Char
'\x2510' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
False Bool
True) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
True Bool
False))
fromLight Char
'\x2514' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
True Bool
False) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
False Bool
True))
fromLight Char
'\x2518' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
True Bool
False) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
True Bool
False))
fromLight Char
'\x251c' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
True Bool
True) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
False Bool
True))
fromLight Char
'\x2524' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
True Bool
True) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
True Bool
False))
fromLight Char
'\x252c' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
False Bool
True) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
True Bool
True))
fromLight Char
'\x2534' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
True Bool
False) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
True Bool
True))
fromLight Char
'\x253c' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
True Bool
True) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
True Bool
True))
fromLight Char
'\x2574' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
False Bool
False) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
True Bool
False))
fromLight Char
'\x2575' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
True Bool
False) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
False Bool
False))
fromLight Char
'\x2576' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
False Bool
False) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
False Bool
True))
fromLight Char
'\x2577' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
False Bool
True) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
False Bool
False))
fromLight Char
_ = Maybe Simple
forall a. Maybe a
Nothing

-- | Convert the given 'Char'acter to the equivalent 'Simple' object if it
-- exists; unspecified output otherwise. The parts of the frame should only be
-- 'Empty' or 'Light'.
fromLight'
  :: Char  -- ^ The given 'Char'acter to convert.
  -> Simple  -- ^ The equivalent 'Simple' object looking at 'Empty' and 'Light' parts.
fromLight' :: Char -> Simple
fromLight' = Maybe Simple -> Simple
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Simple -> Simple)
-> (Char -> Maybe Simple) -> Char -> Simple
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe Simple
fromLight

-- | Convert the given 'Char'acter to the equivalent 'Simple' object wrapped in
-- a 'Just' data constructor if it exists; 'Nothing' otherwise. The parts of the
-- frame should only be 'Empty' or 'Heavy', if it contains a 'Light' object
-- 'Nothing' is returned.
fromHeavy
  :: Char  -- ^ The given 'Char'acter to convert to a 'Simple'.
  -> Maybe Simple  -- ^ The equivalent 'Simple' object wrapped in a 'Just' data constructor if it exists; 'Nothing' otherwise.
fromHeavy :: Char -> Maybe Simple
fromHeavy Char
' ' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
False Bool
False) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
False Bool
False))
fromHeavy Char
'\x2501' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
False Bool
False) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
True Bool
True))
fromHeavy Char
'\x2503' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
True Bool
True) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
False Bool
False))
fromHeavy Char
'\x250f' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
False Bool
True) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
False Bool
True))
fromHeavy Char
'\x2513' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
False Bool
True) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
True Bool
False))
fromHeavy Char
'\x2517' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
True Bool
False) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
False Bool
True))
fromHeavy Char
'\x251b' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
True Bool
False) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
True Bool
False))
fromHeavy Char
'\x2523' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
True Bool
True) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
False Bool
True))
fromHeavy Char
'\x252b' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
True Bool
True) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
True Bool
False))
fromHeavy Char
'\x2533' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
False Bool
True) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
True Bool
True))
fromHeavy Char
'\x253b' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
True Bool
False) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
True Bool
True))
fromHeavy Char
'\x254b' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
True Bool
True) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
True Bool
True))
fromHeavy Char
'\x2578' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
False Bool
False) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
True Bool
False))
fromHeavy Char
'\x2579' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
True Bool
False) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
False Bool
False))
fromHeavy Char
'\x257a' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
False Bool
False) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
False Bool
True))
fromHeavy Char
'\x257b' = Simple -> Maybe Simple
forall a. a -> Maybe a
Just (Vertical Bool -> Horizontal Bool -> Simple
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Bool -> Bool -> Vertical Bool
forall a. a -> a -> Vertical a
Vertical Bool
False Bool
True) (Bool -> Bool -> Horizontal Bool
forall a. a -> a -> Horizontal a
Horizontal Bool
False Bool
False))
fromHeavy Char
_ = Maybe Simple
forall a. Maybe a
Nothing

-- | Convert the given 'Char'acter to the equivalent 'Simple' object if it
-- exists; unspecified output otherwise. The parts of the frame should only be
-- 'Empty' or 'Heavy'.
fromHeavy'
  :: Char  -- ^ The given 'Char'acter to convert.
  -> Simple  -- ^ The equivalent 'Simple' object looking at 'Empty' and 'Heavy' parts.
fromHeavy' :: Char -> Simple
fromHeavy' = Maybe Simple -> Simple
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Simple -> Simple)
-> (Char -> Maybe Simple) -> Char -> Simple
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe Simple
fromHeavy

-- | Convert the given 'Char'acter to a 'Simple', if no such 'Simple' object
-- exists, the output is unspecified. Parts that are 'Light' or 'Heavy' are
-- mapped to 'True', and parts that are 'Empty' are mapped to 'False'.
fromSimple'
  :: Char  -- ^ The given 'Char'acter to convert'.
  -> Simple  -- ^ The equivalent 'Simple' object if it exists.
fromSimple' :: Char -> Simple
fromSimple' = Weighted -> Simple
weightedToSimple (Weighted -> Simple) -> (Char -> Weighted) -> Char -> Simple
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Weighted
fromWeighted'

-- | Convert the given 'Char'acter to a 'Simple' object wrapped in a 'Just' if
-- such 'Simple' object exists; 'Nothing' otherwise. Parts that are 'Light' or
-- 'Heavy' are mapped to 'True', and parts that are 'Empty' are mapped to
-- 'False'.
fromSimple
  :: Char  -- The given 'Char'acter to convert.
  -> Maybe Simple  -- ^ Ther equivalent 'Simple' object wrapped in a 'Just' data constructor if it exists; 'Nothing' otherwise.
fromSimple :: Char -> Maybe Simple
fromSimple = (Weighted -> Simple) -> Maybe Weighted -> Maybe Simple
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Weighted -> Simple
weightedToSimple (Maybe Weighted -> Maybe Simple)
-> (Char -> Maybe Weighted) -> Char -> Maybe Simple
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe Weighted
fromWeighted

-- | Convert the given 'Char'acter to a 'Parts' object of 'Weight' objects
-- wrapped in a 'Just' data constructor if it is a /block/ character; 'Nothing'
-- otherwise.
fromWeighted
  :: Char  -- ^ The given 'Char'acter to convert to a 'Weighted' object.
  -> Maybe Weighted  -- ^ A 'Weighted' object wrapped in a 'Just' if the character is a frame of 'Weight's; 'Nothing' otherwise.
fromWeighted :: Char -> Maybe Weighted
fromWeighted Char
' ' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Empty))
fromWeighted Char
'\x2500' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Light))
fromWeighted Char
'\x2501' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Heavy))
fromWeighted Char
'\x2502' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Empty))
fromWeighted Char
'\x2503' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Empty))
fromWeighted Char
'\x250c' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Light))
fromWeighted Char
'\x250d' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Heavy))
fromWeighted Char
'\x250e' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Light))
fromWeighted Char
'\x250f' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Heavy))
fromWeighted Char
'\x2510' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Empty))
fromWeighted Char
'\x2511' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Empty))
fromWeighted Char
'\x2512' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Empty))
fromWeighted Char
'\x2513' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Empty))
fromWeighted Char
'\x2514' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Light))
fromWeighted Char
'\x2515' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Heavy))
fromWeighted Char
'\x2516' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Light))
fromWeighted Char
'\x2517' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Heavy))
fromWeighted Char
'\x2518' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Empty))
fromWeighted Char
'\x2519' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Empty))
fromWeighted Char
'\x251a' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Empty))
fromWeighted Char
'\x251b' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Empty))
fromWeighted Char
'\x251c' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Light))
fromWeighted Char
'\x251d' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Heavy))
fromWeighted Char
'\x251e' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Light))
fromWeighted Char
'\x251f' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Light))
fromWeighted Char
'\x2520' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Light))
fromWeighted Char
'\x2521' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Heavy))
fromWeighted Char
'\x2522' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Heavy))
fromWeighted Char
'\x2523' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Heavy))
fromWeighted Char
'\x2524' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Empty))
fromWeighted Char
'\x2525' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Empty))
fromWeighted Char
'\x2526' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Empty))
fromWeighted Char
'\x2527' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Empty))
fromWeighted Char
'\x2528' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Empty))
fromWeighted Char
'\x2529' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Empty))
fromWeighted Char
'\x252a' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Empty))
fromWeighted Char
'\x252b' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Empty))
fromWeighted Char
'\x252c' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Light))
fromWeighted Char
'\x252d' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Light))
fromWeighted Char
'\x252e' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Heavy))
fromWeighted Char
'\x252f' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Heavy))
fromWeighted Char
'\x2530' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Light))
fromWeighted Char
'\x2531' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Light))
fromWeighted Char
'\x2532' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Heavy))
fromWeighted Char
'\x2533' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Heavy))
fromWeighted Char
'\x2534' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Light))
fromWeighted Char
'\x2535' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Light))
fromWeighted Char
'\x2536' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Heavy))
fromWeighted Char
'\x2537' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Heavy))
fromWeighted Char
'\x2538' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Light))
fromWeighted Char
'\x2539' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Light))
fromWeighted Char
'\x253a' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Heavy))
fromWeighted Char
'\x253b' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Heavy))
fromWeighted Char
'\x253c' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Light))
fromWeighted Char
'\x253d' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Light))
fromWeighted Char
'\x253e' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Heavy))
fromWeighted Char
'\x253f' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Heavy))
fromWeighted Char
'\x2540' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Light))
fromWeighted Char
'\x2541' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Light))
fromWeighted Char
'\x2542' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Light))
fromWeighted Char
'\x2543' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Light))
fromWeighted Char
'\x2544' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Heavy))
fromWeighted Char
'\x2545' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Light))
fromWeighted Char
'\x2546' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Heavy))
fromWeighted Char
'\x2547' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Heavy))
fromWeighted Char
'\x2548' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Heavy))
fromWeighted Char
'\x2549' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Light))
fromWeighted Char
'\x254a' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Heavy))
fromWeighted Char
'\x254b' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Heavy))
fromWeighted Char
'\x2574' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Empty))
fromWeighted Char
'\x2575' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Empty))
fromWeighted Char
'\x2576' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Light))
fromWeighted Char
'\x2577' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Empty))
fromWeighted Char
'\x2578' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Empty))
fromWeighted Char
'\x2579' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Empty))
fromWeighted Char
'\x257a' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Heavy))
fromWeighted Char
'\x257b' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Empty))
fromWeighted Char
'\x257c' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Light Weight
Heavy))
fromWeighted Char
'\x257d' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Light Weight
Heavy) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Empty))
fromWeighted Char
'\x257e' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Empty Weight
Empty) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Heavy Weight
Light))
fromWeighted Char
'\x257f' = Weighted -> Maybe Weighted
forall a. a -> Maybe a
Just (Vertical Weight -> Horizontal Weight -> Weighted
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Weight -> Weight -> Vertical Weight
forall a. a -> a -> Vertical a
Vertical Weight
Heavy Weight
Light) (Weight -> Weight -> Horizontal Weight
forall a. a -> a -> Horizontal a
Horizontal Weight
Empty Weight
Empty))
fromWeighted Char
_ = Maybe Weighted
forall a. Maybe a
Nothing

instance UnicodeCharacter (Parts Weight) where
    toUnicodeChar :: Weighted -> Char
toUnicodeChar = Weighted -> Char
weighted
    fromUnicodeChar :: Char -> Maybe Weighted
fromUnicodeChar = Char -> Maybe Weighted
fromWeighted
    fromUnicodeChar' :: Char -> Weighted
fromUnicodeChar' = Char -> Weighted
fromWeighted'

instance UnicodeCharacter (Parts Bool) where
    toUnicodeChar :: Simple -> Char
toUnicodeChar = Simple -> Char
simple
    fromUnicodeChar :: Char -> Maybe Simple
fromUnicodeChar = Char -> Maybe Simple
fromLight
    fromUnicodeChar' :: Char -> Simple
fromUnicodeChar' = Char -> Simple
fromLight'

instance UnicodeText (Parts Weight)
instance UnicodeText (Parts Bool)