module Text.Layout.Table.LineStyle
    ( -- * Line Styling
      LineStyle(..)
    , makeLineBold
    , makeLineLight
    , makeLineDashed
    , makeLineSolid

      -- * ASCII Lines and Joins
    , asciiHorizontal
    , asciiVertical
    , asciiJoinString
    , asciiJoinString4
    , roundedAsciiJoinString
    , roundedAsciiJoinString4

      -- * Unicode Lines and Joins
    , unicodeHorizontal
    , unicodeVertical
    , unicodeJoinString
    , unicodeJoinString4
    ) where

import Data.Default.Class

-- | The line styles supported by the Unicode Box-Drawing block.
data LineStyle
    = NoLine          -- ^ No lines in both orientations.
    | SingleLine      -- ^ @─@ and @│@.
    | HeavyLine       -- ^ @━@ and @┃@.
    | DoubleLine      -- ^ @═@ and @║@.
    | DashLine        -- ^ @┄@ and @┆@.
    | HeavyDashLine   -- ^ @┅@ and @┇@.
    | Dash4Line       -- ^ @┈@ and @┊@.
    | HeavyDash4Line  -- ^ @┉@ and @┋@.
    | Dash2Line       -- ^ @╌@ and @╎@.
    | HeavyDash2Line  -- ^ @╍@ and @╏@.
  deriving (LineStyle -> LineStyle -> Bool
(LineStyle -> LineStyle -> Bool)
-> (LineStyle -> LineStyle -> Bool) -> Eq LineStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineStyle -> LineStyle -> Bool
$c/= :: LineStyle -> LineStyle -> Bool
== :: LineStyle -> LineStyle -> Bool
$c== :: LineStyle -> LineStyle -> Bool
Eq)

instance Default LineStyle where
    -- | A single line.
    def :: LineStyle
def = LineStyle
SingleLine

-- | Make a 'LineStyle' bold.
makeLineBold :: LineStyle -> LineStyle
makeLineBold :: LineStyle -> LineStyle
makeLineBold LineStyle
SingleLine = LineStyle
HeavyLine
makeLineBold LineStyle
DashLine   = LineStyle
HeavyDashLine
makeLineBold LineStyle
Dash4Line  = LineStyle
HeavyDash4Line
makeLineBold LineStyle
Dash2Line  = LineStyle
HeavyDash2Line
makeLineBold LineStyle
x          = LineStyle
x

-- | Make a 'LineStyle' unbolded.
makeLineLight :: LineStyle -> LineStyle
makeLineLight :: LineStyle -> LineStyle
makeLineLight LineStyle
HeavyLine      = LineStyle
SingleLine
makeLineLight LineStyle
HeavyDashLine  = LineStyle
DashLine
makeLineLight LineStyle
HeavyDash4Line = LineStyle
Dash4Line
makeLineLight LineStyle
HeavyDash2Line = LineStyle
Dash2Line
makeLineLight LineStyle
x              = LineStyle
x

-- | Make a 'LineStyle' dashed.
makeLineDashed :: LineStyle -> LineStyle
makeLineDashed :: LineStyle -> LineStyle
makeLineDashed LineStyle
SingleLine = LineStyle
DashLine
makeLineDashed LineStyle
HeavyLine  = LineStyle
HeavyDashLine
makeLineDashed LineStyle
x          = LineStyle
x

-- | Make a 'LineStyle' solid.
makeLineSolid :: LineStyle -> LineStyle
makeLineSolid :: LineStyle -> LineStyle
makeLineSolid LineStyle
DashLine       = LineStyle
SingleLine
makeLineSolid LineStyle
Dash4Line      = LineStyle
SingleLine
makeLineSolid LineStyle
Dash2Line      = LineStyle
SingleLine
makeLineSolid LineStyle
HeavyDashLine  = LineStyle
HeavyLine
makeLineSolid LineStyle
HeavyDash4Line = LineStyle
HeavyLine
makeLineSolid LineStyle
HeavyDash2Line = LineStyle
HeavyLine
makeLineSolid LineStyle
x              = LineStyle
x

-- | Join styles supported by the Unicode Box-Drawing block.
data UnicodeJoin = NoJoin | Light | Heavy | Double

-- | The 'UnicodeJoin' associated to each 'LineStyle'.
joinType :: LineStyle -> UnicodeJoin
joinType :: LineStyle -> UnicodeJoin
joinType LineStyle
NoLine          = UnicodeJoin
NoJoin
joinType LineStyle
SingleLine      = UnicodeJoin
Light
joinType LineStyle
DashLine        = UnicodeJoin
Light
joinType LineStyle
Dash4Line       = UnicodeJoin
Light
joinType LineStyle
Dash2Line       = UnicodeJoin
Light
joinType LineStyle
HeavyLine       = UnicodeJoin
Heavy
joinType LineStyle
HeavyDashLine   = UnicodeJoin
Heavy
joinType LineStyle
HeavyDash4Line  = UnicodeJoin
Heavy
joinType LineStyle
HeavyDash2Line  = UnicodeJoin
Heavy
joinType LineStyle
DoubleLine      = UnicodeJoin
Double


-- | ASCII representations for horizontal lines.
asciiHorizontal :: LineStyle -> String
asciiHorizontal :: LineStyle -> String
asciiHorizontal LineStyle
NoLine     = String
""
asciiHorizontal LineStyle
DoubleLine = String
"="
asciiHorizontal LineStyle
_          = String
"-"

-- | ASCII representations for vertical lines.
asciiVertical :: LineStyle -> String
asciiVertical :: LineStyle -> String
asciiVertical LineStyle
NoLine     = String
""
asciiVertical LineStyle
DoubleLine = String
"||"
asciiVertical LineStyle
_          = String
"|"

-- | ASCII representations for joins using pluses.
asciiJoinString :: LineStyle -> LineStyle -> String
asciiJoinString :: LineStyle -> LineStyle -> String
asciiJoinString LineStyle
h LineStyle
v = LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
asciiJoinString4 LineStyle
h LineStyle
h LineStyle
v LineStyle
v

-- | ASCII representations for joins using rounded joins.
roundedAsciiJoinString :: LineStyle -> LineStyle -> String
roundedAsciiJoinString :: LineStyle -> LineStyle -> String
roundedAsciiJoinString LineStyle
h LineStyle
v = LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
roundedAsciiJoinString4 LineStyle
h LineStyle
h LineStyle
v LineStyle
v

-- | ASCII interior joins, allowing the lines to change when passing through the vertex.
-- Uses pluses for joins. The argument order is west, east, north, then south.
asciiJoinString4 :: LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
asciiJoinString4 :: LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
asciiJoinString4 LineStyle
NoLine LineStyle
NoLine LineStyle
NoLine LineStyle
NoLine          = String
" "
asciiJoinString4 LineStyle
NoLine LineStyle
NoLine LineStyle
n      LineStyle
s      | LineStyle
n LineStyle -> LineStyle -> Bool
forall a. Eq a => a -> a -> Bool
== LineStyle
s = LineStyle -> String
asciiVertical LineStyle
n
asciiJoinString4 LineStyle
w      LineStyle
e      LineStyle
NoLine LineStyle
NoLine | LineStyle
w LineStyle -> LineStyle -> Bool
forall a. Eq a => a -> a -> Bool
== LineStyle
e = LineStyle -> String
asciiHorizontal LineStyle
w
asciiJoinString4 LineStyle
w      LineStyle
e      LineStyle
n      LineStyle
s               = LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
aJoins LineStyle
w LineStyle
e LineStyle
n LineStyle
s

-- | ASCII interior joins, allowing the lines to change when passing through the vertex.
-- Uses rounded joins. The argument order is west, east, north, then south.
roundedAsciiJoinString4 :: LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
roundedAsciiJoinString4 :: LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
roundedAsciiJoinString4 LineStyle
NoLine LineStyle
NoLine LineStyle
NoLine LineStyle
NoLine          = String
" "
roundedAsciiJoinString4 LineStyle
NoLine LineStyle
NoLine LineStyle
n      LineStyle
s      | LineStyle
n LineStyle -> LineStyle -> Bool
forall a. Eq a => a -> a -> Bool
== LineStyle
s = LineStyle -> String
asciiVertical LineStyle
n
roundedAsciiJoinString4 LineStyle
w      LineStyle
e      LineStyle
NoLine LineStyle
NoLine | LineStyle
w LineStyle -> LineStyle -> Bool
forall a. Eq a => a -> a -> Bool
== LineStyle
e = LineStyle -> String
asciiHorizontal LineStyle
w
roundedAsciiJoinString4 LineStyle
w      LineStyle
e      LineStyle
n      LineStyle
s               = LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
arJoins LineStyle
w LineStyle
e LineStyle
n LineStyle
s

-- | Draw ASCII line joins with pluses. Arguments are in the order west, east,
-- north, south.
--
-- Only 'NoLine', 'SingleLine', and 'DoubleLine' are supported by ASCII. Other
-- line styles are treated as 'SingleLine'.
aJoins :: LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
aJoins :: LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
aJoins LineStyle
_ LineStyle
_ LineStyle
DoubleLine LineStyle
_          = String
"++"
aJoins LineStyle
_ LineStyle
_ LineStyle
_          LineStyle
DoubleLine = String
"++"
aJoins LineStyle
_ LineStyle
_ LineStyle
_          LineStyle
_          = String
"+"

-- | Draw ASCII line joins with rounded joins. Arguments are in order west,
-- east, north, south.
--
-- Only 'NoLine', 'SingleLine', and 'DoubleLine' are supported by ASCII. Other
-- line styles are treated as 'SingleLine'.
arJoins :: LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
-- Top joins
arJoins :: LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
arJoins LineStyle
_          LineStyle
_          LineStyle
NoLine     LineStyle
DoubleLine = String
".."
arJoins LineStyle
_          LineStyle
_          LineStyle
NoLine     LineStyle
_          = String
"."
-- Bottom joins
arJoins LineStyle
_          LineStyle
_          LineStyle
DoubleLine LineStyle
NoLine     = String
"''"
arJoins LineStyle
_          LineStyle
_          LineStyle
_          LineStyle
NoLine     = String
"'"
-- T-joins
arJoins LineStyle
NoLine     LineStyle
_          LineStyle
SingleLine LineStyle
SingleLine = String
":"
arJoins LineStyle
_          LineStyle
NoLine     LineStyle
SingleLine LineStyle
SingleLine = String
":"
arJoins LineStyle
NoLine     LineStyle
_          LineStyle
DoubleLine LineStyle
DoubleLine = String
"::"
arJoins LineStyle
_          LineStyle
NoLine     LineStyle
DoubleLine LineStyle
DoubleLine = String
"::"
-- Left joins
arJoins LineStyle
NoLine     LineStyle
DoubleLine LineStyle
DoubleLine LineStyle
_          = String
"::"
arJoins LineStyle
NoLine     LineStyle
DoubleLine LineStyle
_          LineStyle
_          = String
":"
arJoins LineStyle
NoLine     LineStyle
SingleLine LineStyle
DoubleLine LineStyle
_          = String
"++"
arJoins LineStyle
NoLine     LineStyle
SingleLine LineStyle
_          LineStyle
_          = String
"+"
-- Right joins
arJoins LineStyle
DoubleLine LineStyle
NoLine     LineStyle
DoubleLine LineStyle
_          = String
"::"
arJoins LineStyle
DoubleLine LineStyle
NoLine     LineStyle
_          LineStyle
_          = String
":"
arJoins LineStyle
SingleLine LineStyle
NoLine     LineStyle
DoubleLine LineStyle
_          = String
"++"
arJoins LineStyle
SingleLine LineStyle
NoLine     LineStyle
_          LineStyle
_          = String
"+"
-- Interior joins
arJoins LineStyle
DoubleLine LineStyle
_          LineStyle
DoubleLine LineStyle
_          = String
"::"
arJoins LineStyle
DoubleLine LineStyle
_          LineStyle
_          LineStyle
_          = String
":"
arJoins LineStyle
_          LineStyle
_          LineStyle
DoubleLine LineStyle
_          = String
"++"
arJoins LineStyle
_          LineStyle
_          LineStyle
_          LineStyle
_          = String
"+"


-- | Unicode representations for horizontal lines.
unicodeHorizontal :: LineStyle -> String
unicodeHorizontal :: LineStyle -> String
unicodeHorizontal LineStyle
NoLine         = String
""
unicodeHorizontal LineStyle
SingleLine     = String
"─"
unicodeHorizontal LineStyle
HeavyLine      = String
"━"
unicodeHorizontal LineStyle
DoubleLine     = String
"═"
unicodeHorizontal LineStyle
DashLine       = String
"┄"
unicodeHorizontal LineStyle
HeavyDashLine  = String
"┅"
unicodeHorizontal LineStyle
Dash4Line      = String
"┈"
unicodeHorizontal LineStyle
HeavyDash4Line = String
"┉"
unicodeHorizontal LineStyle
Dash2Line      = String
"╌"
unicodeHorizontal LineStyle
HeavyDash2Line = String
"╍"

-- | Unicode representations for vertical lines.
unicodeVertical :: LineStyle -> String
unicodeVertical :: LineStyle -> String
unicodeVertical LineStyle
NoLine         = String
""
unicodeVertical LineStyle
SingleLine     = String
"│"
unicodeVertical LineStyle
HeavyLine      = String
"┃"
unicodeVertical LineStyle
DoubleLine     = String
"║"
unicodeVertical LineStyle
DashLine       = String
"┆"
unicodeVertical LineStyle
HeavyDashLine  = String
"┇"
unicodeVertical LineStyle
Dash4Line      = String
"┊"
unicodeVertical LineStyle
HeavyDash4Line = String
"┋"
unicodeVertical LineStyle
Dash2Line      = String
"╎"
unicodeVertical LineStyle
HeavyDash2Line = String
"╏"

-- | Unicode interior joins, specifying the horizontal and vertical lines.
unicodeJoinString :: LineStyle -> LineStyle -> String
unicodeJoinString :: LineStyle -> LineStyle -> String
unicodeJoinString LineStyle
h LineStyle
v = LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
unicodeJoinString4 LineStyle
h LineStyle
h LineStyle
v LineStyle
v

-- | Unicode interior joins, allowing the lines to change when passing through the vertex.
unicodeJoinString4
    :: LineStyle -- ^ 'LineStyle' of the line coming from the west.
    -> LineStyle -- ^ 'LineStyle' of the line coming from the east.
    -> LineStyle -- ^ 'LineStyle' of the line coming from the north.
    -> LineStyle -- ^ 'LineStyle' of the line coming from the south.
    -> String
unicodeJoinString4 :: LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
unicodeJoinString4 LineStyle
NoLine LineStyle
NoLine LineStyle
NoLine LineStyle
NoLine          = String
" "
unicodeJoinString4 LineStyle
NoLine LineStyle
NoLine LineStyle
n      LineStyle
s      | LineStyle
n LineStyle -> LineStyle -> Bool
forall a. Eq a => a -> a -> Bool
== LineStyle
s = LineStyle -> String
unicodeVertical LineStyle
n
unicodeJoinString4 LineStyle
w      LineStyle
e      LineStyle
NoLine LineStyle
NoLine | LineStyle
w LineStyle -> LineStyle -> Bool
forall a. Eq a => a -> a -> Bool
== LineStyle
e = LineStyle -> String
unicodeHorizontal LineStyle
w
unicodeJoinString4 LineStyle
w      LineStyle
e      LineStyle
n      LineStyle
s               = Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> String) -> Char -> String
forall a b. (a -> b) -> a -> b
$ UnicodeJoin -> UnicodeJoin -> UnicodeJoin -> UnicodeJoin -> Char
uJoins (LineStyle -> UnicodeJoin
joinType LineStyle
w) (LineStyle -> UnicodeJoin
joinType LineStyle
e) (LineStyle -> UnicodeJoin
joinType LineStyle
n) (LineStyle -> UnicodeJoin
joinType LineStyle
s)

-- | Find the Unicode box-drawing character which joins lines of given weights.
-- Arguments are in order west, east, north, south.
--
-- Not all joins are fully supported by Unicode, and in these cases we try to
-- gracefully substitute a similar character.
-- - Any join consisting solely of 'NoJoin', 'Light, and 'Heavy' is fully supported.
-- - Most joins consisting solely of 'NoJoin', 'Light, and 'Double' are supported.
--   For those that aren't, we substitute 'Heavy' for 'Double'.
-- - Any join which has both 'Heavy' and 'Double' is unsupported, and we
--   substitute 'Heavy' for 'Double'.
uJoins :: UnicodeJoin -> UnicodeJoin -> UnicodeJoin -> UnicodeJoin -> Char
-- All NoJoin, 1 case
uJoins :: UnicodeJoin -> UnicodeJoin -> UnicodeJoin -> UnicodeJoin -> Char
uJoins UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
NoJoin = Char
' '
-- Using NoJoin and Light, 15 cases
uJoins UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
Light  = Char
'│'
uJoins UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
NoJoin = Char
'─'
uJoins UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
Light  = Char
'┼'
uJoins UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
Light  = Char
'╷'
uJoins UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
NoJoin = Char
'╵'
uJoins UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
NoJoin = Char
'╶'
uJoins UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
NoJoin = Char
'╴'
uJoins UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
Light  = Char
'┌'
uJoins UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
NoJoin = Char
'└'
uJoins UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
Light  = Char
'┐'
uJoins UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
NoJoin = Char
'┘'
uJoins UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
Light  = Char
'├'
uJoins UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
Light  = Char
'┤'
uJoins UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
Light  = Char
'┬'
uJoins UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
NoJoin = Char
'┴'
-- Using NoJoin and Heavy, 15 cases
uJoins UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
Heavy  UnicodeJoin
Heavy  = Char
'┃'
uJoins UnicodeJoin
Heavy  UnicodeJoin
Heavy  UnicodeJoin
NoJoin UnicodeJoin
NoJoin = Char
'━'
uJoins UnicodeJoin
Heavy  UnicodeJoin
Heavy  UnicodeJoin
Heavy  UnicodeJoin
Heavy  = Char
'╋'
uJoins UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
Heavy  = Char
'╻'
uJoins UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
Heavy  UnicodeJoin
NoJoin = Char
'╹'
uJoins UnicodeJoin
NoJoin UnicodeJoin
Heavy  UnicodeJoin
NoJoin UnicodeJoin
NoJoin = Char
'╺'
uJoins UnicodeJoin
Heavy  UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
NoJoin = Char
'╸'
uJoins UnicodeJoin
NoJoin UnicodeJoin
Heavy  UnicodeJoin
NoJoin UnicodeJoin
Heavy  = Char
'┏'
uJoins UnicodeJoin
NoJoin UnicodeJoin
Heavy  UnicodeJoin
Heavy  UnicodeJoin
NoJoin = Char
'┗'
uJoins UnicodeJoin
Heavy  UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
Heavy  = Char
'┓'
uJoins UnicodeJoin
Heavy  UnicodeJoin
NoJoin UnicodeJoin
Heavy  UnicodeJoin
NoJoin = Char
'┛'
uJoins UnicodeJoin
NoJoin UnicodeJoin
Heavy  UnicodeJoin
Heavy  UnicodeJoin
Heavy  = Char
'┣'
uJoins UnicodeJoin
Heavy  UnicodeJoin
NoJoin UnicodeJoin
Heavy  UnicodeJoin
Heavy  = Char
'┫'
uJoins UnicodeJoin
Heavy  UnicodeJoin
Heavy  UnicodeJoin
NoJoin UnicodeJoin
Heavy  = Char
'┳'
uJoins UnicodeJoin
Heavy  UnicodeJoin
Heavy  UnicodeJoin
Heavy  UnicodeJoin
NoJoin = Char
'┻'
-- Using NoJoin and Light with two Heavy, 18 cases
uJoins UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
Heavy  UnicodeJoin
Heavy  = Char
'┠'
uJoins UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
Heavy  UnicodeJoin
Heavy  = Char
'┨'
uJoins UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
Heavy  UnicodeJoin
Heavy  = Char
'╂'
uJoins UnicodeJoin
Heavy  UnicodeJoin
Heavy  UnicodeJoin
NoJoin UnicodeJoin
Light  = Char
'┯'
uJoins UnicodeJoin
Heavy  UnicodeJoin
Heavy  UnicodeJoin
Light  UnicodeJoin
NoJoin = Char
'┷'
uJoins UnicodeJoin
Heavy  UnicodeJoin
Heavy  UnicodeJoin
Light  UnicodeJoin
Light  = Char
'┿'
uJoins UnicodeJoin
NoJoin UnicodeJoin
Heavy  UnicodeJoin
Light  UnicodeJoin
Heavy  = Char
'┢'
uJoins UnicodeJoin
Light  UnicodeJoin
Heavy  UnicodeJoin
NoJoin UnicodeJoin
Heavy  = Char
'┲'
uJoins UnicodeJoin
Light  UnicodeJoin
Heavy  UnicodeJoin
Light  UnicodeJoin
Heavy  = Char
'╆'
uJoins UnicodeJoin
NoJoin UnicodeJoin
Heavy  UnicodeJoin
Heavy  UnicodeJoin
Light  = Char
'┡'
uJoins UnicodeJoin
Light  UnicodeJoin
Heavy  UnicodeJoin
Heavy  UnicodeJoin
NoJoin = Char
'┺'
uJoins UnicodeJoin
Light  UnicodeJoin
Heavy  UnicodeJoin
Heavy  UnicodeJoin
Light  = Char
'╄'
uJoins UnicodeJoin
Heavy  UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
Heavy  = Char
'┪'
uJoins UnicodeJoin
Heavy  UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
Heavy  = Char
'┱'
uJoins UnicodeJoin
Heavy  UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
Heavy  = Char
'╅'
uJoins UnicodeJoin
Heavy  UnicodeJoin
NoJoin UnicodeJoin
Heavy  UnicodeJoin
Light  = Char
'┩'
uJoins UnicodeJoin
Heavy  UnicodeJoin
Light  UnicodeJoin
Heavy  UnicodeJoin
NoJoin = Char
'┹'
uJoins UnicodeJoin
Heavy  UnicodeJoin
Light  UnicodeJoin
Heavy  UnicodeJoin
Light  = Char
'╃'
-- Using NoJoin and Light with southward Heavy, 7 cases
uJoins UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
Heavy  = Char
'╽'
uJoins UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
Heavy  = Char
'┎'
uJoins UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
Heavy  = Char
'┟'
uJoins UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
Heavy  = Char
'┒'
uJoins UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
Heavy  = Char
'┧'
uJoins UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
Heavy  = Char
'┰'
uJoins UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
Heavy  = Char
'╁'
-- Using NoJoin and Light with northward Heavy, 7 cases
uJoins UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
Heavy  UnicodeJoin
Light  = Char
'╿'
uJoins UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
Heavy  UnicodeJoin
NoJoin = Char
'┖'
uJoins UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
Heavy  UnicodeJoin
Light  = Char
'┞'
uJoins UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
Heavy  UnicodeJoin
NoJoin = Char
'┚'
uJoins UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
Heavy  UnicodeJoin
Light  = Char
'┦'
uJoins UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
Heavy  UnicodeJoin
NoJoin = Char
'┸'
uJoins UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
Heavy  UnicodeJoin
Light  = Char
'╀'
-- Using NoJoin and Light with westward Heavy, 7 cases
uJoins UnicodeJoin
NoJoin UnicodeJoin
Heavy  UnicodeJoin
NoJoin UnicodeJoin
Light  = Char
'┍'
uJoins UnicodeJoin
NoJoin UnicodeJoin
Heavy  UnicodeJoin
Light  UnicodeJoin
NoJoin = Char
'┕'
uJoins UnicodeJoin
NoJoin UnicodeJoin
Heavy  UnicodeJoin
Light  UnicodeJoin
Light  = Char
'┝'
uJoins UnicodeJoin
Light  UnicodeJoin
Heavy  UnicodeJoin
NoJoin UnicodeJoin
NoJoin = Char
'╼'
uJoins UnicodeJoin
Light  UnicodeJoin
Heavy  UnicodeJoin
NoJoin UnicodeJoin
Light  = Char
'┮'
uJoins UnicodeJoin
Light  UnicodeJoin
Heavy  UnicodeJoin
Light  UnicodeJoin
NoJoin = Char
'┶'
uJoins UnicodeJoin
Light  UnicodeJoin
Heavy  UnicodeJoin
Light  UnicodeJoin
Light  = Char
'┾'
-- Using NoJoin and Light with eastward Heavy, 7 cases
uJoins UnicodeJoin
Heavy  UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
Light  = Char
'┑'
uJoins UnicodeJoin
Heavy  UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
NoJoin = Char
'┙'
uJoins UnicodeJoin
Heavy  UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
Light  = Char
'┥'
uJoins UnicodeJoin
Heavy  UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
NoJoin = Char
'╾'
uJoins UnicodeJoin
Heavy  UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
Light  = Char
'┭'
uJoins UnicodeJoin
Heavy  UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
NoJoin = Char
'┵'
uJoins UnicodeJoin
Heavy  UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
Light  = Char
'┽'
-- Using Light and three Heavy, 4 cases
uJoins UnicodeJoin
Light  UnicodeJoin
Heavy  UnicodeJoin
Heavy  UnicodeJoin
Heavy  = Char
'╊'
uJoins UnicodeJoin
Heavy  UnicodeJoin
Light  UnicodeJoin
Heavy  UnicodeJoin
Heavy  = Char
'╉'
uJoins UnicodeJoin
Heavy  UnicodeJoin
Heavy  UnicodeJoin
Light  UnicodeJoin
Heavy  = Char
'╈'
uJoins UnicodeJoin
Heavy  UnicodeJoin
Heavy  UnicodeJoin
Heavy  UnicodeJoin
Light  = Char
'╇'
-- Up to this point we have defined all joins of NoJoin, Light, and Heavy, 81 cases total
-- Using NoJoin and Double, 15 cases
uJoins UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
Double UnicodeJoin
Double = Char
'║'
uJoins UnicodeJoin
Double UnicodeJoin
Double UnicodeJoin
NoJoin UnicodeJoin
NoJoin = Char
'═'
uJoins UnicodeJoin
Double UnicodeJoin
Double UnicodeJoin
Double UnicodeJoin
Double = Char
'╬'
uJoins UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
Double = Char
'╻'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
Double UnicodeJoin
NoJoin = Char
'╹'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
NoJoin UnicodeJoin
Double UnicodeJoin
NoJoin UnicodeJoin
NoJoin = Char
'╺'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
Double UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
NoJoin = Char
'╸'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
NoJoin UnicodeJoin
Double UnicodeJoin
NoJoin UnicodeJoin
Double = Char
'╔'
uJoins UnicodeJoin
NoJoin UnicodeJoin
Double UnicodeJoin
Double UnicodeJoin
NoJoin = Char
'╚'
uJoins UnicodeJoin
Double UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
Double = Char
'╗'
uJoins UnicodeJoin
Double UnicodeJoin
NoJoin UnicodeJoin
Double UnicodeJoin
NoJoin = Char
'╝'
uJoins UnicodeJoin
NoJoin UnicodeJoin
Double UnicodeJoin
Double UnicodeJoin
Double = Char
'╠'
uJoins UnicodeJoin
Double UnicodeJoin
NoJoin UnicodeJoin
Double UnicodeJoin
Double = Char
'╣'
uJoins UnicodeJoin
Double UnicodeJoin
Double UnicodeJoin
NoJoin UnicodeJoin
Double = Char
'╦'
uJoins UnicodeJoin
Double UnicodeJoin
Double UnicodeJoin
Double UnicodeJoin
NoJoin = Char
'╩'
-- Using NoJoin and Light with two Double, 18 cases
uJoins UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
Double UnicodeJoin
Double = Char
'╟'
uJoins UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
Double UnicodeJoin
Double = Char
'╢'
uJoins UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
Double UnicodeJoin
Double = Char
'╫'
uJoins UnicodeJoin
Double UnicodeJoin
Double UnicodeJoin
NoJoin UnicodeJoin
Light  = Char
'╤'
uJoins UnicodeJoin
Double UnicodeJoin
Double UnicodeJoin
Light  UnicodeJoin
NoJoin = Char
'╧'
uJoins UnicodeJoin
Double UnicodeJoin
Double UnicodeJoin
Light  UnicodeJoin
Light  = Char
'╪'
uJoins UnicodeJoin
NoJoin UnicodeJoin
Double UnicodeJoin
Light  UnicodeJoin
Double = Char
'┢'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
Light  UnicodeJoin
Double UnicodeJoin
NoJoin UnicodeJoin
Double = Char
'┲'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
Light  UnicodeJoin
Double UnicodeJoin
Light  UnicodeJoin
Double = Char
'╆'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
NoJoin UnicodeJoin
Double UnicodeJoin
Double UnicodeJoin
Light  = Char
'┡'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
Light  UnicodeJoin
Double UnicodeJoin
Double UnicodeJoin
NoJoin = Char
'┺'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
Light  UnicodeJoin
Double UnicodeJoin
Double UnicodeJoin
Light  = Char
'╄'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
Double UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
Double = Char
'┪'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
Double UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
Double = Char
'┱'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
Double UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
Double = Char
'╅'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
Double UnicodeJoin
NoJoin UnicodeJoin
Double UnicodeJoin
Light  = Char
'┩'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
Double UnicodeJoin
Light  UnicodeJoin
Double UnicodeJoin
NoJoin = Char
'┹'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
Double UnicodeJoin
Light  UnicodeJoin
Double UnicodeJoin
Light  = Char
'╃'  -- Not available, use Heavy instead of Double
-- Using NoJoin and Light with southward Double, 7 cases
uJoins UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
Double = Char
'╽'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
Double = Char
'╓'
uJoins UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
Double = Char
'┟'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
Double = Char
'╖'
uJoins UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
Double = Char
'┧'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
Double = Char
'╥'
uJoins UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
Double = Char
'╁'  -- Not available, use Heavy instead of Double
-- Using NoJoin and Light with northward Double, 7 cases
uJoins UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
Double UnicodeJoin
Light  = Char
'╿'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
Double UnicodeJoin
NoJoin = Char
'╙'
uJoins UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
Double UnicodeJoin
Light  = Char
'┞'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
Double UnicodeJoin
NoJoin = Char
'╜'
uJoins UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
Double UnicodeJoin
Light  = Char
'┦'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
Double UnicodeJoin
NoJoin = Char
'╨'
uJoins UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
Double UnicodeJoin
Light  = Char
'╀'  -- Not available, use Heavy instead of Double
-- Using NoJoin and Light with westward Double, 7 cases
uJoins UnicodeJoin
NoJoin UnicodeJoin
Double UnicodeJoin
NoJoin UnicodeJoin
Light  = Char
'╓'
uJoins UnicodeJoin
NoJoin UnicodeJoin
Double UnicodeJoin
Light  UnicodeJoin
NoJoin = Char
'╘'
uJoins UnicodeJoin
NoJoin UnicodeJoin
Double UnicodeJoin
Light  UnicodeJoin
Light  = Char
'╞'
uJoins UnicodeJoin
Light  UnicodeJoin
Double UnicodeJoin
NoJoin UnicodeJoin
NoJoin = Char
'╼'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
Light  UnicodeJoin
Double UnicodeJoin
NoJoin UnicodeJoin
Light  = Char
'┮'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
Light  UnicodeJoin
Double UnicodeJoin
Light  UnicodeJoin
NoJoin = Char
'┶'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
Light  UnicodeJoin
Double UnicodeJoin
Light  UnicodeJoin
Light  = Char
'┾'  -- Not available, use Heavy instead of Double
-- Using NoJoin and Light with eastward Double, 7 cases
uJoins UnicodeJoin
Double UnicodeJoin
NoJoin UnicodeJoin
NoJoin UnicodeJoin
Light  = Char
'╕'
uJoins UnicodeJoin
Double UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
NoJoin = Char
'╛'
uJoins UnicodeJoin
Double UnicodeJoin
NoJoin UnicodeJoin
Light  UnicodeJoin
Light  = Char
'╡'
uJoins UnicodeJoin
Double UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
NoJoin = Char
'╾'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
Double UnicodeJoin
Light  UnicodeJoin
NoJoin UnicodeJoin
Light  = Char
'┭'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
Double UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
NoJoin = Char
'┵'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
Double UnicodeJoin
Light  UnicodeJoin
Light  UnicodeJoin
Light  = Char
'┽'  -- Not available, use Heavy instead of Double
-- Using Light and three Double, 4 cases
uJoins UnicodeJoin
Light  UnicodeJoin
Double UnicodeJoin
Double UnicodeJoin
Double = Char
'╊'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
Double UnicodeJoin
Light  UnicodeJoin
Double UnicodeJoin
Double = Char
'╉'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
Double UnicodeJoin
Double UnicodeJoin
Light  UnicodeJoin
Double = Char
'╈'  -- Not available, use Heavy instead of Double
uJoins UnicodeJoin
Double UnicodeJoin
Double UnicodeJoin
Double UnicodeJoin
Light  = Char
'╇'  -- Not available, use Heavy instead of Double
-- Up to this point we have defined all joins of NoJoin, Light, and Double, 146 cases total
-- Beyond this point, all cases involve at least one of each of Heavy and
-- Double, for which there are no join glyphs defined in Unicode. For these, we degrade any
-- Double to a Heavy.
-- An alternate degradation path is Heavy -> Single, but for some of these
-- there would be a second degradation Double -> Heavy afterwards. It's unclear
-- which of these options is better.
uJoins UnicodeJoin
e UnicodeJoin
w UnicodeJoin
n UnicodeJoin
s = UnicodeJoin -> UnicodeJoin -> UnicodeJoin -> UnicodeJoin -> Char
uJoins (UnicodeJoin -> UnicodeJoin
degrade UnicodeJoin
e) (UnicodeJoin -> UnicodeJoin
degrade UnicodeJoin
w) (UnicodeJoin -> UnicodeJoin
degrade UnicodeJoin
n) (UnicodeJoin -> UnicodeJoin
degrade UnicodeJoin
s)
  where
    degrade :: UnicodeJoin -> UnicodeJoin
degrade UnicodeJoin
Double = UnicodeJoin
Heavy
    degrade UnicodeJoin
x      = UnicodeJoin
x