{-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RecordWildCards #-}

-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com
-- SPDX-License-Identifier: MIT

module Margin (defaultMargin, withMargin, withLines, WithMargin) where

import CST
import Data.Char (GeneralCategory (..), generalCategory)
import qualified Data.Text as T
import Lining (LineFormat (..), ToSingleLine (..))
import Render (Render (..))

defaultMargin :: Int
defaultMargin :: Int
defaultMargin = Int
80

withMargin :: (WithMargin a) => Int -> a -> a
withMargin :: forall a. WithMargin a => Int -> a -> a
withMargin Int
margin = (Int, Int) -> a -> a
forall a. WithMargin a => (Int, Int) -> a -> a
withMargin' (Int
0, Int
margin)

withLines :: (WithMargin a, ToSingleLine a) => LineFormat -> Int -> a -> a
withLines :: forall a.
(WithMargin a, ToSingleLine a) =>
LineFormat -> Int -> a -> a
withLines LineFormat
SINGLELINE Int
_ = a -> a
forall a. ToSingleLine a => a -> a
toSingleLine
withLines LineFormat
MULTILINE Int
margin = Int -> a -> a
forall a. WithMargin a => Int -> a -> a
withMargin Int
margin

class WithMargin a where
  withMargin' :: (Int, Int) -> a -> a

instance WithMargin EXPRESSION where
  withMargin' :: (Int, Int) -> EXPRESSION -> EXPRESSION
withMargin' (Int, Int)
_ ex :: EXPRESSION
ex@EX_FORMATION{$sel:binding:EX_GLOBAL :: EXPRESSION -> BINDING
binding = BI_EMPTY{}} = EXPRESSION
ex
  withMargin' (Int
extra, Int
margin) ex :: EXPRESSION
ex@EX_FORMATION{$sel:tab:EX_GLOBAL :: EXPRESSION -> TAB
tab = tab :: TAB
tab@(TAB Int
indent), BINDING
TAB
EOL
RSB
LSB
$sel:binding:EX_GLOBAL :: EXPRESSION -> BINDING
lsb :: LSB
eol :: EOL
binding :: BINDING
eol' :: EOL
tab' :: TAB
rsb :: RSB
$sel:lsb:EX_GLOBAL :: EXPRESSION -> LSB
$sel:eol:EX_GLOBAL :: EXPRESSION -> EOL
$sel:eol':EX_GLOBAL :: EXPRESSION -> EOL
$sel:tab':EX_GLOBAL :: EXPRESSION -> TAB
$sel:rsb:EX_GLOBAL :: EXPRESSION -> RSB
..} =
    let single :: EXPRESSION
single = EXPRESSION -> EXPRESSION
forall a. ToSingleLine a => a -> a
toSingleLine EXPRESSION
ex
        ex' :: EXPRESSION
ex' = LSB -> EOL -> TAB -> BINDING -> EOL -> TAB -> RSB -> EXPRESSION
EX_FORMATION LSB
lsb EOL
EOL TAB
tab ((Int, Int) -> BINDING -> BINDING
forall a. WithMargin a => (Int, Int) -> a -> a
withMargin' (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
indent, Int
margin) BINDING
binding) EOL
EOL TAB
tab' RSB
rsb
     in if EXPRESSION -> Int
forall a. Render a => a -> Int
lengthOf EXPRESSION
single Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
extra Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
margin then EXPRESSION
single else EXPRESSION
ex'
  withMargin' (Int, Int)
_ num :: EXPRESSION
num@EX_NUMBER{} = EXPRESSION
num
  withMargin' (Int, Int)
_ str :: EXPRESSION
str@EX_STRING{} = EXPRESSION
str
  withMargin' (Int
extra, Int
margin) EX_DISPATCH{ATTRIBUTE
EXPRESSION
SPACE
expr :: EXPRESSION
space :: SPACE
attr :: ATTRIBUTE
$sel:attr:EX_GLOBAL :: EXPRESSION -> ATTRIBUTE
$sel:expr:EX_GLOBAL :: EXPRESSION -> EXPRESSION
$sel:space:EX_GLOBAL :: EXPRESSION -> SPACE
..} = EXPRESSION -> SPACE -> ATTRIBUTE -> EXPRESSION
EX_DISPATCH ((Int, Int) -> EXPRESSION -> EXPRESSION
forall a. WithMargin a => (Int, Int) -> a -> a
withMargin' (Int
extra, Int
margin Int -> Int -> Int
forall a. Num a => a -> a -> a
- ATTRIBUTE -> Int
forall a. Render a => a -> Int
lengthOf ATTRIBUTE
attr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) EXPRESSION
expr) SPACE
space ATTRIBUTE
attr
  withMargin' (Int, Int)
cfg EX_PHI_AGAIN{Int
Maybe String
EXPRESSION
$sel:expr:EX_GLOBAL :: EXPRESSION -> EXPRESSION
prefix :: Maybe String
idx :: Int
expr :: EXPRESSION
$sel:prefix:EX_GLOBAL :: EXPRESSION -> Maybe String
$sel:idx:EX_GLOBAL :: EXPRESSION -> Int
..} = Maybe String -> Int -> EXPRESSION -> EXPRESSION
EX_PHI_AGAIN Maybe String
prefix Int
idx ((Int, Int) -> EXPRESSION -> EXPRESSION
forall a. WithMargin a => (Int, Int) -> a -> a
withMargin' (Int, Int)
cfg EXPRESSION
expr)
  withMargin' (Int, Int)
_ EX_PHI_MEET{Int
Maybe String
EXPRESSION
$sel:expr:EX_GLOBAL :: EXPRESSION -> EXPRESSION
$sel:prefix:EX_GLOBAL :: EXPRESSION -> Maybe String
$sel:idx:EX_GLOBAL :: EXPRESSION -> Int
prefix :: Maybe String
idx :: Int
expr :: EXPRESSION
..} = Maybe String -> Int -> EXPRESSION -> EXPRESSION
EX_PHI_MEET Maybe String
prefix Int
idx (EXPRESSION -> EXPRESSION
forall a. ToSingleLine a => a -> a
toSingleLine EXPRESSION
expr)
  withMargin' cfg :: (Int, Int)
cfg@(Int
extra, Int
margin) ex :: EXPRESSION
ex@EX_SINGLE{$sel:pair:EX_GLOBAL :: EXPRESSION -> PAIR
pair = PA_TAU{ATTRIBUTE
EXPRESSION
ARROW
attr :: ATTRIBUTE
arrow :: ARROW
expr :: EXPRESSION
$sel:attr:PA_TAU :: PAIR -> ATTRIBUTE
$sel:arrow:PA_TAU :: PAIR -> ARROW
$sel:expr:PA_TAU :: PAIR -> EXPRESSION
..}, EXPRESSION
SPACE
$sel:space:EX_GLOBAL :: EXPRESSION -> SPACE
space :: SPACE
formation :: EXPRESSION
$sel:formation:EX_GLOBAL :: EXPRESSION -> EXPRESSION
..} =
    let single :: EXPRESSION
single = EXPRESSION -> EXPRESSION
forall a. ToSingleLine a => a -> a
toSingleLine EXPRESSION
ex
        asset :: EXPRESSION
asset = (Int, Int) -> EXPRESSION -> EXPRESSION
forall a. WithMargin a => (Int, Int) -> a -> a
withMargin' (Int
extra, Int
margin Int -> Int -> Int
forall a. Num a => a -> a -> a
- ATTRIBUTE -> Int
forall a. Render a => a -> Int
lengthOf ATTRIBUTE
attr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) EXPRESSION
expr
     in if EXPRESSION -> Int
forall a. Render a => a -> Int
lengthOf EXPRESSION
single Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
extra Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
margin then EXPRESSION
single else PAIR -> SPACE -> EXPRESSION -> EXPRESSION
EX_SINGLE (ATTRIBUTE -> ARROW -> EXPRESSION -> PAIR
PA_TAU ATTRIBUTE
attr ARROW
arrow EXPRESSION
asset) SPACE
space ((Int, Int) -> EXPRESSION -> EXPRESSION
forall a. WithMargin a => (Int, Int) -> a -> a
withMargin' (Int, Int)
cfg EXPRESSION
formation)
  withMargin' cfg :: (Int, Int)
cfg@(Int
extra, Int
margin) ex :: EXPRESSION
ex@EX_APPLICATION{$sel:tab:EX_GLOBAL :: EXPRESSION -> TAB
tab = tab :: TAB
tab@(TAB Int
indt), Int
EXPRESSION
APP_ARGUMENT
TAB
EOL
SPACE
$sel:eol:EX_GLOBAL :: EXPRESSION -> EOL
$sel:eol':EX_GLOBAL :: EXPRESSION -> EOL
$sel:tab':EX_GLOBAL :: EXPRESSION -> TAB
$sel:expr:EX_GLOBAL :: EXPRESSION -> EXPRESSION
$sel:space:EX_GLOBAL :: EXPRESSION -> SPACE
expr :: EXPRESSION
space :: SPACE
eol :: EOL
argument :: APP_ARGUMENT
eol' :: EOL
tab' :: TAB
indent :: Int
$sel:argument:EX_GLOBAL :: EXPRESSION -> APP_ARGUMENT
$sel:indent:EX_GLOBAL :: EXPRESSION -> Int
..} =
    let single :: EXPRESSION
single = EXPRESSION -> EXPRESSION
forall a. ToSingleLine a => a -> a
toSingleLine EXPRESSION
ex
        main :: EXPRESSION
main = (Int, Int) -> EXPRESSION -> EXPRESSION
forall a. WithMargin a => (Int, Int) -> a -> a
withMargin' (Int, Int)
cfg EXPRESSION
expr
        singleMain :: EXPRESSION
singleMain = EXPRESSION -> EXPRESSION
forall a. ToSingleLine a => a -> a
toSingleLine EXPRESSION
main
        extra' :: Int
extra' = Text -> Int
displayWidth ([Text] -> Text
forall a. HasCallStack => [a] -> a
last (Text -> [Text]
T.lines (EXPRESSION -> Text
forall a. Render a => a -> Text
render EXPRESSION
main))) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4
        arg' :: APP_ARGUMENT
arg' = (Int, Int) -> APP_ARGUMENT -> APP_ARGUMENT
forall a. WithMargin a => (Int, Int) -> a -> a
withMargin' (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
indt, Int
margin) APP_ARGUMENT
argument
        singleArg :: APP_ARGUMENT
singleArg = APP_ARGUMENT -> APP_ARGUMENT
forall a. ToSingleLine a => a -> a
toSingleLine APP_ARGUMENT
arg'
     in if
          | EXPRESSION -> Int
forall a. Render a => a -> Int
lengthOf EXPRESSION
single Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
extra Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
margin -> EXPRESSION
single
          | EXPRESSION -> Int
forall a. Render a => a -> Int
lengthOf EXPRESSION
singleMain Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
extra Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
margin -> EXPRESSION
-> SPACE
-> EOL
-> TAB
-> APP_ARGUMENT
-> EOL
-> TAB
-> Int
-> EXPRESSION
EX_APPLICATION EXPRESSION
singleMain SPACE
space EOL
EOL TAB
tab APP_ARGUMENT
arg' EOL
EOL TAB
tab' Int
indent
          | APP_ARGUMENT -> Int
forall a. Render a => a -> Int
lengthOf APP_ARGUMENT
singleArg Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
extra' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
margin -> EXPRESSION
-> SPACE
-> EOL
-> TAB
-> APP_ARGUMENT
-> EOL
-> TAB
-> Int
-> EXPRESSION
EX_APPLICATION EXPRESSION
main SPACE
space EOL
NO_EOL TAB
TAB' APP_ARGUMENT
singleArg EOL
NO_EOL TAB
TAB' Int
indent
          | Bool
otherwise -> EXPRESSION
-> SPACE
-> EOL
-> TAB
-> APP_ARGUMENT
-> EOL
-> TAB
-> Int
-> EXPRESSION
EX_APPLICATION EXPRESSION
main SPACE
space EOL
EOL TAB
tab APP_ARGUMENT
arg' EOL
EOL TAB
tab' Int
indent
  withMargin' (Int, Int)
_ EXPRESSION
ex = EXPRESSION
ex

instance WithMargin APP_ARGUMENT where
  withMargin' :: (Int, Int) -> APP_ARGUMENT -> APP_ARGUMENT
withMargin' (Int, Int)
cfg (AA_TAU APP_BINDING
tau) = APP_BINDING -> APP_ARGUMENT
AA_TAU ((Int, Int) -> APP_BINDING -> APP_BINDING
forall a. WithMargin a => (Int, Int) -> a -> a
withMargin' (Int, Int)
cfg APP_BINDING
tau)
  withMargin' (Int, Int)
cfg (AA_TAUS BINDING
taus) = BINDING -> APP_ARGUMENT
AA_TAUS ((Int, Int) -> BINDING -> BINDING
forall a. WithMargin a => (Int, Int) -> a -> a
withMargin' (Int, Int)
cfg BINDING
taus)
  withMargin' (Int, Int)
cfg (AA_EXPRS APP_ARG
args) = APP_ARG -> APP_ARGUMENT
AA_EXPRS ((Int, Int) -> APP_ARG -> APP_ARG
forall a. WithMargin a => (Int, Int) -> a -> a
withMargin' (Int, Int)
cfg APP_ARG
args)

instance WithMargin APP_BINDING where
  withMargin' :: (Int, Int) -> APP_BINDING -> APP_BINDING
withMargin' (Int, Int)
cfg APP_BINDING{PAIR
pair :: PAIR
$sel:pair:APP_BINDING :: APP_BINDING -> PAIR
..} = PAIR -> APP_BINDING
APP_BINDING ((Int, Int) -> PAIR -> PAIR
forall a. WithMargin a => (Int, Int) -> a -> a
withMargin' (Int, Int)
cfg PAIR
pair)

instance WithMargin APP_ARG where
  withMargin' :: (Int, Int) -> APP_ARG -> APP_ARG
withMargin' cfg :: (Int, Int)
cfg@(Int
extra, Int
margin) arg :: APP_ARG
arg@APP_ARG{EXPRESSION
APP_ARGS
expr :: EXPRESSION
args :: APP_ARGS
$sel:expr:APP_ARG :: APP_ARG -> EXPRESSION
$sel:args:APP_ARG :: APP_ARG -> APP_ARGS
..} =
    let single :: APP_ARG
single = APP_ARG -> APP_ARG
forall a. ToSingleLine a => a -> a
toSingleLine APP_ARG
arg
     in if APP_ARG -> Int
forall a. Render a => a -> Int
lengthOf APP_ARG
single Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
extra Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
margin then APP_ARG
single else EXPRESSION -> APP_ARGS -> APP_ARG
APP_ARG ((Int, Int) -> EXPRESSION -> EXPRESSION
forall a. WithMargin a => (Int, Int) -> a -> a
withMargin' (Int, Int)
cfg EXPRESSION
expr) ((Int, Int) -> APP_ARGS -> APP_ARGS
forall a. WithMargin a => (Int, Int) -> a -> a
withMargin' (Int, Int)
cfg APP_ARGS
args)

instance WithMargin APP_ARGS where
  withMargin' :: (Int, Int) -> APP_ARGS -> APP_ARGS
withMargin' (Int, Int)
cfg AAS_EXPR{EXPRESSION
APP_ARGS
TAB
EOL
eol :: EOL
tab :: TAB
expr :: EXPRESSION
args :: APP_ARGS
$sel:eol:AAS_EXPR :: APP_ARGS -> EOL
$sel:tab:AAS_EXPR :: APP_ARGS -> TAB
$sel:expr:AAS_EXPR :: APP_ARGS -> EXPRESSION
$sel:args:AAS_EXPR :: APP_ARGS -> APP_ARGS
..} = EOL -> TAB -> EXPRESSION -> APP_ARGS -> APP_ARGS
AAS_EXPR EOL
EOL TAB
tab ((Int, Int) -> EXPRESSION -> EXPRESSION
forall a. WithMargin a => (Int, Int) -> a -> a
withMargin' (Int, Int)
cfg EXPRESSION
expr) ((Int, Int) -> APP_ARGS -> APP_ARGS
forall a. WithMargin a => (Int, Int) -> a -> a
withMargin' (Int, Int)
cfg APP_ARGS
args)
  withMargin' (Int, Int)
_ APP_ARGS
args = APP_ARGS
args

instance WithMargin BINDING where
  withMargin' :: (Int, Int) -> BINDING -> BINDING
withMargin' (Int, Int)
cfg BI_PAIR{BINDINGS
PAIR
TAB
pair :: PAIR
bindings :: BINDINGS
tab :: TAB
$sel:pair:BI_PAIR :: BINDING -> PAIR
$sel:bindings:BI_PAIR :: BINDING -> BINDINGS
$sel:tab:BI_PAIR :: BINDING -> TAB
..} = PAIR -> BINDINGS -> TAB -> BINDING
BI_PAIR ((Int, Int) -> PAIR -> PAIR
forall a. WithMargin a => (Int, Int) -> a -> a
withMargin' ((Int, Int) -> (Int, Int)
forall {a} {b}. Num a => (a, b) -> (a, b)
commas (Int, Int)
cfg) PAIR
pair) ((Int, Int) -> BINDINGS -> BINDINGS
forall a. WithMargin a => (Int, Int) -> a -> a
withMargin' (Int, Int)
cfg BINDINGS
bindings) TAB
tab
    where
      commas :: (a, b) -> (a, b)
commas (a
extra, b
margin) = case BINDINGS
bindings of
        BDS_EMPTY{} -> (a
extra, b
margin)
        BINDINGS
_ -> (a
extra a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, b
margin)
  withMargin' (Int, Int)
cfg BI_META{BINDINGS
TAB
META
$sel:bindings:BI_PAIR :: BINDING -> BINDINGS
$sel:tab:BI_PAIR :: BINDING -> TAB
meta :: META
bindings :: BINDINGS
tab :: TAB
$sel:meta:BI_PAIR :: BINDING -> META
..} = META -> BINDINGS -> TAB -> BINDING
BI_META META
meta ((Int, Int) -> BINDINGS -> BINDINGS
forall a. WithMargin a => (Int, Int) -> a -> a
withMargin' (Int, Int)
cfg BINDINGS
bindings) TAB
tab
  withMargin' (Int, Int)
_ BINDING
bd = BINDING
bd

instance WithMargin BINDINGS where
  withMargin' :: (Int, Int) -> BINDINGS -> BINDINGS
withMargin' (Int, Int)
cfg BDS_PAIR{BINDINGS
PAIR
TAB
EOL
eol :: EOL
tab :: TAB
pair :: PAIR
bindings :: BINDINGS
$sel:eol:BDS_PAIR :: BINDINGS -> EOL
$sel:tab:BDS_PAIR :: BINDINGS -> TAB
$sel:pair:BDS_PAIR :: BINDINGS -> PAIR
$sel:bindings:BDS_PAIR :: BINDINGS -> BINDINGS
..} = EOL -> TAB -> PAIR -> BINDINGS -> BINDINGS
BDS_PAIR EOL
EOL TAB
tab ((Int, Int) -> PAIR -> PAIR
forall a. WithMargin a => (Int, Int) -> a -> a
withMargin' ((Int, Int) -> (Int, Int)
forall {a} {b}. Num a => (a, b) -> (a, b)
commas (Int, Int)
cfg) PAIR
pair) ((Int, Int) -> BINDINGS -> BINDINGS
forall a. WithMargin a => (Int, Int) -> a -> a
withMargin' (Int, Int)
cfg BINDINGS
bindings)
    where
      commas :: (a, b) -> (a, b)
commas (a
extra, b
margin) = case BINDINGS
bindings of
        BDS_EMPTY{} -> (a
extra, b
margin)
        BINDINGS
_ -> (a
extra a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, b
margin)
  withMargin' (Int, Int)
cfg BDS_META{BINDINGS
TAB
META
EOL
$sel:eol:BDS_PAIR :: BINDINGS -> EOL
$sel:tab:BDS_PAIR :: BINDINGS -> TAB
$sel:bindings:BDS_PAIR :: BINDINGS -> BINDINGS
eol :: EOL
tab :: TAB
meta :: META
bindings :: BINDINGS
$sel:meta:BDS_PAIR :: BINDINGS -> META
..} = EOL -> TAB -> META -> BINDINGS -> BINDINGS
BDS_META EOL
EOL TAB
tab META
meta ((Int, Int) -> BINDINGS -> BINDINGS
forall a. WithMargin a => (Int, Int) -> a -> a
withMargin' (Int, Int)
cfg BINDINGS
bindings)
  withMargin' (Int, Int)
_ BINDINGS
bds = BINDINGS
bds

instance WithMargin PAIR where
  withMargin' :: (Int, Int) -> PAIR -> PAIR
withMargin' (Int
extra, Int
margin) pa :: PAIR
pa@PA_TAU{ATTRIBUTE
EXPRESSION
ARROW
$sel:attr:PA_TAU :: PAIR -> ATTRIBUTE
$sel:arrow:PA_TAU :: PAIR -> ARROW
$sel:expr:PA_TAU :: PAIR -> EXPRESSION
attr :: ATTRIBUTE
arrow :: ARROW
expr :: EXPRESSION
..} =
    let single :: PAIR
single = PAIR -> PAIR
forall a. ToSingleLine a => a -> a
toSingleLine PAIR
pa
        extra' :: Int
extra' = Int
extra Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ATTRIBUTE -> Int
forall a. Render a => a -> Int
lengthOf ATTRIBUTE
attr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ARROW -> Int
forall a. Render a => a -> Int
lengthOf ARROW
arrow Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
        pa' :: PAIR
pa' = ATTRIBUTE -> ARROW -> EXPRESSION -> PAIR
PA_TAU ATTRIBUTE
attr ARROW
arrow ((Int, Int) -> EXPRESSION -> EXPRESSION
forall a. WithMargin a => (Int, Int) -> a -> a
withMargin' (Int
extra', Int
margin) EXPRESSION
expr)
     in if PAIR -> Int
forall a. Render a => a -> Int
lengthOf PAIR
single Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
extra Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
margin then PAIR
single else PAIR
pa'
  withMargin' (Int
extra, Int
margin) pa :: PAIR
pa@PA_ALPHA{EXPRESSION
ALPHA
ARROW
$sel:arrow:PA_TAU :: PAIR -> ARROW
$sel:expr:PA_TAU :: PAIR -> EXPRESSION
alpha :: ALPHA
arrow :: ARROW
expr :: EXPRESSION
$sel:alpha:PA_TAU :: PAIR -> ALPHA
..} =
    let single :: PAIR
single = PAIR -> PAIR
forall a. ToSingleLine a => a -> a
toSingleLine PAIR
pa
        extra' :: Int
extra' = Int
extra Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ALPHA -> Int
forall a. Render a => a -> Int
lengthOf ALPHA
alpha Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ARROW -> Int
forall a. Render a => a -> Int
lengthOf ARROW
arrow Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
        pa' :: PAIR
pa' = ALPHA -> ARROW -> EXPRESSION -> PAIR
PA_ALPHA ALPHA
alpha ARROW
arrow ((Int, Int) -> EXPRESSION -> EXPRESSION
forall a. WithMargin a => (Int, Int) -> a -> a
withMargin' (Int
extra', Int
margin) EXPRESSION
expr)
     in if PAIR -> Int
forall a. Render a => a -> Int
lengthOf PAIR
single Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
extra Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
margin then PAIR
single else PAIR
pa'
  withMargin' (Int
extra, Int
margin) pa :: PAIR
pa@PA_FORMATION{[ATTRIBUTE]
ATTRIBUTE
EXPRESSION
ARROW
$sel:attr:PA_TAU :: PAIR -> ATTRIBUTE
$sel:arrow:PA_TAU :: PAIR -> ARROW
$sel:expr:PA_TAU :: PAIR -> EXPRESSION
attr :: ATTRIBUTE
voids :: [ATTRIBUTE]
arrow :: ARROW
expr :: EXPRESSION
$sel:voids:PA_TAU :: PAIR -> [ATTRIBUTE]
..} =
    let single :: PAIR
single = PAIR -> PAIR
forall a. ToSingleLine a => a -> a
toSingleLine PAIR
pa
        extra' :: Int
extra' = Int
extra Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ATTRIBUTE -> Int
forall a. Render a => a -> Int
lengthOf ATTRIBUTE
attr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [ATTRIBUTE] -> Int
forall a. Render a => a -> Int
lengthOf [ATTRIBUTE]
voids Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ARROW -> Int
forall a. Render a => a -> Int
lengthOf ARROW
arrow Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4
        pa' :: PAIR
pa' = ATTRIBUTE -> [ATTRIBUTE] -> ARROW -> EXPRESSION -> PAIR
PA_FORMATION ATTRIBUTE
attr [ATTRIBUTE]
voids ARROW
arrow ((Int, Int) -> EXPRESSION -> EXPRESSION
forall a. WithMargin a => (Int, Int) -> a -> a
withMargin' (Int
extra', Int
margin) EXPRESSION
expr)
     in if PAIR -> Int
forall a. Render a => a -> Int
lengthOf PAIR
single Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
extra Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
margin then PAIR
single else PAIR
pa'
  withMargin' (Int, Int)
_ PAIR
pa = PAIR
pa

instance WithMargin CONDITION where
  withMargin' :: (Int, Int) -> CONDITION -> CONDITION
withMargin' (Int, Int)
_ CONDITION
co = CONDITION
co

instance WithMargin EXTRA where
  withMargin' :: (Int, Int) -> EXTRA -> EXTRA
withMargin' (Int, Int)
_ = EXTRA -> EXTRA
forall a. a -> a
id

lengthOf :: Render a => a -> Int
lengthOf :: forall a. Render a => a -> Int
lengthOf a
renderable = Text -> Int
displayWidth (a -> Text
forall a. Render a => a -> Text
render a
renderable)

displayWidth :: T.Text -> Int
displayWidth :: Text -> Int
displayWidth = (Int -> Char -> Int) -> Int -> Text -> Int
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' Int -> Char -> Int
addWidth Int
0
  where
    addWidth :: Int -> Char -> Int
    addWidth :: Int -> Char -> Int
addWidth Int
acc Char
character = Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
charWidth Char
character

charWidth :: Char -> Int
charWidth :: Char -> Int
charWidth Char
character
  | Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
character Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x300 = Int
1
  | Bool
blank = Int
0
  | Int -> Bool
isWideCodePoint (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
character) = Int
2
  | Bool
otherwise = Int
1
  where
    blank :: Bool
    blank :: Bool
blank = Char -> GeneralCategory
generalCategory Char
character GeneralCategory -> [GeneralCategory] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GeneralCategory
NonSpacingMark, GeneralCategory
EnclosingMark, GeneralCategory
Format]

    isWideCodePoint :: Int -> Bool
    isWideCodePoint :: Int -> Bool
isWideCodePoint Int
codePoint = ((Int, Int) -> Bool) -> [(Int, Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> (Int, Int) -> Bool
inRange Int
codePoint) [(Int, Int)]
wideRanges

    inRange :: Int -> (Int, Int) -> Bool
    inRange :: Int -> (Int, Int) -> Bool
inRange Int
codePoint (Int
lo, Int
hi) = Int
codePoint Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lo Bool -> Bool -> Bool
&& Int
codePoint Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
hi

    wideRanges :: [(Int, Int)]
    wideRanges :: [(Int, Int)]
wideRanges =
      [ (Int
0x1100, Int
0x115F)
      , (Int
0x231A, Int
0x231B)
      , (Int
0x2329, Int
0x232A)
      , (Int
0x23E9, Int
0x23EC)
      , (Int
0x23F0, Int
0x23F0)
      , (Int
0x23F3, Int
0x23F3)
      , (Int
0x25FD, Int
0x25FE)
      , (Int
0x2614, Int
0x2615)
      , (Int
0x2648, Int
0x2653)
      , (Int
0x267F, Int
0x267F)
      , (Int
0x2693, Int
0x2693)
      , (Int
0x26A1, Int
0x26A1)
      , (Int
0x26AA, Int
0x26AB)
      , (Int
0x26BD, Int
0x26BE)
      , (Int
0x26C4, Int
0x26C5)
      , (Int
0x26CE, Int
0x26CE)
      , (Int
0x26D4, Int
0x26D4)
      , (Int
0x26EA, Int
0x26EA)
      , (Int
0x26F2, Int
0x26F3)
      , (Int
0x26F5, Int
0x26F5)
      , (Int
0x26FA, Int
0x26FA)
      , (Int
0x26FD, Int
0x26FD)
      , (Int
0x2705, Int
0x2705)
      , (Int
0x270A, Int
0x270B)
      , (Int
0x2728, Int
0x2728)
      , (Int
0x274C, Int
0x274C)
      , (Int
0x274E, Int
0x274E)
      , (Int
0x2753, Int
0x2755)
      , (Int
0x2757, Int
0x2757)
      , (Int
0x2795, Int
0x2797)
      , (Int
0x27B0, Int
0x27B0)
      , (Int
0x27BF, Int
0x27BF)
      , (Int
0x2B1B, Int
0x2B1C)
      , (Int
0x2B50, Int
0x2B50)
      , (Int
0x2B55, Int
0x2B55)
      , (Int
0x2E80, Int
0x303E)
      , (Int
0x3041, Int
0x33FF)
      , (Int
0x3400, Int
0x4DBF)
      , (Int
0x4E00, Int
0x9FFF)
      , (Int
0xA000, Int
0xA4CF)
      , (Int
0xA960, Int
0xA97C)
      , (Int
0xAC00, Int
0xD7A3)
      , (Int
0xF900, Int
0xFAFF)
      , (Int
0xFE10, Int
0xFE19)
      , (Int
0xFE30, Int
0xFE4F)
      , (Int
0xFE50, Int
0xFE52)
      , (Int
0xFE54, Int
0xFE66)
      , (Int
0xFE68, Int
0xFE6B)
      , (Int
0xFF00, Int
0xFF60)
      , (Int
0xFFE0, Int
0xFFE6)
      , (Int
0x16FE0, Int
0x16FE4)
      , (Int
0x16FF0, Int
0x16FF1)
      , (Int
0x17000, Int
0x187F7)
      , (Int
0x18800, Int
0x18CD5)
      , (Int
0x18D00, Int
0x18D08)
      , (Int
0x1B000, Int
0x1B11E)
      , (Int
0x1B150, Int
0x1B152)
      , (Int
0x1B164, Int
0x1B167)
      , (Int
0x1B170, Int
0x1B2FB)
      , (Int
0x1F004, Int
0x1F004)
      , (Int
0x1F0CF, Int
0x1F0CF)
      , (Int
0x1F18E, Int
0x1F18E)
      , (Int
0x1F191, Int
0x1F19A)
      , (Int
0x1F200, Int
0x1F202)
      , (Int
0x1F210, Int
0x1F23B)
      , (Int
0x1F240, Int
0x1F248)
      , (Int
0x1F250, Int
0x1F251)
      , (Int
0x1F260, Int
0x1F265)
      , (Int
0x1F300, Int
0x1FAFF)
      , (Int
0x20000, Int
0x3FFFD)
      ]