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)


{- |
This function is not total because half-width and half-height double bars are missing.
-}
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'