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

-- |
-- 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 (fromUnicodeChar, fromUnicodeChar', isInCharRange, toUnicodeChar), UnicodeText (isInTextRange), generateIsInTextRange')
import Data.Data (Data)
import Data.Functor.Classes (Eq1 (liftEq), Ord1 (liftCompare))
import Data.Hashable (Hashable)
import Data.Hashable.Lifted (Hashable1)
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
  { -- | The state of the left line of the frame.
    forall a. Horizontal a -> a
left :: a,
    -- | The state of the right line of the frame.
    forall a. Horizontal a -> a
right :: a
  }
  deriving (Horizontal a
Horizontal a -> Horizontal a -> Bounded (Horizontal a)
forall a. a -> a -> Bounded a
forall a. Bounded a => Horizontal a
$cminBound :: forall a. Bounded a => Horizontal a
minBound :: Horizontal a
$cmaxBound :: forall a. Bounded a => Horizontal a
maxBound :: Horizontal a
Bounded, Typeable (Horizontal a)
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 -> Constr
Horizontal a -> DataType
(forall b. Data b => b -> b) -> Horizontal a -> Horizontal a
forall {a}. Data a => Typeable (Horizontal a)
forall a. Data a => Horizontal a -> Constr
forall a. Data a => Horizontal a -> DataType
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))
$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)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Horizontal a -> 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)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Horizontal a)
$ctoConstr :: forall a. Data a => Horizontal a -> Constr
toConstr :: Horizontal a -> Constr
$cdataTypeOf :: forall a. Data a => Horizontal a -> DataType
dataTypeOf :: Horizontal a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Horizontal a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> 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))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Horizontal a))
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Horizontal a -> Horizontal a
gmapT :: (forall b. Data b => b -> b) -> Horizontal a -> Horizontal a
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Horizontal a -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Horizontal a -> r
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Horizontal a -> [u]
gmapQ :: forall u. (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
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Horizontal a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Horizontal a -> m (Horizontal a)
gmapM :: forall (m :: * -> *).
Monad m =>
(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)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Horizontal a -> m (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
$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
/= :: Horizontal a -> Horizontal a -> Bool
Eq, (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
$cfold :: forall m. Monoid m => Horizontal m -> m
fold :: forall m. Monoid m => Horizontal m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Horizontal a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Horizontal a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Horizontal a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Horizontal a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Horizontal a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Horizontal a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Horizontal a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Horizontal a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Horizontal a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Horizontal a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Horizontal a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Horizontal a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Horizontal a -> a
foldr1 :: forall a. (a -> a -> a) -> Horizontal a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Horizontal a -> a
foldl1 :: forall a. (a -> a -> a) -> Horizontal a -> a
$ctoList :: forall a. Horizontal a -> [a]
toList :: forall a. Horizontal a -> [a]
$cnull :: forall a. Horizontal a -> Bool
null :: forall a. Horizontal a -> Bool
$clength :: forall a. Horizontal a -> Int
length :: forall a. Horizontal a -> Int
$celem :: forall a. Eq a => a -> Horizontal a -> Bool
elem :: forall a. Eq a => a -> Horizontal a -> Bool
$cmaximum :: forall a. Ord a => Horizontal a -> a
maximum :: forall a. Ord a => Horizontal a -> a
$cminimum :: forall a. Ord a => Horizontal a -> a
minimum :: forall a. Ord a => Horizontal a -> a
$csum :: forall a. Num a => Horizontal a -> a
sum :: forall a. Num a => Horizontal a -> a
$cproduct :: forall a. Num a => Horizontal a -> a
product :: forall a. Num a => Horizontal a -> a
Foldable, (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
$cfmap :: forall a b. (a -> b) -> Horizontal a -> Horizontal b
fmap :: forall a b. (a -> b) -> Horizontal a -> Horizontal b
$c<$ :: forall a b. a -> Horizontal b -> Horizontal a
<$ :: forall a b. a -> Horizontal b -> Horizontal a
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
$cfrom :: forall a x. Horizontal a -> Rep (Horizontal a) x
from :: forall x. Horizontal a -> Rep (Horizontal a) x
$cto :: forall a x. Rep (Horizontal a) x -> Horizontal a
to :: forall x. Rep (Horizontal a) x -> Horizontal a
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
$cfrom1 :: forall a. Horizontal a -> Rep1 Horizontal a
from1 :: forall a. Horizontal a -> Rep1 Horizontal a
$cto1 :: forall a. Rep1 Horizontal a -> Horizontal a
to1 :: forall a. Rep1 Horizontal a -> 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
$ccompare :: forall a. Ord a => Horizontal a -> Horizontal a -> Ordering
compare :: Horizontal a -> Horizontal a -> Ordering
$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
>= :: Horizontal a -> Horizontal a -> Bool
$cmax :: forall a. Ord a => Horizontal a -> Horizontal a -> Horizontal a
max :: Horizontal a -> Horizontal a -> Horizontal a
$cmin :: forall a. Ord a => Horizontal a -> Horizontal a -> Horizontal a
min :: Horizontal a -> Horizontal a -> 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
$creadsPrec :: forall a. Read a => Int -> ReadS (Horizontal a)
readsPrec :: Int -> ReadS (Horizontal a)
$creadList :: forall a. Read a => ReadS [Horizontal a]
readList :: ReadS [Horizontal a]
$creadPrec :: forall a. Read a => ReadPrec (Horizontal a)
readPrec :: ReadPrec (Horizontal a)
$creadListPrec :: forall a. Read a => ReadPrec [Horizontal a]
readListPrec :: ReadPrec [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
$cshowsPrec :: forall a. Show a => Int -> Horizontal a -> ShowS
showsPrec :: Int -> Horizontal a -> ShowS
$cshow :: forall a. Show a => Horizontal a -> String
show :: Horizontal a -> String
$cshowList :: forall a. Show a => [Horizontal a] -> ShowS
showList :: [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
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)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Horizontal a -> f (Horizontal b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Horizontal a -> f (Horizontal b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Horizontal (f a) -> f (Horizontal a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Horizontal (f a) -> f (Horizontal a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Horizontal a -> m (Horizontal b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Horizontal a -> m (Horizontal b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
Horizontal (m a) -> m (Horizontal a)
sequence :: forall (m :: * -> *) a.
Monad m =>
Horizontal (m a) -> m (Horizontal a)
Traversable)

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

instance Eq1 Vertical where
  liftEq :: forall a b. (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 :: forall a b.
(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
$cminBound :: forall a. Bounded a => Parts a
minBound :: Parts a
$cmaxBound :: forall a. Bounded a => Parts a
maxBound :: Parts a
Bounded, Typeable (Parts a)
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 -> Constr
Parts a -> DataType
(forall b. Data b => b -> b) -> Parts a -> Parts a
forall {a}. Data a => Typeable (Parts a)
forall a. Data a => Parts a -> Constr
forall a. Data a => Parts a -> DataType
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))
$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)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Parts a -> 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)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Parts a)
$ctoConstr :: forall a. Data a => Parts a -> Constr
toConstr :: Parts a -> Constr
$cdataTypeOf :: forall a. Data a => Parts a -> DataType
dataTypeOf :: Parts a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Parts a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> 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))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Parts a))
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Parts a -> Parts a
gmapT :: (forall b. Data b => b -> b) -> Parts a -> Parts a
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Parts a -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Parts a -> r
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Parts a -> [u]
gmapQ :: forall u. (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
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Parts a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Parts a -> m (Parts a)
gmapM :: forall (m :: * -> *).
Monad m =>
(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)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Parts a -> m (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
$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
/= :: Parts a -> Parts a -> Bool
Eq, (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
$cfold :: forall m. Monoid m => Parts m -> m
fold :: forall m. Monoid m => Parts m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Parts a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Parts a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Parts a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Parts a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Parts a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Parts a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Parts a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Parts a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Parts a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Parts a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Parts a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Parts a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Parts a -> a
foldr1 :: forall a. (a -> a -> a) -> Parts a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Parts a -> a
foldl1 :: forall a. (a -> a -> a) -> Parts a -> a
$ctoList :: forall a. Parts a -> [a]
toList :: forall a. Parts a -> [a]
$cnull :: forall a. Parts a -> Bool
null :: forall a. Parts a -> Bool
$clength :: forall a. Parts a -> Int
length :: forall a. Parts a -> Int
$celem :: forall a. Eq a => a -> Parts a -> Bool
elem :: forall a. Eq a => a -> Parts a -> Bool
$cmaximum :: forall a. Ord a => Parts a -> a
maximum :: forall a. Ord a => Parts a -> a
$cminimum :: forall a. Ord a => Parts a -> a
minimum :: forall a. Ord a => Parts a -> a
$csum :: forall a. Num a => Parts a -> a
sum :: forall a. Num a => Parts a -> a
$cproduct :: forall a. Num a => Parts a -> a
product :: forall a. Num a => Parts a -> a
Foldable, (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
$cfmap :: forall a b. (a -> b) -> Parts a -> Parts b
fmap :: forall a b. (a -> b) -> Parts a -> Parts b
$c<$ :: forall a b. a -> Parts b -> Parts a
<$ :: forall a b. a -> Parts b -> Parts a
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
$cfrom :: forall a x. Parts a -> Rep (Parts a) x
from :: forall x. Parts a -> Rep (Parts a) x
$cto :: forall a x. Rep (Parts a) x -> Parts a
to :: forall x. Rep (Parts a) x -> Parts a
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
$cfrom1 :: forall a. Parts a -> Rep1 Parts a
from1 :: forall a. Parts a -> Rep1 Parts a
$cto1 :: forall a. Rep1 Parts a -> Parts a
to1 :: forall a. Rep1 Parts a -> 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
$ccompare :: forall a. Ord a => Parts a -> Parts a -> Ordering
compare :: Parts a -> Parts a -> Ordering
$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
>= :: Parts a -> Parts a -> Bool
$cmax :: forall a. Ord a => Parts a -> Parts a -> Parts a
max :: Parts a -> Parts a -> Parts a
$cmin :: forall a. Ord a => Parts a -> Parts a -> Parts a
min :: Parts a -> Parts a -> 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
$creadsPrec :: forall a. Read a => Int -> ReadS (Parts a)
readsPrec :: Int -> ReadS (Parts a)
$creadList :: forall a. Read a => ReadS [Parts a]
readList :: ReadS [Parts a]
$creadPrec :: forall a. Read a => ReadPrec (Parts a)
readPrec :: ReadPrec (Parts a)
$creadListPrec :: forall a. Read a => ReadPrec [Parts a]
readListPrec :: ReadPrec [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
$cshowsPrec :: forall a. Show a => Int -> Parts a -> ShowS
showsPrec :: Int -> Parts a -> ShowS
$cshow :: forall a. Show a => Parts a -> String
show :: Parts a -> String
$cshowList :: forall a. Show a => [Parts a] -> ShowS
showList :: [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
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)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Parts a -> f (Parts b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Parts a -> f (Parts b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Parts (f a) -> f (Parts a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Parts (f a) -> f (Parts a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Parts a -> m (Parts b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Parts a -> m (Parts b)
$csequence :: forall (m :: * -> *) a. Monad m => Parts (m a) -> m (Parts a)
sequence :: forall (m :: * -> *) a. Monad m => Parts (m a) -> m (Parts a)
Traversable)

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

#if MIN_VERSION_base(4,11,0)
instance Monoid 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
(<>)
#else
instance (Monoid a, Semigroup a) => Monoid (Horizontal a) where
  mempty = Horizontal mempty mempty
  mappend = (<>)
#endif

#if MIN_VERSION_base(4,11,0)
instance Monoid 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
(<>)
#else
instance (Monoid a, Semigroup a) => Monoid (Vertical a) where
  mempty = Vertical mempty mempty
  mappend = (<>)
#endif

#if MIN_VERSION_base(4,11,0)
instance Monoid 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
(<>)
#else
instance (Monoid a, Semigroup a) => Monoid (Parts a) where
  mempty = Parts mempty mempty
  mappend = (<>)
#endif

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 :: forall a. 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 a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
arb

instance Arbitrary a => Arbitrary (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 :: forall a. 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 a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
arb

instance Arbitrary a => Arbitrary (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 :: forall a. 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 a. 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 a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a -> Gen (Horizontal a)
forall a. Gen a -> Gen (Horizontal a)
forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary Gen a
arb

instance Applicative Horizontal where
  pure :: forall a. 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 <*> :: forall a b. 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 :: forall a. 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 <*> :: forall a b. 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 :: forall a. 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 a. a -> Vertical a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x) (a -> Horizontal a
forall a. a -> Horizontal a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
  Parts Vertical (a -> b)
fa Horizontal (a -> b)
fb <*> :: forall a b. 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 a b. 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 a b. 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 ::
  -- | 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.
  a ->
  -- | The 'Parts' pattern with the state of the given lines.
  Parts a
pattern $mFrame :: forall {r} {a}.
Parts a -> (a -> a -> a -> a -> r) -> ((# #) -> r) -> r
$bFrame :: forall a. a -> a -> a -> a -> Parts a
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 ::
  -- | The 'Weighted' object to convert.
  Weighted ->
  -- | The 'Simple' object that takes "True' for parts that were 'Light' and 'Heavy'; and 'False' for 'Empty' parts.
  Simple
weightedToSimple :: Weighted -> Simple
weightedToSimple = (Weight -> Bool) -> Weighted -> Simple
forall a b. (a -> b) -> Parts a -> Parts b
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 ::
  -- | The 'Weight' that is used for 'True' values.
  Weight ->
  -- | The 'Simple' frame to convert.
  Simple ->
  -- | The resulting 'Weighted' frame.
  Weighted
simpleToWeighted :: Weight -> Simple -> Weighted
simpleToWeighted = (Bool -> Weight) -> Simple -> Weighted
forall a b. (a -> b) -> Parts a -> Parts b
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 ::
  -- | The 'Simple' frame to convert.
  Simple ->
  -- | The resulting 'Weighted' frame.
  Weighted
simpleToLight :: Simple -> Weighted
simpleToLight = Weight -> Simple -> Weighted
simpleToWeighted Weight
Light

-- | Convert a 'Simple' frame to a 'Weighted' frame by converting 'True' to
-- 'Heavy'.
simpleToHeavy ::
  -- | The 'Simple frame to convert.
  Simple ->
  -- | The resulting 'Weighted' frame.
  Weighted
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 ::
  -- | The given 'Simple' frame to convert.
  Simple ->
  -- | The corresponding characer for this 'Simple' frame.
  Char
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' ::
  -- | The given 'Simple' frame to convert.
  Simple ->
  -- | The corresponding characer for this 'Simple' frame.
  Char
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 ::
  -- | The given 'Simple' frame to convert.
  Simple ->
  -- | The corresponding characer for this 'Simple' frame.
  Char
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 ::
  -- | The 'Weighted' object that specifies how the lines on the four directions should look like.
  Weighted ->
  -- | The character that represents these lines.
  Char
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' ::
  -- | The given 'Char'acter to convert.
  Char ->
  -- | The equivalent 'Weighted' object.
  Weighted
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 ::
  -- | The given 'Char'acter to convert to a 'Simple'.
  Char ->
  -- | The equivalent 'Simple' object wrapped in a 'Just' data constructor if it exists; 'Nothing' otherwise.
  Maybe Simple
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' ::
  -- | The given 'Char'acter to convert.
  Char ->
  -- | The equivalent 'Simple' object looking at 'Empty' and 'Light' parts.
  Simple
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 ::
  -- | The given 'Char'acter to convert to a 'Simple'.
  Char ->
  -- | The equivalent 'Simple' object wrapped in a 'Just' data constructor if it exists; 'Nothing' otherwise.
  Maybe Simple
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' ::
  -- | The given 'Char'acter to convert.
  Char ->
  -- | The equivalent 'Simple' object looking at 'Empty' and 'Heavy' parts.
  Simple
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' ::
  -- | The given 'Char'acter to convert'.
  Char ->
  -- | The equivalent 'Simple' object if it exists.
  Simple
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.

  -- | Ther equivalent 'Simple' object wrapped in a 'Just' data constructor if it exists; 'Nothing' otherwise.
  Maybe Simple
fromSimple :: Char -> Maybe Simple
fromSimple = (Weighted -> Simple) -> Maybe Weighted -> Maybe Simple
forall a b. (a -> b) -> Maybe a -> Maybe b
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 ::
  -- | The given 'Char'acter to convert to a 'Weighted' object.
  Char ->
  -- | A 'Weighted' object wrapped in a 'Just' if the character is a frame of 'Weight's; 'Nothing' otherwise.
  Maybe Weighted
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'
  isInCharRange :: Char -> Bool
isInCharRange Char
' ' = Bool
True
  isInCharRange Char
c = (Char
'\x2500' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x2503') Bool -> Bool -> Bool
|| (Char
'\x250c' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x254b')

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'
  isInCharRange :: Char -> Bool
isInCharRange Char
' ' = Bool
True
  isInCharRange Char
'\x2500' = Bool
True
  isInCharRange Char
'\x2502' = Bool
True
  isInCharRange Char
'\x250c' = Bool
True
  isInCharRange Char
'\x2510' = Bool
True
  isInCharRange Char
'\x2514' = Bool
True
  isInCharRange Char
'\x2518' = Bool
True
  isInCharRange Char
'\x251c' = Bool
True
  isInCharRange Char
'\x2524' = Bool
True
  isInCharRange Char
'\x252c' = Bool
True
  isInCharRange Char
'\x2534' = Bool
True
  isInCharRange Char
'\x253c' = Bool
True
  isInCharRange Char
'\x2574' = Bool
True
  isInCharRange Char
'\x2575' = Bool
True
  isInCharRange Char
'\x2576' = Bool
True
  isInCharRange Char
'\x2577' = Bool
True
  isInCharRange Char
_ = Bool
False

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

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