module Data.Char.Frame where
import Control.Applicative (Applicative, pure, (<*>), liftA2, )
import Data.Traversable (Traversable, traverse, foldMapDefault, )
import Data.Foldable (Foldable, foldMap, )
import Data.Monoid (Monoid, mempty, mappend, )
import Data.Semigroup (Semigroup((<>)), )
data Horizontal a = Horizontal {Horizontal a -> a
left, Horizontal a -> a
right :: a} deriving (Horizontal a -> Horizontal a -> Bool
(Horizontal a -> Horizontal a -> Bool)
-> (Horizontal a -> Horizontal a -> Bool) -> Eq (Horizontal a)
forall a. Eq a => Horizontal a -> Horizontal a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Horizontal a -> Horizontal a -> Bool
$c/= :: forall a. Eq a => Horizontal a -> Horizontal a -> Bool
== :: Horizontal a -> Horizontal a -> Bool
$c== :: forall a. Eq a => Horizontal a -> Horizontal a -> Bool
Eq, Int -> Horizontal a -> ShowS
[Horizontal a] -> ShowS
Horizontal a -> String
(Int -> Horizontal a -> ShowS)
-> (Horizontal a -> String)
-> ([Horizontal a] -> ShowS)
-> Show (Horizontal a)
forall a. Show a => Int -> Horizontal a -> ShowS
forall a. Show a => [Horizontal a] -> ShowS
forall a. Show a => Horizontal a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Horizontal a] -> ShowS
$cshowList :: forall a. Show a => [Horizontal a] -> ShowS
show :: Horizontal a -> String
$cshow :: forall a. Show a => Horizontal a -> String
showsPrec :: Int -> Horizontal a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Horizontal a -> ShowS
Show)
data Vertical a = Vertical {Vertical a -> a
up, Vertical a -> a
down :: a} deriving (Vertical a -> Vertical a -> Bool
(Vertical a -> Vertical a -> Bool)
-> (Vertical a -> Vertical a -> Bool) -> Eq (Vertical a)
forall a. Eq a => Vertical a -> Vertical a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vertical a -> Vertical a -> Bool
$c/= :: forall a. Eq a => Vertical a -> Vertical a -> Bool
== :: Vertical a -> Vertical a -> Bool
$c== :: forall a. Eq a => Vertical a -> Vertical a -> Bool
Eq, Int -> Vertical a -> ShowS
[Vertical a] -> ShowS
Vertical a -> String
(Int -> Vertical a -> ShowS)
-> (Vertical a -> String)
-> ([Vertical a] -> ShowS)
-> Show (Vertical a)
forall a. Show a => Int -> Vertical a -> ShowS
forall a. Show a => [Vertical a] -> ShowS
forall a. Show a => Vertical a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vertical a] -> ShowS
$cshowList :: forall a. Show a => [Vertical a] -> ShowS
show :: Vertical a -> String
$cshow :: forall a. Show a => Vertical a -> String
showsPrec :: Int -> Vertical a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Vertical a -> ShowS
Show)
data Parts a = Parts (Vertical a) (Horizontal a) deriving (Parts a -> Parts a -> Bool
(Parts a -> Parts a -> Bool)
-> (Parts a -> Parts a -> Bool) -> Eq (Parts a)
forall a. Eq a => Parts a -> Parts a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Parts a -> Parts a -> Bool
$c/= :: forall a. Eq a => Parts a -> Parts a -> Bool
== :: Parts a -> Parts a -> Bool
$c== :: forall a. Eq a => Parts a -> Parts a -> Bool
Eq, Int -> Parts a -> ShowS
[Parts a] -> ShowS
Parts a -> String
(Int -> Parts a -> ShowS)
-> (Parts a -> String) -> ([Parts a] -> ShowS) -> Show (Parts a)
forall a. Show a => Int -> Parts a -> ShowS
forall a. Show a => [Parts a] -> ShowS
forall a. Show a => Parts a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Parts a] -> ShowS
$cshowList :: forall a. Show a => [Parts a] -> ShowS
show :: Parts a -> String
$cshow :: forall a. Show a => Parts a -> String
showsPrec :: Int -> Parts a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Parts a -> ShowS
Show)
instance Semigroup a => Semigroup (Horizontal a) where
Horizontal a
xl a
xr <> :: Horizontal a -> Horizontal a -> Horizontal a
<> Horizontal a
yl a
yr =
a -> a -> Horizontal a
forall a. a -> a -> Horizontal a
Horizontal (a
xl a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
yl) (a
xr a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
yr)
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
xl a
xr) (Horizontal a
yl a
yr) =
a -> a -> Horizontal a
forall a. a -> a -> Horizontal a
Horizontal (a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
xl a
yl) (a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
xr a
yr)
instance Semigroup a => Semigroup (Vertical a) where
Vertical a
xl a
xr <> :: Vertical a -> Vertical a -> Vertical a
<> Vertical a
yl a
yr =
a -> a -> Vertical a
forall a. a -> a -> Vertical a
Vertical (a
xl a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
yl) (a
xr a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
yr)
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
xl a
xr) (Vertical a
yl a
yr) =
a -> a -> Vertical a
forall a. a -> a -> Vertical a
Vertical (a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
xl a
yl) (a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
xr a
yr)
instance Semigroup a => Semigroup (Parts a) where
Parts Vertical a
xl Horizontal a
xr <> :: Parts a -> Parts a -> Parts a
<> Parts Vertical a
yl Horizontal a
yr =
Vertical a -> Horizontal a -> Parts a
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Vertical a
xl Vertical a -> Vertical a -> Vertical a
forall a. Semigroup a => a -> a -> a
<> Vertical a
yl) (Horizontal a
xr Horizontal a -> Horizontal a -> Horizontal a
forall a. Semigroup a => a -> a -> a
<> Horizontal a
yr)
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 Vertical a
xl Horizontal a
xr) (Parts Vertical a
yl Horizontal a
yr) =
Vertical a -> Horizontal a -> Parts a
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Vertical a -> Vertical a -> Vertical a
forall a. Monoid a => a -> a -> a
mappend Vertical a
xl Vertical a
yl) (Horizontal a -> Horizontal a -> Horizontal a
forall a. Monoid a => a -> a -> a
mappend Horizontal a
xr Horizontal a
yr)
instance Functor Horizontal where
fmap :: (a -> b) -> Horizontal a -> Horizontal b
fmap a -> b
f (Horizontal a
a a
b) = b -> b -> Horizontal b
forall a. a -> a -> Horizontal a
Horizontal (a -> b
f a
a) (a -> b
f a
b)
instance Functor Vertical where
fmap :: (a -> b) -> Vertical a -> Vertical b
fmap a -> b
f (Vertical a
a a
b) = b -> b -> Vertical b
forall a. a -> a -> Vertical a
Vertical (a -> b
f a
a) (a -> b
f a
b)
instance Functor Parts where
fmap :: (a -> b) -> Parts a -> Parts b
fmap a -> b
f (Parts Vertical a
a Horizontal a
b) = Vertical b -> Horizontal b -> Parts b
forall a. Vertical a -> Horizontal a -> Parts a
Parts ((a -> b) -> Vertical a -> Vertical b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Vertical a
a) ((a -> b) -> Horizontal a -> Horizontal b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Horizontal a
b)
instance Foldable Horizontal where
foldMap :: (a -> m) -> Horizontal a -> m
foldMap = (a -> m) -> Horizontal a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault
instance Foldable Vertical where
foldMap :: (a -> m) -> Vertical a -> m
foldMap = (a -> m) -> Vertical a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault
instance Foldable Parts where
foldMap :: (a -> m) -> Parts a -> m
foldMap = (a -> m) -> Parts a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault
instance Traversable Horizontal where
traverse :: (a -> f b) -> Horizontal a -> f (Horizontal b)
traverse a -> f b
f (Horizontal a
a a
b) = (b -> b -> Horizontal b) -> f b -> f b -> f (Horizontal b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> Horizontal b
forall a. a -> a -> Horizontal a
Horizontal (a -> f b
f a
a) (a -> f b
f a
b)
instance Traversable Vertical where
traverse :: (a -> f b) -> Vertical a -> f (Vertical b)
traverse a -> f b
f (Vertical a
a a
b) = (b -> b -> Vertical b) -> f b -> f b -> f (Vertical b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> Vertical b
forall a. a -> a -> Vertical a
Vertical (a -> f b
f a
a) (a -> f b
f a
b)
instance Traversable Parts where
traverse :: (a -> f b) -> Parts a -> f (Parts b)
traverse a -> f b
f (Parts Vertical a
a Horizontal a
b) = (Vertical b -> Horizontal b -> Parts b)
-> f (Vertical b) -> f (Horizontal b) -> f (Parts b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Vertical b -> Horizontal b -> Parts b
forall a. Vertical a -> Horizontal a -> Parts a
Parts ((a -> f b) -> Vertical a -> f (Vertical b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Vertical a
a) ((a -> f b) -> Horizontal a -> f (Horizontal b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Horizontal a
b)
instance Applicative Horizontal where
pure :: a -> Horizontal a
pure a
a = a -> a -> Horizontal a
forall a. a -> a -> Horizontal a
Horizontal a
a a
a
Horizontal a -> b
fa a -> b
fb <*> :: Horizontal (a -> b) -> Horizontal a -> Horizontal b
<*> Horizontal a
a a
b =
b -> b -> Horizontal b
forall a. a -> a -> Horizontal a
Horizontal (a -> b
fa a
a) (a -> b
fb a
b)
instance Applicative Vertical where
pure :: a -> Vertical a
pure a
a = a -> a -> Vertical a
forall a. a -> a -> Vertical a
Vertical a
a a
a
Vertical a -> b
fa a -> b
fb <*> :: Vertical (a -> b) -> Vertical a -> Vertical b
<*> Vertical a
a a
b =
b -> b -> Vertical b
forall a. a -> a -> Vertical a
Vertical (a -> b
fa a
a) (a -> b
fb a
b)
instance Applicative Parts where
pure :: a -> Parts a
pure a
a = Vertical a -> Horizontal a -> Parts a
forall a. Vertical a -> Horizontal a -> Parts a
Parts (a -> Vertical a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) (a -> Horizontal a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
Parts Vertical (a -> b)
fa Horizontal (a -> b)
fb <*> :: Parts (a -> b) -> Parts a -> Parts b
<*> Parts Vertical a
a Horizontal a
b =
Vertical b -> Horizontal b -> Parts b
forall a. Vertical a -> Horizontal a -> Parts a
Parts (Vertical (a -> b)
fa Vertical (a -> b) -> Vertical a -> Vertical b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Vertical a
a) (Horizontal (a -> b)
fb Horizontal (a -> b) -> Horizontal a -> Horizontal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Horizontal a
b)
simple :: Parts Bool -> Char
simple :: Parts Bool -> Char
simple Parts Bool
set =
case Parts Bool
set of
Parts (Vertical Bool
False Bool
False) (Horizontal Bool
False Bool
False) -> Char
' '
Parts (Vertical Bool
False Bool
False) (Horizontal Bool
True Bool
True ) -> Char
'\x2500'
Parts (Vertical Bool
True Bool
True ) (Horizontal Bool
False Bool
False) -> Char
'\x2502'
Parts (Vertical Bool
True Bool
True ) (Horizontal Bool
True Bool
True ) -> Char
'\x253C'
Parts (Vertical Bool
False Bool
False) (Horizontal Bool
False Bool
True ) -> Char
'\x2576'
Parts (Vertical Bool
False Bool
False) (Horizontal Bool
True Bool
False) -> Char
'\x2574'
Parts (Vertical Bool
False Bool
True ) (Horizontal Bool
False Bool
False) -> Char
'\x2577'
Parts (Vertical Bool
True Bool
False) (Horizontal Bool
False Bool
False) -> Char
'\x2575'
Parts (Vertical Bool
False Bool
True ) (Horizontal Bool
False Bool
True ) -> Char
'\x250C'
Parts (Vertical Bool
False Bool
True ) (Horizontal Bool
True Bool
False) -> Char
'\x2510'
Parts (Vertical Bool
True Bool
False) (Horizontal Bool
False Bool
True ) -> Char
'\x2514'
Parts (Vertical Bool
True Bool
False) (Horizontal Bool
True Bool
False) -> Char
'\x2518'
Parts (Vertical Bool
True Bool
True ) (Horizontal Bool
False Bool
True ) -> Char
'\x251C'
Parts (Vertical Bool
True Bool
True ) (Horizontal Bool
True Bool
False) -> Char
'\x2524'
Parts (Vertical Bool
False Bool
True ) (Horizontal Bool
True Bool
True ) -> Char
'\x252C'
Parts (Vertical Bool
True Bool
False) (Horizontal Bool
True Bool
True ) -> Char
'\x2534'
data Weight = Empty | Light | Heavy
deriving (Weight -> Weight -> Bool
(Weight -> Weight -> Bool)
-> (Weight -> Weight -> Bool) -> Eq Weight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Weight -> Weight -> Bool
$c/= :: Weight -> Weight -> Bool
== :: Weight -> Weight -> Bool
$c== :: Weight -> Weight -> Bool
Eq, Eq Weight
Eq Weight
-> (Weight -> Weight -> Ordering)
-> (Weight -> Weight -> Bool)
-> (Weight -> Weight -> Bool)
-> (Weight -> Weight -> Bool)
-> (Weight -> Weight -> Bool)
-> (Weight -> Weight -> Weight)
-> (Weight -> Weight -> Weight)
-> Ord Weight
Weight -> Weight -> Bool
Weight -> Weight -> Ordering
Weight -> Weight -> Weight
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Weight -> Weight -> Weight
$cmin :: Weight -> Weight -> Weight
max :: Weight -> Weight -> Weight
$cmax :: Weight -> Weight -> Weight
>= :: Weight -> Weight -> Bool
$c>= :: Weight -> Weight -> Bool
> :: Weight -> Weight -> Bool
$c> :: Weight -> Weight -> Bool
<= :: Weight -> Weight -> Bool
$c<= :: Weight -> Weight -> Bool
< :: Weight -> Weight -> Bool
$c< :: Weight -> Weight -> Bool
compare :: Weight -> Weight -> Ordering
$ccompare :: Weight -> Weight -> Ordering
$cp1Ord :: Eq Weight
Ord, Int -> Weight -> ShowS
[Weight] -> ShowS
Weight -> String
(Int -> Weight -> ShowS)
-> (Weight -> String) -> ([Weight] -> ShowS) -> Show Weight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Weight] -> ShowS
$cshowList :: [Weight] -> ShowS
show :: Weight -> String
$cshow :: Weight -> String
showsPrec :: Int -> Weight -> ShowS
$cshowsPrec :: Int -> Weight -> ShowS
Show, Int -> Weight
Weight -> Int
Weight -> [Weight]
Weight -> Weight
Weight -> Weight -> [Weight]
Weight -> Weight -> Weight -> [Weight]
(Weight -> Weight)
-> (Weight -> Weight)
-> (Int -> Weight)
-> (Weight -> Int)
-> (Weight -> [Weight])
-> (Weight -> Weight -> [Weight])
-> (Weight -> Weight -> [Weight])
-> (Weight -> Weight -> Weight -> [Weight])
-> Enum Weight
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Weight -> Weight -> Weight -> [Weight]
$cenumFromThenTo :: Weight -> Weight -> Weight -> [Weight]
enumFromTo :: Weight -> Weight -> [Weight]
$cenumFromTo :: Weight -> Weight -> [Weight]
enumFromThen :: Weight -> Weight -> [Weight]
$cenumFromThen :: Weight -> Weight -> [Weight]
enumFrom :: Weight -> [Weight]
$cenumFrom :: Weight -> [Weight]
fromEnum :: Weight -> Int
$cfromEnum :: Weight -> Int
toEnum :: Int -> Weight
$ctoEnum :: Int -> Weight
pred :: Weight -> Weight
$cpred :: Weight -> Weight
succ :: Weight -> Weight
$csucc :: Weight -> Weight
Enum, Weight
Weight -> Weight -> Bounded Weight
forall a. a -> a -> Bounded a
maxBound :: Weight
$cmaxBound :: Weight
minBound :: Weight
$cminBound :: Weight
Bounded)
weighted :: Parts Weight -> Char
weighted :: Parts Weight -> Char
weighted Parts Weight
set =
case Parts Weight
set of
Parts (Vertical Weight
Empty Weight
Empty) (Horizontal Weight
Empty Weight
Empty) -> Char
' '
Parts (Vertical Weight
Empty Weight
Empty) (Horizontal Weight
Light Weight
Light) -> Char
'\x2500'
Parts (Vertical Weight
Empty Weight
Empty) (Horizontal Weight
Heavy Weight
Heavy) -> Char
'\x2501'
Parts (Vertical Weight
Light Weight
Light) (Horizontal Weight
Empty Weight
Empty) -> Char
'\x2502'
Parts (Vertical Weight
Heavy Weight
Heavy) (Horizontal Weight
Empty Weight
Empty) -> Char
'\x2503'
Parts (Vertical Weight
Empty Weight
Light) (Horizontal Weight
Empty Weight
Light) -> Char
'\x250C'
Parts (Vertical Weight
Empty Weight
Light) (Horizontal Weight
Empty Weight
Heavy) -> Char
'\x250D'
Parts (Vertical Weight
Empty Weight
Heavy) (Horizontal Weight
Empty Weight
Light) -> Char
'\x250E'
Parts (Vertical Weight
Empty Weight
Heavy) (Horizontal Weight
Empty Weight
Heavy) -> Char
'\x250F'
Parts (Vertical Weight
Empty Weight
Light) (Horizontal Weight
Light Weight
Empty) -> Char
'\x2510'
Parts (Vertical Weight
Empty Weight
Light) (Horizontal Weight
Heavy Weight
Empty) -> Char
'\x2511'
Parts (Vertical Weight
Empty Weight
Heavy) (Horizontal Weight
Light Weight
Empty) -> Char
'\x2512'
Parts (Vertical Weight
Empty Weight
Heavy) (Horizontal Weight
Heavy Weight
Empty) -> Char
'\x2513'
Parts (Vertical Weight
Light Weight
Empty) (Horizontal Weight
Empty Weight
Light) -> Char
'\x2514'
Parts (Vertical Weight
Light Weight
Empty) (Horizontal Weight
Empty Weight
Heavy) -> Char
'\x2515'
Parts (Vertical Weight
Heavy Weight
Empty) (Horizontal Weight
Empty Weight
Light) -> Char
'\x2516'
Parts (Vertical Weight
Heavy Weight
Empty) (Horizontal Weight
Empty Weight
Heavy) -> Char
'\x2517'
Parts (Vertical Weight
Light Weight
Empty) (Horizontal Weight
Light Weight
Empty) -> Char
'\x2518'
Parts (Vertical Weight
Light Weight
Empty) (Horizontal Weight
Heavy Weight
Empty) -> Char
'\x2519'
Parts (Vertical Weight
Heavy Weight
Empty) (Horizontal Weight
Light Weight
Empty) -> Char
'\x251A'
Parts (Vertical Weight
Heavy Weight
Empty) (Horizontal Weight
Heavy Weight
Empty) -> Char
'\x251B'
Parts (Vertical Weight
Light Weight
Light) (Horizontal Weight
Empty Weight
Light) -> Char
'\x251C'
Parts (Vertical Weight
Light Weight
Light) (Horizontal Weight
Empty Weight
Heavy) -> Char
'\x251D'
Parts (Vertical Weight
Heavy Weight
Light) (Horizontal Weight
Empty Weight
Light) -> Char
'\x251E'
Parts (Vertical Weight
Light Weight
Heavy) (Horizontal Weight
Empty Weight
Light) -> Char
'\x251F'
Parts (Vertical Weight
Heavy Weight
Heavy) (Horizontal Weight
Empty Weight
Light) -> Char
'\x2520'
Parts (Vertical Weight
Heavy Weight
Light) (Horizontal Weight
Empty Weight
Heavy) -> Char
'\x2521'
Parts (Vertical Weight
Light Weight
Heavy) (Horizontal Weight
Empty Weight
Heavy) -> Char
'\x2522'
Parts (Vertical Weight
Heavy Weight
Heavy) (Horizontal Weight
Empty Weight
Heavy) -> Char
'\x2523'
Parts (Vertical Weight
Light Weight
Light) (Horizontal Weight
Light Weight
Empty) -> Char
'\x2524'
Parts (Vertical Weight
Light Weight
Light) (Horizontal Weight
Heavy Weight
Empty) -> Char
'\x2525'
Parts (Vertical Weight
Heavy Weight
Light) (Horizontal Weight
Light Weight
Empty) -> Char
'\x2526'
Parts (Vertical Weight
Light Weight
Heavy) (Horizontal Weight
Light Weight
Empty) -> Char
'\x2527'
Parts (Vertical Weight
Heavy Weight
Heavy) (Horizontal Weight
Light Weight
Empty) -> Char
'\x2528'
Parts (Vertical Weight
Heavy Weight
Light) (Horizontal Weight
Heavy Weight
Empty) -> Char
'\x2529'
Parts (Vertical Weight
Light Weight
Heavy) (Horizontal Weight
Heavy Weight
Empty) -> Char
'\x252A'
Parts (Vertical Weight
Heavy Weight
Heavy) (Horizontal Weight
Heavy Weight
Empty) -> Char
'\x252B'
Parts (Vertical Weight
Empty Weight
Light) (Horizontal Weight
Light Weight
Light) -> Char
'\x252C'
Parts (Vertical Weight
Empty Weight
Light) (Horizontal Weight
Heavy Weight
Light) -> Char
'\x252D'
Parts (Vertical Weight
Empty Weight
Light) (Horizontal Weight
Light Weight
Heavy) -> Char
'\x252E'
Parts (Vertical Weight
Empty Weight
Light) (Horizontal Weight
Heavy Weight
Heavy) -> Char
'\x252F'
Parts (Vertical Weight
Empty Weight
Heavy) (Horizontal Weight
Light Weight
Light) -> Char
'\x2530'
Parts (Vertical Weight
Empty Weight
Heavy) (Horizontal Weight
Heavy Weight
Light) -> Char
'\x2531'
Parts (Vertical Weight
Empty Weight
Heavy) (Horizontal Weight
Light Weight
Heavy) -> Char
'\x2532'
Parts (Vertical Weight
Empty Weight
Heavy) (Horizontal Weight
Heavy Weight
Heavy) -> Char
'\x2533'
Parts (Vertical Weight
Light Weight
Empty) (Horizontal Weight
Light Weight
Light) -> Char
'\x2534'
Parts (Vertical Weight
Light Weight
Empty) (Horizontal Weight
Heavy Weight
Light) -> Char
'\x2535'
Parts (Vertical Weight
Light Weight
Empty) (Horizontal Weight
Light Weight
Heavy) -> Char
'\x2536'
Parts (Vertical Weight
Light Weight
Empty) (Horizontal Weight
Heavy Weight
Heavy) -> Char
'\x2537'
Parts (Vertical Weight
Heavy Weight
Empty) (Horizontal Weight
Light Weight
Light) -> Char
'\x2538'
Parts (Vertical Weight
Heavy Weight
Empty) (Horizontal Weight
Heavy Weight
Light) -> Char
'\x2539'
Parts (Vertical Weight
Heavy Weight
Empty) (Horizontal Weight
Light Weight
Heavy) -> Char
'\x253A'
Parts (Vertical Weight
Heavy Weight
Empty) (Horizontal Weight
Heavy Weight
Heavy) -> Char
'\x253B'
Parts (Vertical Weight
Light Weight
Light) (Horizontal Weight
Light Weight
Light) -> Char
'\x253C'
Parts (Vertical Weight
Light Weight
Light) (Horizontal Weight
Heavy Weight
Light) -> Char
'\x253D'
Parts (Vertical Weight
Light Weight
Light) (Horizontal Weight
Light Weight
Heavy) -> Char
'\x253E'
Parts (Vertical Weight
Light Weight
Light) (Horizontal Weight
Heavy Weight
Heavy) -> Char
'\x253F'
Parts (Vertical Weight
Heavy Weight
Light) (Horizontal Weight
Light Weight
Light) -> Char
'\x2540'
Parts (Vertical Weight
Light Weight
Heavy) (Horizontal Weight
Light Weight
Light) -> Char
'\x2541'
Parts (Vertical Weight
Heavy Weight
Heavy) (Horizontal Weight
Light Weight
Light) -> Char
'\x2542'
Parts (Vertical Weight
Heavy Weight
Light) (Horizontal Weight
Heavy Weight
Light) -> Char
'\x2543'
Parts (Vertical Weight
Heavy Weight
Light) (Horizontal Weight
Light Weight
Heavy) -> Char
'\x2544'
Parts (Vertical Weight
Light Weight
Heavy) (Horizontal Weight
Heavy Weight
Light) -> Char
'\x2545'
Parts (Vertical Weight
Light Weight
Heavy) (Horizontal Weight
Light Weight
Heavy) -> Char
'\x2546'
Parts (Vertical Weight
Heavy Weight
Light) (Horizontal Weight
Heavy Weight
Heavy) -> Char
'\x2547'
Parts (Vertical Weight
Light Weight
Heavy) (Horizontal Weight
Heavy Weight
Heavy) -> Char
'\x2548'
Parts (Vertical Weight
Heavy Weight
Heavy) (Horizontal Weight
Heavy Weight
Light) -> Char
'\x2549'
Parts (Vertical Weight
Heavy Weight
Heavy) (Horizontal Weight
Light Weight
Heavy) -> Char
'\x254A'
Parts (Vertical Weight
Heavy Weight
Heavy) (Horizontal Weight
Heavy Weight
Heavy) -> Char
'\x254B'
Parts (Vertical Weight
Empty Weight
Empty) (Horizontal Weight
Light Weight
Empty) -> Char
'\x2574'
Parts (Vertical Weight
Light Weight
Empty) (Horizontal Weight
Empty Weight
Empty) -> Char
'\x2575'
Parts (Vertical Weight
Empty Weight
Empty) (Horizontal Weight
Empty Weight
Light) -> Char
'\x2576'
Parts (Vertical Weight
Empty Weight
Light) (Horizontal Weight
Empty Weight
Empty) -> Char
'\x2577'
Parts (Vertical Weight
Empty Weight
Empty) (Horizontal Weight
Heavy Weight
Empty) -> Char
'\x2578'
Parts (Vertical Weight
Heavy Weight
Empty) (Horizontal Weight
Empty Weight
Empty) -> Char
'\x2579'
Parts (Vertical Weight
Empty Weight
Empty) (Horizontal Weight
Empty Weight
Heavy) -> Char
'\x257A'
Parts (Vertical Weight
Empty Weight
Heavy) (Horizontal Weight
Empty Weight
Empty) -> Char
'\x257B'
Parts (Vertical Weight
Empty Weight
Empty) (Horizontal Weight
Light Weight
Heavy) -> Char
'\x257C'
Parts (Vertical Weight
Light Weight
Heavy) (Horizontal Weight
Empty Weight
Empty) -> Char
'\x257D'
Parts (Vertical Weight
Empty Weight
Empty) (Horizontal Weight
Heavy Weight
Light) -> Char
'\x257E'
Parts (Vertical Weight
Heavy Weight
Light) (Horizontal Weight
Empty Weight
Empty) -> Char
'\x257F'
data Directions a = Directions {Directions a -> a
vertical, Directions a -> a
horizontal :: a} deriving (Directions a -> Directions a -> Bool
(Directions a -> Directions a -> Bool)
-> (Directions a -> Directions a -> Bool) -> Eq (Directions a)
forall a. Eq a => Directions a -> Directions a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Directions a -> Directions a -> Bool
$c/= :: forall a. Eq a => Directions a -> Directions a -> Bool
== :: Directions a -> Directions a -> Bool
$c== :: forall a. Eq a => Directions a -> Directions a -> Bool
Eq, Int -> Directions a -> ShowS
[Directions a] -> ShowS
Directions a -> String
(Int -> Directions a -> ShowS)
-> (Directions a -> String)
-> ([Directions a] -> ShowS)
-> Show (Directions a)
forall a. Show a => Int -> Directions a -> ShowS
forall a. Show a => [Directions a] -> ShowS
forall a. Show a => Directions a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Directions a] -> ShowS
$cshowList :: forall a. Show a => [Directions a] -> ShowS
show :: Directions a -> String
$cshow :: forall a. Show a => Directions a -> String
showsPrec :: Int -> Directions a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Directions a -> ShowS
Show)
instance Functor Directions where
fmap :: (a -> b) -> Directions a -> Directions b
fmap a -> b
f (Directions a
a a
b) = b -> b -> Directions b
forall a. a -> a -> Directions a
Directions (a -> b
f a
a) (a -> b
f a
b)
instance Foldable Directions where
foldMap :: (a -> m) -> Directions a -> m
foldMap = (a -> m) -> Directions a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault
instance Traversable Directions where
traverse :: (a -> f b) -> Directions a -> f (Directions b)
traverse a -> f b
f (Directions a
a a
b) = (b -> b -> Directions b) -> f b -> f b -> f (Directions b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> Directions b
forall a. a -> a -> Directions a
Directions (a -> f b
f a
a) (a -> f b
f a
b)
instance Applicative Directions where
pure :: a -> Directions a
pure a
a = a -> a -> Directions a
forall a. a -> a -> Directions a
Directions a
a a
a
Directions a -> b
fa a -> b
fb <*> :: Directions (a -> b) -> Directions a -> Directions b
<*> Directions a
a a
b =
b -> b -> Directions b
forall a. a -> a -> Directions a
Directions (a -> b
fa a
a) (a -> b
fb a
b)
double :: Directions Bool -> Parts Bool -> Char
double :: Directions Bool -> Parts Bool -> Char
double Directions Bool
doubled Parts Bool
set =
Char -> (Char -> Char) -> Maybe Char -> Char
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Char
forall a. HasCallStack => String -> a
error String
"Frame.double: frame character not available") Char -> Char
forall a. a -> a
id (Maybe Char -> Char) -> Maybe Char -> Char
forall a b. (a -> b) -> a -> b
$
Directions Bool -> Parts Bool -> Maybe Char
doubleMaybe Directions Bool
doubled Parts Bool
set
doubleMaybe :: Directions Bool -> Parts Bool -> Maybe Char
doubleMaybe :: Directions Bool -> Parts Bool -> Maybe Char
doubleMaybe Directions Bool
doubled Parts Bool
set =
let adapt :: Char -> Maybe Char
adapt Char
base =
Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Maybe Char) -> Char -> Maybe Char
forall a b. (a -> b) -> a -> b
$
case Directions Bool
doubled of
Directions Bool
False Bool
False -> Parts Bool -> Char
simple Parts Bool
set
Directions Bool
False Bool
True -> Char
base
Directions Bool
True Bool
False -> Char -> Char
forall a. Enum a => a -> a
succ Char
base
Directions Bool
True Bool
True -> Char -> Char
forall a. Enum a => a -> a
succ (Char -> Char) -> Char -> Char
forall a b. (a -> b) -> a -> b
$ Char -> Char
forall a. Enum a => a -> a
succ Char
base
in case (Directions Bool
doubled, Parts Bool
set) of
(Directions Bool
_ Bool
_, Parts (Vertical Bool
False Bool
False) (Horizontal Bool
False Bool
False)) -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
' '
(Directions Bool
_ Bool
False, Parts (Vertical Bool
False Bool
False) (Horizontal Bool
True Bool
True )) -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x2500'
(Directions Bool
False Bool
_, Parts (Vertical Bool
True Bool
True ) (Horizontal Bool
False Bool
False)) -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x2502'
(Directions Bool
_ Bool
True, Parts (Vertical Bool
False Bool
False) (Horizontal Bool
True Bool
True )) -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x2550'
(Directions Bool
True Bool
_, Parts (Vertical Bool
True Bool
True ) (Horizontal Bool
False Bool
False)) -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x2551'
(Directions Bool
_ Bool
False, Parts (Vertical Bool
False Bool
False) (Horizontal Bool
True Bool
False)) -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x2574'
(Directions Bool
False Bool
_, Parts (Vertical Bool
True Bool
False) (Horizontal Bool
False Bool
False)) -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x2575'
(Directions Bool
_ Bool
False, Parts (Vertical Bool
False Bool
False) (Horizontal Bool
False Bool
True )) -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x2576'
(Directions Bool
False Bool
_, Parts (Vertical Bool
False Bool
True ) (Horizontal Bool
False Bool
False)) -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x2577'
(Directions Bool
_ Bool
True, Parts (Vertical Bool
False Bool
False) (Horizontal Bool
False Bool
True )) -> Maybe Char
forall a. Maybe a
Nothing
(Directions Bool
True Bool
_, Parts (Vertical Bool
True Bool
False) (Horizontal Bool
False Bool
False)) -> Maybe Char
forall a. Maybe a
Nothing
(Directions Bool
_ Bool
True, Parts (Vertical Bool
False Bool
False) (Horizontal Bool
True Bool
False)) -> Maybe Char
forall a. Maybe a
Nothing
(Directions Bool
True Bool
_, Parts (Vertical Bool
False Bool
True ) (Horizontal Bool
False Bool
False)) -> Maybe Char
forall a. Maybe a
Nothing
(Directions Bool
_, Parts (Vertical Bool
False Bool
True) (Horizontal Bool
False Bool
True)) -> Char -> Maybe Char
adapt Char
'\x2552'
(Directions Bool
_, Parts (Vertical Bool
False Bool
True) (Horizontal Bool
True Bool
False)) -> Char -> Maybe Char
adapt Char
'\x2555'
(Directions Bool
_, Parts (Vertical Bool
True Bool
False) (Horizontal Bool
False Bool
True)) -> Char -> Maybe Char
adapt Char
'\x2558'
(Directions Bool
_, Parts (Vertical Bool
True Bool
False) (Horizontal Bool
True Bool
False)) -> Char -> Maybe Char
adapt Char
'\x255B'
(Directions Bool
_, Parts (Vertical Bool
True Bool
True) (Horizontal Bool
False Bool
True)) -> Char -> Maybe Char
adapt Char
'\x255E'
(Directions Bool
_, Parts (Vertical Bool
True Bool
True) (Horizontal Bool
True Bool
False)) -> Char -> Maybe Char
adapt Char
'\x2561'
(Directions Bool
_, Parts (Vertical Bool
False Bool
True) (Horizontal Bool
True Bool
True)) -> Char -> Maybe Char
adapt Char
'\x2564'
(Directions Bool
_, Parts (Vertical Bool
True Bool
False) (Horizontal Bool
True Bool
True)) -> Char -> Maybe Char
adapt Char
'\x2567'
(Directions Bool
_, Parts (Vertical Bool
True Bool
True) (Horizontal Bool
True Bool
True)) -> Char -> Maybe Char
adapt Char
'\x256A'