-- | Direction runs of a line of mixed left-to-right and right-to-left text,
-- for hosts that shape one direction at a time.
--
-- This is the implicit part of the Unicode bidirectional algorithm (UAX #9)
-- for a single line: the paragraph direction from the first strong
-- character, European and Arabic numbers, neutrals between runs, and
-- reordering by level. Explicit embeddings, overrides, isolates and bracket
-- pairs are not handled; text using them lays out as if they were absent.
module NanoUI.Bidi
  ( BidiRun (..)
  , bidiRuns
  , needsBidi
  ) where

import Control.Applicative ((<|>))
import Data.Char (ord)
import Data.List.NonEmpty qualified as NE
import Data.Text (Text)
import Data.Text qualified as T

-- | Characters @runStart@ up to @runEnd@ (exclusive) shaped in one direction.
data BidiRun = BidiRun
  { BidiRun -> Int
runStart :: !Int
  , BidiRun -> Int
runEnd :: !Int
  , BidiRun -> Bool
runRightToLeft :: !Bool
  }
  deriving (BidiRun -> BidiRun -> Bool
(BidiRun -> BidiRun -> Bool)
-> (BidiRun -> BidiRun -> Bool) -> Eq BidiRun
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BidiRun -> BidiRun -> Bool
== :: BidiRun -> BidiRun -> Bool
$c/= :: BidiRun -> BidiRun -> Bool
/= :: BidiRun -> BidiRun -> Bool
Eq, Int -> BidiRun -> ShowS
[BidiRun] -> ShowS
BidiRun -> String
(Int -> BidiRun -> ShowS)
-> (BidiRun -> String) -> ([BidiRun] -> ShowS) -> Show BidiRun
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BidiRun -> ShowS
showsPrec :: Int -> BidiRun -> ShowS
$cshow :: BidiRun -> String
show :: BidiRun -> String
$cshowList :: [BidiRun] -> ShowS
showList :: [BidiRun] -> ShowS
Show)

data Class = L | R | AL | EN | AN | NSM | WS | ON
  deriving (Class -> Class -> Bool
(Class -> Class -> Bool) -> (Class -> Class -> Bool) -> Eq Class
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Class -> Class -> Bool
== :: Class -> Class -> Bool
$c/= :: Class -> Class -> Bool
/= :: Class -> Class -> Bool
Eq, Int -> Class -> ShowS
[Class] -> ShowS
Class -> String
(Int -> Class -> ShowS)
-> (Class -> String) -> ([Class] -> ShowS) -> Show Class
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Class -> ShowS
showsPrec :: Int -> Class -> ShowS
$cshow :: Class -> String
show :: Class -> String
$cshowList :: [Class] -> ShowS
showList :: [Class] -> ShowS
Show)

-- | Whether a line has characters that can flow right to left. A line
-- without them is one left-to-right run.
needsBidi :: Text -> Bool
needsBidi :: Text -> Bool
needsBidi = (Char -> Bool) -> Text -> Bool
T.any (\Char
c -> Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x0590 Bool -> Bool -> Bool
&& Class -> Bool
rtlOrArabic (Char -> Class
classify Char
c))
  where
    rtlOrArabic :: Class -> Bool
rtlOrArabic Class
k = Class
k Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
R Bool -> Bool -> Bool
|| Class
k Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
AL Bool -> Bool -> Bool
|| Class
k Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
AN

-- | The runs of a line in visual order, left to right.
bidiRuns :: Text -> [BidiRun]
bidiRuns :: Text -> [BidiRun]
bidiRuns Text
txt
  | Text -> Bool
T.null Text
txt = []
  | Bool -> Bool
not (Text -> Bool
needsBidi Text
txt) = [Int -> Int -> Bool -> BidiRun
BidiRun Int
0 (Text -> Int
T.length Text
txt) Bool
False]
  | Bool
otherwise =
      let classes0 :: [Class]
classes0 = (Char -> Class) -> String -> [Class]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Class
classify (Text -> String
T.unpack Text
txt)
          paragraphRtl :: Bool
paragraphRtl = case [Class
k | Class
k <- [Class]
classes0, Class
k Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
L Bool -> Bool -> Bool
|| Class
k Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
R Bool -> Bool -> Bool
|| Class
k Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
AL] of
            Class
k : [Class]
_ -> Class
k Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
/= Class
L
            [] -> Bool
False
          base :: Int
base = if Bool
paragraphRtl then Int
1 else Int
0 :: Int
          classes :: [Class]
classes = Bool -> [Class] -> [Class]
resolveNeutrals Bool
paragraphRtl (Bool -> [Class] -> [Class]
resolveWeak Bool
paragraphRtl [Class]
classes0)
          levels :: [Int]
levels = (Class -> Int) -> [Class] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Class -> Int
implicitLevel Int
base) [Class]
classes
          indexed :: [(Int, Int)]
indexed = [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] [Int]
levels
          runs :: [(Int, Int, Int)]
runs =
            [ (Int
start, (Int, Int) -> Int
forall a b. (a, b) -> a
fst (NonEmpty (Int, Int) -> (Int, Int)
forall a. NonEmpty a -> a
NE.last NonEmpty (Int, Int)
grp) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
lvl)
            | NonEmpty (Int, Int)
grp <- ((Int, Int) -> (Int, Int) -> Bool)
-> [(Int, Int)] -> [NonEmpty (Int, Int)]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NE.groupBy (\(Int, Int)
a (Int, Int)
b -> (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Int, Int)
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Int, Int)
b) [(Int, Int)]
indexed
            , let (Int
start, Int
lvl) = NonEmpty (Int, Int) -> (Int, Int)
forall a. NonEmpty a -> a
NE.head NonEmpty (Int, Int)
grp
            ]
       in [Int -> Int -> Bool -> BidiRun
BidiRun Int
s Int
e (Int -> Bool
forall a. Integral a => a -> Bool
odd Int
lvl) | (Int
s, Int
e, Int
lvl) <- [(Int, Int, Int)] -> [(Int, Int, Int)]
reorder [(Int, Int, Int)]
runs]

classify :: Char -> Class
classify :: Char -> Class
classify Char
c
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x0590 = Class
latin
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x05FF = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x0591 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x05C7 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0x05BE Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0x05C0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0x05C3 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0x05C6 then Class
NSM else Class
R
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x0660 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x0669 = Class
AN
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x06F0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x06F9 = Class
EN
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x064B Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x065F Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0x0670 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x06D6 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x06ED = Class
NSM
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x06FF = Class
AL
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x07BF = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x0730 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x074A Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x07A6 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x07B0 then Class
NSM else Class
AL
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x085F = Class
R
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x08FF = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x08D3 then Class
NSM else Class
AL
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x200E Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x200F = if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0x200E then Class
L else Class
R
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0xFB1D Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xFB4F = Class
R
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0xFB50 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xFDFF = Class
AL
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0xFE70 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xFEFF = Class
AL
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x2000 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x206F = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x200A Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0x2028 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0x2029 then Class
WS else Class
ON
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x10800 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x10FFF = Class
R
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x1E800 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x1EFFF = Class
AL
  | Bool
otherwise = Class
L
  where
    n :: Int
n = Char -> Int
ord Char
c
    latin :: Class
latin
      | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' = Class
EN
      | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t' = Class
WS
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x80 Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isAsciiLetter Char
c) = Class
ON
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x80 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xBF = Class
ON
      | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0xD7 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0xF7 = Class
ON
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x0300 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x036F = Class
NSM
      | Bool
otherwise = Class
L
    isAsciiLetter :: Char -> Bool
isAsciiLetter Char
ch = (Char
ch Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
ch Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z') Bool -> Bool -> Bool
|| (Char
ch Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
ch Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z')

-- | Weak types: a mark takes the class before it, a European number after
-- Arabic letters reads as an Arabic number and one after Latin letters (or
-- at the start of a left-to-right line) as Latin.
resolveWeak :: Bool -> [Class] -> [Class]
resolveWeak :: Bool -> [Class] -> [Class]
resolveWeak Bool
paragraphRtl = Class -> Class -> [Class] -> [Class]
go Class
ON (if Bool
paragraphRtl then Class
R else Class
L)
  where
    go :: Class -> Class -> [Class] -> [Class]
go Class
_ Class
_ [] = []
    go Class
prev Class
lastStrong (Class
k : [Class]
ks) =
      let k1 :: Class
k1 = if Class
k Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
NSM then Class
prev else Class
k
          k2 :: Class
k2
            | Class
k1 Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
EN Bool -> Bool -> Bool
&& Class
lastStrong Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
AL = Class
AN
            | Class
k1 Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
EN Bool -> Bool -> Bool
&& Class
lastStrong Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
L = Class
L
            | Bool
otherwise = Class
k1
          k3 :: Class
k3 = if Class
k2 Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
AL then Class
R else Class
k2
          lastStrong' :: Class
lastStrong' = if Class
k1 Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
L Bool -> Bool -> Bool
|| Class
k1 Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
R Bool -> Bool -> Bool
|| Class
k1 Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
AL then Class
k1 else Class
lastStrong
       in Class
k3 Class -> [Class] -> [Class]
forall a. a -> [a] -> [a]
: Class -> Class -> [Class] -> [Class]
go Class
k1 Class
lastStrong' [Class]
ks

-- | Neutrals between two characters of the same direction take it (numbers
-- count as right to left here); other neutrals take the paragraph's.
resolveNeutrals :: Bool -> [Class] -> [Class]
resolveNeutrals :: Bool -> [Class] -> [Class]
resolveNeutrals Bool
paragraphRtl [Class]
classes =
  let direction :: Class -> Maybe Bool
direction Class
k
        | Class
k Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
L = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
        | Class
k Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
R Bool -> Bool -> Bool
|| Class
k Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
AN Bool -> Bool -> Bool
|| Class
k Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
EN = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
        | Bool
otherwise = Maybe Bool
forall a. Maybe a
Nothing
      directions :: [Maybe Bool]
directions = (Class -> Maybe Bool) -> [Class] -> [Maybe Bool]
forall a b. (a -> b) -> [a] -> [b]
map Class -> Maybe Bool
direction [Class]
classes
      before :: [Maybe Bool]
before = (Maybe Bool -> Maybe Bool -> Maybe Bool)
-> Maybe Bool -> [Maybe Bool] -> [Maybe Bool]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\Maybe Bool
acc Maybe Bool
d -> Maybe Bool
d Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
acc) Maybe Bool
forall a. Maybe a
Nothing [Maybe Bool]
directions
      after :: [Maybe Bool]
after = Int -> [Maybe Bool] -> [Maybe Bool]
forall a. Int -> [a] -> [a]
drop Int
1 ((Maybe Bool -> Maybe Bool -> Maybe Bool)
-> Maybe Bool -> [Maybe Bool] -> [Maybe Bool]
forall a b. (a -> b -> b) -> b -> [a] -> [b]
scanr Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) Maybe Bool
forall a. Maybe a
Nothing [Maybe Bool]
directions)
      resolve :: Class -> Maybe Bool -> Maybe Bool -> Class
resolve Class
k Maybe Bool
b Maybe Bool
a
        | Class
k Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
WS Bool -> Bool -> Bool
|| Class
k Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
ON = case (Maybe Bool
b, Maybe Bool
a) of
            (Just Bool
x, Just Bool
y) | Bool
x Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
y -> if Bool
x then Class
R else Class
L
            (Maybe Bool, Maybe Bool)
_ -> if Bool
paragraphRtl then Class
R else Class
L
        | Bool
otherwise = Class
k
   in (Class -> Maybe Bool -> Maybe Bool -> Class)
-> [Class] -> [Maybe Bool] -> [Maybe Bool] -> [Class]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Class -> Maybe Bool -> Maybe Bool -> Class
resolve [Class]
classes [Maybe Bool]
before [Maybe Bool]
after

-- | The embedding level of a resolved class at paragraph level @base@.
implicitLevel :: Int -> Class -> Int
implicitLevel :: Int -> Class -> Int
implicitLevel Int
base Class
k
  | Int -> Bool
forall a. Integral a => a -> Bool
even Int
base = case Class
k of
      Class
R -> Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      Class
AL -> Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      Class
AN -> Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
      Class
EN -> Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
      Class
_ -> Int
base
  | Bool
otherwise = case Class
k of
      Class
L -> Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      Class
EN -> Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      Class
AN -> Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      Class
_ -> Int
base

-- | Reverse every maximal sequence of runs at or above each odd level, from
-- the highest level down.
reorder :: [(Int, Int, Int)] -> [(Int, Int, Int)]
reorder :: [(Int, Int, Int)] -> [(Int, Int, Int)]
reorder [(Int, Int, Int)]
runs =
  let maxLevel :: Int
maxLevel = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int
l | (Int
_, Int
_, Int
l) <- [(Int, Int, Int)]
runs])
      lowestOdd :: Int
lowestOdd = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (Int
maxLevel Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int
l | (Int
_, Int
_, Int
l) <- [(Int, Int, Int)]
runs, Int -> Bool
forall a. Integral a => a -> Bool
odd Int
l])
      pass :: a -> f (a, b, a) -> [(a, b, a)]
pass a
lvl f (a, b, a)
rs =
        (NonEmpty (a, b, a) -> [(a, b, a)])
-> [NonEmpty (a, b, a)] -> [(a, b, a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
          (\NonEmpty (a, b, a)
grp -> if (a, b, a) -> Bool
atLeast (NonEmpty (a, b, a) -> (a, b, a)
forall a. NonEmpty a -> a
NE.head NonEmpty (a, b, a)
grp) then [(a, b, a)] -> [(a, b, a)]
forall a. [a] -> [a]
reverse (NonEmpty (a, b, a) -> [(a, b, a)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (a, b, a)
grp) else NonEmpty (a, b, a) -> [(a, b, a)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (a, b, a)
grp)
          (((a, b, a) -> (a, b, a) -> Bool)
-> f (a, b, a) -> [NonEmpty (a, b, a)]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NE.groupBy (\(a, b, a)
a (a, b, a)
b -> (a, b, a) -> Bool
atLeast (a, b, a)
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== (a, b, a) -> Bool
atLeast (a, b, a)
b) f (a, b, a)
rs)
        where
          atLeast :: (a, b, a) -> Bool
atLeast (a
_, b
_, a
l) = a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
lvl
   in ([(Int, Int, Int)] -> Int -> [(Int, Int, Int)])
-> [(Int, Int, Int)] -> [Int] -> [(Int, Int, Int)]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((Int -> [(Int, Int, Int)] -> [(Int, Int, Int)])
-> [(Int, Int, Int)] -> Int -> [(Int, Int, Int)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> [(Int, Int, Int)] -> [(Int, Int, Int)]
forall {a} {f :: * -> *} {a} {b}.
(Ord a, Foldable f) =>
a -> f (a, b, a) -> [(a, b, a)]
pass) [(Int, Int, Int)]
runs [Int
maxLevel, Int
maxLevel Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 .. Int
lowestOdd]