{-# LANGUAGE RecordWildCards #-}

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

module Abridge (abridged) where

import CST
import qualified Data.Text as T
import Lining (toSingleLine)
import Render (render)

abridged :: Bool -> Int -> EXPRESSION -> EXPRESSION
abridged :: Bool -> Int -> EXPRESSION -> EXPRESSION
abridged Bool
cut Int
width = EXPRESSION -> EXPRESSION
goExpr
  where
    goExpr :: EXPRESSION -> EXPRESSION
    goExpr :: EXPRESSION -> EXPRESSION
goExpr expr :: EXPRESSION
expr@EX_FORMATION{BINDING
TAB
EOL
RSB
LSB
lsb :: LSB
eol :: EOL
tab :: TAB
binding :: BINDING
eol' :: EOL
tab' :: TAB
rsb :: RSB
$sel:lsb:EX_GLOBAL :: EXPRESSION -> LSB
$sel:eol:EX_GLOBAL :: EXPRESSION -> EOL
$sel:tab:EX_GLOBAL :: EXPRESSION -> TAB
$sel:binding:EX_GLOBAL :: EXPRESSION -> BINDING
$sel:eol':EX_GLOBAL :: EXPRESSION -> EOL
$sel:tab':EX_GLOBAL :: EXPRESSION -> TAB
$sel:rsb:EX_GLOBAL :: EXPRESSION -> RSB
..}
      | EXPRESSION -> Bool
short EXPRESSION
expr = LSB -> EOL -> TAB -> BINDING -> EOL -> TAB -> RSB -> EXPRESSION
EX_FORMATION LSB
lsb EOL
eol TAB
tab (BINDING -> BINDING
goIntact BINDING
binding) EOL
eol' TAB
tab' RSB
rsb
      | Bool
otherwise = LSB -> EOL -> TAB -> BINDING -> EOL -> TAB -> RSB -> EXPRESSION
EX_FORMATION LSB
lsb EOL
eol TAB
tab (BINDING -> BINDING
goBinding BINDING
binding) EOL
eol' TAB
tab' RSB
rsb
    goExpr expr :: EXPRESSION
expr@EX_SINGLE{EXPRESSION
PAIR
SPACE
pair :: PAIR
space :: SPACE
formation :: EXPRESSION
$sel:space:EX_GLOBAL :: EXPRESSION -> SPACE
$sel:pair:EX_GLOBAL :: EXPRESSION -> PAIR
$sel:formation:EX_GLOBAL :: EXPRESSION -> EXPRESSION
..}
      | EXPRESSION -> Bool
short EXPRESSION
expr Bool -> Bool -> Bool
|| PAIR -> Bool
salient PAIR
pair = PAIR -> SPACE -> EXPRESSION -> EXPRESSION
EX_SINGLE (PAIR -> PAIR
goPair PAIR
pair) SPACE
space (EXPRESSION -> EXPRESSION
goExpr EXPRESSION
formation)
      | Bool
otherwise = EXPRESSION -> EXPRESSION
goExpr EXPRESSION
formation
    goExpr EX_DISPATCH{ATTRIBUTE
EXPRESSION
SPACE
$sel:space:EX_GLOBAL :: EXPRESSION -> SPACE
expr :: EXPRESSION
space :: SPACE
attr :: ATTRIBUTE
$sel:attr:EX_GLOBAL :: EXPRESSION -> ATTRIBUTE
$sel:expr:EX_GLOBAL :: EXPRESSION -> EXPRESSION
..} = EXPRESSION -> SPACE -> ATTRIBUTE -> EXPRESSION
EX_DISPATCH (EXPRESSION -> EXPRESSION
goExpr EXPRESSION
expr) SPACE
space ATTRIBUTE
attr
    goExpr EX_APPLICATION{Int
EXPRESSION
APP_ARGUMENT
TAB
EOL
SPACE
$sel:eol:EX_GLOBAL :: EXPRESSION -> EOL
$sel:tab:EX_GLOBAL :: EXPRESSION -> TAB
$sel:eol':EX_GLOBAL :: EXPRESSION -> EOL
$sel:tab':EX_GLOBAL :: EXPRESSION -> TAB
$sel:space:EX_GLOBAL :: EXPRESSION -> SPACE
$sel:expr:EX_GLOBAL :: EXPRESSION -> EXPRESSION
expr :: EXPRESSION
space :: SPACE
eol :: EOL
tab :: TAB
argument :: APP_ARGUMENT
eol' :: EOL
tab' :: TAB
indent :: Int
$sel:argument:EX_GLOBAL :: EXPRESSION -> APP_ARGUMENT
$sel:indent:EX_GLOBAL :: EXPRESSION -> Int
..} = EXPRESSION
-> SPACE
-> EOL
-> TAB
-> APP_ARGUMENT
-> EOL
-> TAB
-> Int
-> EXPRESSION
EX_APPLICATION (EXPRESSION -> EXPRESSION
goExpr EXPRESSION
expr) SPACE
space EOL
eol TAB
tab (APP_ARGUMENT -> APP_ARGUMENT
goArgument APP_ARGUMENT
argument) EOL
eol' TAB
tab' Int
indent
    goExpr EX_PHI_MEET{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_MEET Maybe String
prefix Int
idx (EXPRESSION -> EXPRESSION
goExpr EXPRESSION
expr)
    goExpr EX_PHI_AGAIN{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_AGAIN Maybe String
prefix Int
idx (EXPRESSION -> EXPRESSION
goExpr EXPRESSION
expr)
    goExpr EX_BYTES{BYTES
bytes :: BYTES
$sel:bytes:EX_GLOBAL :: EXPRESSION -> BYTES
..} = BYTES -> EXPRESSION
EX_BYTES (BYTES -> BYTES
goBytes BYTES
bytes)
    goExpr EXPRESSION
expr = EXPRESSION
expr
    goBinding :: BINDING -> BINDING
    goBinding :: BINDING -> BINDING
goBinding empty :: BINDING
empty@BI_EMPTY{} = BINDING
empty
    goBinding BINDING
binding = BINDINGS -> BINDING
headed (Int -> BINDINGS -> BINDINGS
goBindings Int
0 (BINDING -> BINDINGS
tail' BINDING
binding))
      where
        tail' :: BINDING -> BINDINGS
        tail' :: BINDING -> BINDINGS
tail' 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
..} = EOL -> TAB -> PAIR -> BINDINGS -> BINDINGS
BDS_PAIR EOL
EOL TAB
tab PAIR
pair BINDINGS
bindings
        tail' 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
..} = EOL -> TAB -> META -> BINDINGS -> BINDINGS
BDS_META EOL
EOL TAB
tab META
meta BINDINGS
bindings
        tail' BI_EMPTY{TAB
$sel:tab:BI_PAIR :: BINDING -> TAB
tab :: TAB
..} = TAB -> BINDINGS
BDS_EMPTY TAB
tab
        headed :: BINDINGS -> BINDING
        headed :: BINDINGS -> BINDING
headed 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
..} = PAIR -> BINDINGS -> TAB -> BINDING
BI_PAIR PAIR
pair BINDINGS
bindings TAB
tab
        headed 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
..} = META -> BINDINGS -> TAB -> BINDING
BI_META META
meta BINDINGS
bindings TAB
tab
        headed BDS_EMPTY{TAB
$sel:tab:BDS_PAIR :: BINDINGS -> TAB
tab :: TAB
..} = TAB -> BINDING
BI_EMPTY TAB
tab
    goBindings :: Int -> BINDINGS -> BINDINGS
    goBindings :: Int -> BINDINGS -> BINDINGS
goBindings Int
folded BDS_PAIR{BINDINGS
PAIR
TAB
EOL
$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 :: EOL
tab :: TAB
pair :: PAIR
bindings :: BINDINGS
..}
      | PAIR -> Bool
salient PAIR
pair = EOL -> TAB -> PAIR -> BINDINGS -> BINDINGS
BDS_PAIR EOL
eol TAB
tab (PAIR -> PAIR
goPair PAIR
pair) (Int -> BINDINGS -> BINDINGS
goBindings Int
folded BINDINGS
bindings)
      | Bool
otherwise = Int -> BINDINGS -> BINDINGS
goBindings (Int
folded Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) BINDINGS
bindings
    goBindings Int
folded BDS_META{BINDINGS
TAB
META
EOL
$sel:eol:BDS_PAIR :: BINDINGS -> EOL
$sel:tab:BDS_PAIR :: BINDINGS -> TAB
$sel:bindings:BDS_PAIR :: BINDINGS -> BINDINGS
$sel:meta:BDS_PAIR :: BINDINGS -> META
eol :: EOL
tab :: TAB
meta :: META
bindings :: BINDINGS
..} = EOL -> TAB -> META -> BINDINGS -> BINDINGS
BDS_META EOL
eol TAB
tab META
meta (Int -> BINDINGS -> BINDINGS
goBindings Int
folded BINDINGS
bindings)
    goBindings Int
0 empty :: BINDINGS
empty@BDS_EMPTY{} = BINDINGS
empty
    goBindings Int
folded empty :: BINDINGS
empty@BDS_EMPTY{TAB
$sel:tab:BDS_PAIR :: BINDINGS -> TAB
tab :: TAB
..} = EOL -> TAB -> PAIR -> BINDINGS -> BINDINGS
BDS_PAIR EOL
EOL TAB
tab (Int -> PAIR
PA_FOLDED Int
folded) BINDINGS
empty
    goPair :: PAIR -> PAIR
    goPair :: PAIR -> PAIR
goPair 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
..} = ATTRIBUTE -> ARROW -> EXPRESSION -> PAIR
PA_TAU ATTRIBUTE
attr ARROW
arrow (EXPRESSION -> EXPRESSION
goExpr EXPRESSION
expr)
    goPair 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
..} = ALPHA -> ARROW -> EXPRESSION -> PAIR
PA_ALPHA ALPHA
alpha ARROW
arrow (EXPRESSION -> EXPRESSION
goExpr EXPRESSION
expr)
    goPair 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]
..} = ATTRIBUTE -> [ATTRIBUTE] -> ARROW -> EXPRESSION -> PAIR
PA_FORMATION ATTRIBUTE
attr [ATTRIBUTE]
voids ARROW
arrow (EXPRESSION -> EXPRESSION
goExpr EXPRESSION
expr)
    goPair PA_DELTA{BYTES
bytes :: BYTES
$sel:bytes:PA_TAU :: PAIR -> BYTES
..} = BYTES -> PAIR
PA_DELTA (BYTES -> BYTES
goBytes BYTES
bytes)
    goPair PAIR
pair = PAIR
pair
    goArgument :: APP_ARGUMENT -> APP_ARGUMENT
    goArgument :: APP_ARGUMENT -> APP_ARGUMENT
goArgument (AA_TAU APP_BINDING{PAIR
pair :: PAIR
$sel:pair:APP_BINDING :: APP_BINDING -> PAIR
..}) = APP_BINDING -> APP_ARGUMENT
AA_TAU (PAIR -> APP_BINDING
APP_BINDING (PAIR -> PAIR
goPair PAIR
pair))
    goArgument (AA_TAUS BINDING
binding) = BINDING -> APP_ARGUMENT
AA_TAUS (BINDING -> BINDING
goIntact BINDING
binding)
    goArgument (AA_EXPRS 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
..}) = APP_ARG -> APP_ARGUMENT
AA_EXPRS (EXPRESSION -> APP_ARGS -> APP_ARG
APP_ARG (EXPRESSION -> EXPRESSION
goExpr EXPRESSION
expr) (APP_ARGS -> APP_ARGS
goAppArgs APP_ARGS
args))
    goIntact :: BINDING -> BINDING
    goIntact :: BINDING -> BINDING
goIntact BI_PAIR{BINDINGS
PAIR
TAB
$sel:pair:BI_PAIR :: BINDING -> PAIR
$sel:bindings:BI_PAIR :: BINDING -> BINDINGS
$sel:tab:BI_PAIR :: BINDING -> TAB
pair :: PAIR
bindings :: BINDINGS
tab :: TAB
..} = PAIR -> BINDINGS -> TAB -> BINDING
BI_PAIR (PAIR -> PAIR
goPair PAIR
pair) (BINDINGS -> BINDINGS
goIntacts BINDINGS
bindings) TAB
tab
    goIntact BI_META{BINDINGS
TAB
META
$sel:bindings:BI_PAIR :: BINDING -> BINDINGS
$sel:tab:BI_PAIR :: BINDING -> TAB
$sel:meta:BI_PAIR :: BINDING -> META
meta :: META
bindings :: BINDINGS
tab :: TAB
..} = META -> BINDINGS -> TAB -> BINDING
BI_META META
meta (BINDINGS -> BINDINGS
goIntacts BINDINGS
bindings) TAB
tab
    goIntact BINDING
empty = BINDING
empty
    goIntacts :: BINDINGS -> BINDINGS
    goIntacts :: BINDINGS -> BINDINGS
goIntacts BDS_PAIR{BINDINGS
PAIR
TAB
EOL
$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 :: EOL
tab :: TAB
pair :: PAIR
bindings :: BINDINGS
..} = EOL -> TAB -> PAIR -> BINDINGS -> BINDINGS
BDS_PAIR EOL
eol TAB
tab (PAIR -> PAIR
goPair PAIR
pair) (BINDINGS -> BINDINGS
goIntacts BINDINGS
bindings)
    goIntacts BDS_META{BINDINGS
TAB
META
EOL
$sel:eol:BDS_PAIR :: BINDINGS -> EOL
$sel:tab:BDS_PAIR :: BINDINGS -> TAB
$sel:bindings:BDS_PAIR :: BINDINGS -> BINDINGS
$sel:meta:BDS_PAIR :: BINDINGS -> META
eol :: EOL
tab :: TAB
meta :: META
bindings :: BINDINGS
..} = EOL -> TAB -> META -> BINDINGS -> BINDINGS
BDS_META EOL
eol TAB
tab META
meta (BINDINGS -> BINDINGS
goIntacts BINDINGS
bindings)
    goIntacts BINDINGS
empty = BINDINGS
empty
    goAppArgs :: APP_ARGS -> APP_ARGS
    goAppArgs :: APP_ARGS -> APP_ARGS
goAppArgs 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 (EXPRESSION -> EXPRESSION
goExpr EXPRESSION
expr) (APP_ARGS -> APP_ARGS
goAppArgs APP_ARGS
args)
    goAppArgs APP_ARGS
AAS_EMPTY = APP_ARGS
AAS_EMPTY
    goBytes :: BYTES -> BYTES
    goBytes :: BYTES -> BYTES
goBytes (BT_MANY [String]
bts)
      | Bool
cut Bool -> Bool -> Bool
&& [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
bts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
8 = [String] -> Int -> [String] -> BYTES
BT_CUT (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
2 [String]
bts) ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
bts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
bts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) [String]
bts)
    goBytes BYTES
bts = BYTES
bts
    short :: EXPRESSION -> Bool
    short :: EXPRESSION -> Bool
short EXPRESSION
expr = Text -> Int
T.length (EXPRESSION -> Text
forall a. Render a => a -> Text
render (EXPRESSION -> EXPRESSION
forall a. ToSingleLine a => a -> a
toSingleLine EXPRESSION
expr)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
width
    salient :: PAIR -> Bool
    salient :: PAIR -> Bool
salient PA_TAU{$sel:attr:PA_TAU :: PAIR -> ATTRIBUTE
attr = AT_PHI{}} = Bool
True
    salient PA_FORMATION{$sel:attr:PA_TAU :: PAIR -> ATTRIBUTE
attr = AT_PHI{}} = Bool
True
    salient PA_VOID{$sel:attr:PA_TAU :: PAIR -> ATTRIBUTE
attr = AT_PHI{}} = Bool
True
    salient PA_LAMBDA{} = Bool
True
    salient PA_META_LAMBDA{} = Bool
True
    salient PA_DELTA{} = Bool
True
    salient PA_META_DELTA{} = Bool
True
    salient PAIR
_ = Bool
False