src/Symantic/Plaintext/Writer2.hs

   1 {-# LANGUAGE DeriveFunctor #-}
   2 {-# OPTIONS_GHC -Wno-orphans #-}
   3
   4 module Symantic.Plaintext.Writer2 where
   5
   6 import Control.Applicative (Alternative (..), Applicative (..))
   7 import Data.Bool
   8 import Data.Char (Char)
   9 import Data.Eq (Eq (..))
  10 import Data.Function (($), (.))
  11 import Data.Functor (Functor (..), (<$>))
  12 import Data.List qualified as List
  13 import Data.Maybe (Maybe (..), fromMaybe)
  14 import Data.Monoid (Monoid (..))
  15 import Data.Ord (Ord (..))
  16 import Data.Semigroup (Semigroup (..))
  17 import Data.String (IsString (..), String)
  18 import Data.Traversable (Traversable (traverse))
  19 import GHC.Natural (
  20   minusNatural,
  21   minusNaturalMaybe,
  22   quotRemNatural,
  23  )
  24 import Numeric.Natural (Natural)
  25 import Text.Show (
  26   Show (..),
  27   showParen,
  28   showString,
  29  )
  30 import Prelude (
  31   Num (..),
  32   error,
  33   fromIntegral,
  34   undefined,
  35  )
  36
  37 --import qualified Data.Text.Lazy.Builder as TLB
  38 --import qualified Data.Text.Lazy.Builder as TLB
  39
  40 import Control.Monad (Monad ((>>=)))
  41 import Data.Functor.Identity (Identity (..))
  42 import Data.Text.Internal.Fusion.Types (RS (RS3))
  43 import Data.Tuple (fst, snd, swap)
  44 import Debug.Trace (trace, traceShow)
  45 import GHC.IO.Exception (IOErrorType (SystemError))
  46 import GHC.List (sum)
  47 import GHC.Real (Integral (div))
  48 import Symantic.Plaintext.Classes ()
  49 import Symantic.Plaintext.Output
  50
  51 data Measured o = Measured
  52   { measuredHorizontal :: Natural
  53   , measuredVertical :: Natural
  54   , unMeasured :: o
  55   }
  56 instance Dimensionable (Measured o) where
  57   width = measuredHorizontal
  58   height = measuredVertical
  59
  60 -- renderRect :: Outputable o => Measured (Rect o) -> [o]
  61 -- renderRect Measured{..} = case unMeasured of
  62 --   RectEmpty -> []
  63 --   RectChunk o -> [o]
  64 --   Rects{..} -> case rectDirection of
  65 --     DirectionHorizontal -> []
  66
  67 resize :: Measured [o] -> [o]
  68 resize Measured{..} = undefined
  69
  70 -- | Doc: https://personal.cis.strath.ac.uk/conor.mcbride/so-pigworker.pdf#section.4.9
  71 data PaddedList a = (:-)
  72   { padded :: [a]
  73   , padder :: a
  74   }
  75   deriving (Show, Eq)
  76
  77 infixr 5 :-
  78
  79 instance Functor PaddedList where
  80   fmap = (<*>) . pure
  81 instance Applicative PaddedList where
  82   pure = ([] :-)
  83   as :- ap <*> bs :- bp = go as bs :- ap bp
  84     where
  85       go [] xs = ap <$> xs
  86       go fs [] = ($ bp) <$> fs
  87       go (f : fs) (x : xs) = f x : go fs xs
  88
  89 -- >>> "om":-' ' <*> "mane":-' '
  90
  91 -- >>> "om":-' ' <*> "mane":-' '
  92 -- Couldn't match type ‘Char’ with ‘Char -> b’
  93 -- Expected type: PaddedList (Char -> b)
  94 --   Actual type: PaddedList Char
  95
  96 -- >>> deggar ' ' ["om", "mane", "padme", "hum12345"]
  97 -- (:-) {padded = ["omph","maau"," ndm"," em1","  e2","   3","   4","   5"], padder = "    "}
  98 deggar pad = traverse (:- pad)
  99
 100 lines0 = ["om", "mane", "padme", "hum12345"]
 101 columns0 = [["om"], ["mane", "padme"], ["hum", "12345"]]
 102 measureList :: Lengthable a => [a] -> (Natural, [(Natural, a)])
 103 measureList =
 104   List.mapAccumL (\acc s -> let len = length s in (max len acc, (len, s))) 0
 105 measureVert :: Lengthable a => [a] -> (Natural, [(Natural, a)])
 106 measureVert ss = (fromIntegral $ List.length ss, (1,) <$> ss)
 107
 108 -- >>> padList (\n -> List.replicate (fromIntegral n) ' ') (measureList lines0)
 109 -- ["om      ","mane    ","padme   ","hum12345"]
 110 -- >>> (measureVert lines0)
 111 -- (4,[(1,"om"),(1,"mane"),(1,"padme"),(1,"hum12345")])
 112 padList :: Semigroup o => (Natural -> o) -> (Natural, [(Natural, o)]) -> [o]
 113 padList pad (inpLen, inp) =
 114   fmap
 115     ( \(itemLen, item) -> case inpLen `minusNaturalMaybe` itemLen of
 116         Nothing -> item
 117         Just padLen -> item <> pad padLen
 118     )
 119     inp
 120
 121 whites :: Integral a => a -> [Char]
 122 whites n = List.replicate (fromIntegral n) ' '
 123 withLength :: Lengthable a => [a] -> (Natural, [a])
 124 withLength x = (sum $ length <$> x, x)
 125
 126 text0 :: [Chunk (Line [Chunk (Word String)])]
 127 text0 = convert @String "123 45\n67 89\n  10 11 12"
 128
 129 {- |
 130  >>> justi JustifyCenter text0
 131  [Item (Line [Spaces 1,Item (Word "123"),Spaces 1,Item (Word "45"),Spaces 1]),Item (Line [Spaces 1,Item (Word "67"),Spaces 1,Item (Word "89"),Spaces 2]),Item (Line [Spaces 0,Item (Word "10"),Spaces 1,Item (Word "11"),Spaces 1,Item (Word "12"),Spaces 0])]
 132 -}
 133
 134 -- >>> justi JustifyStart text0
 135 -- [Item (Line [Item (Word "123"),Spaces 1,Item (Word "45"),Spaces 2]),Item (Line [Item (Word "67"),Spaces 1,Item (Word "89"),Spaces 3]),Item (Line [Item (Word "10"),Spaces 1,Item (Word "11"),Spaces 1,Item (Word "12"),Spaces 0])]
 136
 137 -- >>> justi JustifyEnd text0
 138 -- [Item (Line [Spaces 2,Item (Word "123"),Spaces 1,Item (Word "45")]),Item (Line [Spaces 3,Item (Word "67"),Spaces 1,Item (Word "89")]),Item (Line [Spaces 0,Item (Word "10"),Spaces 1,Item (Word "11"),Spaces 1,Item (Word "12")])]
 139
 140 -- >>> justi JustifySpaceBetween text0
 141 -- [Item (Line [Item (Word "123"),Spaces 2,Item (Word "45")]),Item (Line [Item (Word "67"),Spaces 2,Item (Word "89")]),Item (Line [Item (Word "10"),Spaces 1,Item (Word "11"),Spaces 1,Item (Word "12")])]
 142 {-
 143 justi ::
 144   Semigroup o =>
 145   Lengthable o =>
 146   Justify ->
 147   [Chunk [Chunk o]] ->
 148   [Chunk [Chunk o]]
 149 justi jus ls =
 150   (<$> ls) $
 151     \lineChunk ->
 152       (<$> lineChunk) $ \li -> (<$> li) $ \l ->
 153         justifyChunks jus minWitdh (length l, l)
 154   where
 155     --(maxCols, maxWidths, rows) = List.foldr go (0, List.repeat 0, []) ls
 156     minWitdh :: Natural
 157     minWitdh =
 158       List.foldl'
 159         ( \acc -> \case
 160             ChunkInvisible{} -> acc
 161             ChunkItem o -> length o
 162             ChunkSpaces{} -> acc
 163         )
 164         0
 165         ls
 166 -}
 167 -- formatChunks ::
 168 --   forall o.
 169 --   Semigroup o =>
 170 --   Justify ->
 171 --   Justify ->
 172 --   {-vertLimit-} Natural ->
 173 --   {-horizLimit-} Natural ->
 174 --   [Chunk [Measured (Chunk o)]] ->
 175 --   {-lines-} Measured [Chunk {-words-} (Measured [Chunk o])]
 176 -- formatChunks vertJus horizJus vertLimit horizLimit vertChunks =
 177 --   justifyChunks
 178 --     DirectionHorizontal
 179 --     vertJus
 180 --     vertLimit
 181 --     $ fmap (\(v,cs) -> Measured 0 v cs)
 182 --     $ List.mapAccumL
 183 --       ( \vertDim vertChunk ->
 184 --           case vertChunk of
 185 --             ChunkInvisible o -> (vertDim, ChunkInvisible o)
 186 --             ChunkSpaces s -> (vertDim + s, ChunkSpaces s)
 187 --             ChunkItem vertItem ->
 188 --               ( vertDim + horizHeight
 189 --               , ChunkItem $
 190 --                   --Measured horizLimit horizHeight
 191 --                   justifyChunks
 192 --                     DirectionVertical
 193 --                     horizJus
 194 --                     horizLimit
 195 --                     vertItem
 196 --               )
 197 --               where
 198 --                 horizHeight = maxOn' measuredHeight vertItem
 199 --       )
 200 --       0
 201 --       vertChunks
 202
 203 {- | A strict version of 'sum', using a custom valuation function.
 204
 205  > sumOn' read ["1", "2", "3"] == 6
 206 -}
 207 sumOn' :: Num b => (a -> b) -> [a] -> b
 208 sumOn' f = List.foldl' (\acc x -> acc + f x) 0
 209
 210 maxOn' :: (a -> Natural) -> [a] -> Natural
 211 maxOn' f = List.foldl' (\acc x -> acc `max` f x) 0
 212
 213 {- | A version of 'maximum' where the comparison is done on some extracted value.
 214    Raises an error if the list is empty. Only calls the function once per element.
 215
 216  > maximumOn id [] == undefined
 217  > maximumOn length ["test","extra","a"] == "extra"
 218 -}
 219 maximumOn :: Ord b => (a -> b) -> [a] -> a
 220 maximumOn f [] = error "Data.List.Extra.maximumOn: empty list"
 221 maximumOn f (x : xs) = g x (f x) xs
 222   where
 223     g v mv [] = v
 224     g v mv (x : xs)
 225       | mx > mv = g x mx xs
 226       | otherwise = g v mv xs
 227       where
 228         mx = f x
 229
 230 {-
 231 >>> text0
 232 [Item (Line [Item (Word "123"),Spaces 1,Item (Word "45")]),Item (Line [Item (Word "67")]),Item (Line [Item (Word "89"),Spaces 1,Item (Word "10")])]
 233
 234 >>> length text0
 235 3
 236
 237 >>> justifyChunks JustifyCenter 30 (length text0, text0)
 238 [Spaces 13,Item (Line [Item (Word "123"),Spaces 1,Item (Word "45")]),Item (Line [Item (Word "67")]),Item (Line [Item (Word "89"),Spaces 1,Item (Word "10")]),Spaces 14]
 239
 240 >>> justifyChunks JustifySpaceBetween 30 (length text0, text0)
 241 [Item (Line [Item (Word "123"),Spaces 1,Item (Word "45")]),Item (Line [Item (Word "67")]),Item (Line [Item (Word "89"),Spaces 1,Item (Word "10")])]
 242 -}
 243 justifyChunks ::
 244   Semigroup o =>
 245   Direction ->
 246   Justify ->
 247   Natural ->
 248   [Measured (Chunk o)] ->
 249   Measured [Chunk o]
 250 justifyChunks dir jus limitDim measuredChunks =
 251   let chunksDim = List.sum (mea <$> measuredChunks)
 252       chunks = unMeasured <$> measuredChunks
 253       mea = case dir of
 254         DirectionHorizontal -> measuredVertical
 255         DirectionVertical -> measuredHorizontal
 256    in Measured
 257         { measuredHorizontal = 0
 258         , measuredVertical = 0
 259         , unMeasured = case limitDim `minusNaturalMaybe` chunksDim of
 260             Nothing -> chunks
 261             Just padLen ->
 262               case jus of
 263                 JustifyStart -> chunks <> [ChunkSpaces padLen]
 264                 JustifyEnd -> [ChunkSpaces padLen] <> chunks
 265                 JustifyCenter -> [ChunkSpaces halfPadLen] <> chunks <> [ChunkSpaces (padLen - halfPadLen)]
 266                   where
 267                     -- NOTE: may be 0
 268                     halfPadLen = padLen `div` 2
 269                 JustifySpaceBetween ->
 270                   if itemsCount > 0
 271                     then spaceBetweenItems chunks padLens
 272                     else chunks <> [ChunkSpaces padLen]
 273                   where
 274                     itemsCount = countItems chunks
 275                     padLens = justifyPadding padLen itemsCount
 276                     spaceBetweenItems :: [Chunk o] -> [Natural] -> [Chunk o]
 277                     spaceBetweenItems (x : xs) pads@(p : ps) =
 278                       case x of
 279                         ChunkSpaces _w -> ChunkSpaces (p + 1) : spaceBetweenItems xs ps
 280                         _ -> x : spaceBetweenItems xs pads
 281                     spaceBetweenItems (w : ws) [] = w : spaceBetweenItems ws []
 282                     spaceBetweenItems [] _os = mempty
 283         }
 284
 285 instance IsString (Rect String) where
 286   fromString s =
 287     Rects
 288       { rectDirection = DirectionHorizontal
 289       , rectJustify = JustifyStart
 290       , rectWrap = False
 291       , rectAxis = rectOfWords . wordsNoEmpty <$> lines s
 292       }
 293     where
 294       rectOfWords :: [Word String] -> Rect String
 295       rectOfWords ws =
 296         Rects
 297           { rectDirection = DirectionHorizontal
 298           , rectJustify = JustifyStart
 299           , rectWrap = False
 300           , rectAxis = (\(Word x) -> Rect (fromIntegral (List.length x), [x])) <$> ws
 301           }
 302
 303 rect0 :: Rect String
 304 rect0 =
 305   Rects
 306     { rectDirection = DirectionHorizontal
 307     , rectJustify = JustifyStart
 308     , rectWrap = False
 309     , rectAxis = ["abc"]
 310     }
 311 rect1 :: Rect String
 312 rect1 =
 313   Rects
 314     { rectDirection = DirectionHorizontal
 315     , rectJustify = JustifyStart
 316     , rectWrap = True
 317     , rectAxis = ["abc", "abcd", "abc"]
 318     }
 319 rect2 :: Rect [Char]
 320 rect2 =
 321   Rects
 322     { rectDirection = DirectionVertical
 323     , rectJustify = JustifyStart
 324     , rectWrap = False
 325     , rectAxis =
 326         [ Rects
 327             { rectDirection = DirectionHorizontal
 328             , rectJustify = JustifyStart
 329             , rectWrap = True
 330             , rectAxis = ["123", "4567", "890"]
 331             }
 332         , Rects
 333             { rectDirection = DirectionHorizontal
 334             , rectJustify = JustifyStart
 335             , rectWrap = True
 336             , rectAxis = ["abc", "defg", "hij"]
 337             }
 338         ]
 339     }
 340
 341 {- | @(measureRect limitH limitV rect)@ return the given @(rect)@
 342 with minimal 'rectMeasure's, trying to fit the given limits when 'rectWrap' is 'True'.
 343
 344 >>> measureRect Nothing Nothing rectH3V1
 345 Rect {rectContent = "abc"}
 346
 347 >>> measureRect Nothing Nothing rect1
 348 Rects {rectMeasure = (10,1), rectDirection = DirectionHorizontal, rectJustify = JustifyStart, rectWrap = False, rectAxis = [Rect {rectContent = "abc"},Rect {rectContent = "abcd"},Rect {rectContent = "abc"}]}
 349
 350 >>> measureRect (Just 4) Nothing rect1{rectWrap=True}
 351 Rects {rectMeasure = (4,3), rectDirection = DirectionHorizontal, rectJustify = JustifyStart, rectWrap = True, rectAxis = [Rect {rectContent = "abc"},Rect {rectContent = "abcd"},Rect {rectContent = "abc"}]}
 352
 353 >>> measureRect (Just 2) Nothing rect1{rectWrap=True, rectDirection = DirectionVertical}
 354 Rects {rectMeasure = (7,2), rectDirection = DirectionVertical, rectJustify = JustifyStart, rectWrap = True, rectAxis = [Rect {rectContent = "abc"},Rect {rectContent = "abcd"},Rect {rectContent = "abc"}]}
 355 -}
 356
 357 {- |
 358
 359 >>> renderRect Nothing Nothing rect0
 360 ((3,1),[["abc"]])
 361
 362 >>> renderRect Nothing Nothing rect1
 363 ((10,1),[["abc","abcd","abc"]])
 364
 365 >>> renderRect Nothing Nothing rect2
 366 ((10,2),[["123","4567","890","abc","defg","hij"]])
 367
 368 >>> renderRect (Just 4) Nothing rect2
 369 ((4,6),[["123"," ","abc"," "],["4567","defg"],["890"," ","hij"," "]])
 370 -}
 371 renderRect ::
 372   forall o.
 373   Semigroup o =>
 374   Show o =>
 375   Dimensionable o =>
 376   Padable o =>
 377   Maybe Natural ->
 378   Maybe Natural ->
 379   Rect o ->
 380   ((Natural, Natural), [[o]])
 381 renderRect limitH limitV is =
 382   traceShow ("renderRect" :: String, limitH, limitV, is, "res" :: String, res) res
 383   where
 384     res =
 385       case is of
 386         Rect (n, ws) -> ((n, 1), [ws])
 387         Rects{..} ->
 388           let (_finalH, _finalV, maximalH, maximalV, renderedRects) =
 389                 List.foldl'
 390                   ( \(currH, currV, maxH, maxV, rectHV) rect ->
 391                       let (dim, rectRendered) =
 392                             renderRect
 393                               (limitH `minusOrZero` currH)
 394                               (limitV `minusOrZero` currV)
 395                               rect
 396                           newDim@(rectH, rectV) =
 397                             case rectDirection of
 398                               DirectionHorizontal -> dim
 399                               DirectionVertical -> swap dim
 400                           newH = currH + (if currH == 0 || rectDirection == DirectionVertical then 0 else 1) + rectH
 401                        in case limitH of
 402                             Just limH
 403                               -- Limit overflow, and wrapping
 404                               | limH < newH && rectWrap ->
 405                                 traceShow ("overflow" :: String, limH, newH) $
 406                                   (rectH, maxV, maxH `max` rectH, maxV + rectV, newRectHV)
 407                               where
 408                                 -- Word goes into a new line
 409                                 newRectHV = [(newDim, rectRendered)] : rectHV
 410                             -- No limit, or no overflow, or no wrapping
 411                             _ -> (newH, currV, maxH + rectH, maxV `max` rectV, newRectHV)
 412                               where
 413                                 -- Word goes into the same line
 414                                 newRectHV = case rectHV of
 415                                   [] -> [[(newDim, rectRendered)]]
 416                                   r : rs -> ((newDim, rectRendered) : r) : rs
 417                   )
 418                   (0, 0, 0, 0, [])
 419                   rectAxis
 420            in ( case rectDirection of
 421                   DirectionHorizontal -> (maximalH, maximalV)
 422                   DirectionVertical -> (maximalV, maximalH)
 423               , concatHV maximalH maximalV (List.reverse $ List.reverse <$> renderedRects)
 424               -- (traceShow ("renderedRects" :: String, renderedRects) $ List.reverse renderedRects)
 425               )
 426     -- concatRender :: [[o]] -> [[o]] -> [[o]]
 427     -- concatRender = List.zipWith (<>)
 428     -- Should probably change a wrapped H rect into a V rect containing H rects
 429     -- Now reads rectAxis from the left to right, top to bottom
 430     -- and make each line reach at least maximalH
 431     -- case rectJustify of
 432     --   JustifyStart ->
 433     --     ((\line -> line <> replicate (maximalH - List.length line) ' ') <$> lines)
 434     --     <> replicate (maximalV - List.length lines) (replicate maximalH ' ')
 435
 436     minusOrZero :: Maybe Natural -> Natural -> Maybe Natural
 437     minusOrZero Nothing _m = Nothing
 438     minusOrZero (Just n) m = minusNaturalMaybe n m <|> Just 0
 439
 440 {-
 441 @
 442
 443 >>> concatH 10 2 [((3,1), [["123"]])]
 444 [["123","       "],["   ","       "]]
 445
 446 >>> concatH 10 2 [((3,2), [["123"], ["ab "]]), ((4,1), [["4567"]])]
 447 [["123","4567","   "],["ab ","    ","   "]]
 448
 449 >>> concatH 4 3 [((4,3),[["abc"," "],["defg"],["hij"," "]])]
 450 [["abc"," "],["defg"],["hij"," "]]
 451
 452 >>> concatH 8 3 [((4,3),[["123"," "],["4567"],["890"," "]]), ((4,3),[["abc"," "],["defg"],["hij"," "]])]
 453 [["123"," ","abc"," "],["4567","defg"],["890"," ","hij"," "]]
 454
 455 @
 456 -}
 457 concatH :: Padable o => Show o => Natural -> Natural -> [((Natural, Natural), [[o]])] -> [[o]]
 458 concatH maxH maxV rs =
 459   traceShow
 460     ("concatH" :: String, maxH, maxV, rs, "res" :: String, res)
 461     res
 462   where
 463     (res, rsH) =
 464       List.foldr
 465         ( \((rH, rV), r) (acc, accH) ->
 466             let rPlusVPad = case maxV `minusNaturalMaybe` rV of
 467                   Nothing -> error "concatH: given maxV is lower than the actual maximal V length"
 468                   Just dV -> r <> List.replicate (fromIntegral dV) [padding rH]
 469              in (List.zipWith (<>) rPlusVPad acc, accH + rH)
 470         )
 471         (List.replicate (fromIntegral maxV) [padding dH | dH /= 0], 0)
 472         rs
 473     dH =
 474       fromMaybe (error "concatH: given maxH is lower than the actual maximal H length ") $
 475         maxH `minusNaturalMaybe` rsH
 476
 477 {-
 478 concatH maxH maxV [] = List.replicate (fromIntegral maxV) [padding maxH | maxH /= 0]
 479 concatH maxH maxV (((rH, rV), r) : rs) = case maxH `minusNaturalMaybe` rH of
 480   Nothing -> error "concatH: given maxH is lower than the actual maximal H length "
 481   Just dH -> List.zipWith (<>) rPlusVPad (concatH dH maxV rs)
 482   where
 483     rPlusVPad = case maxV `minusNaturalMaybe` rV of
 484       Nothing -> error "concatH: given maxV is lower than the actual maximal V length"
 485       Just dV -> r <> List.replicate (fromIntegral dV) [padding rH]
 486 -}
 487 {-
 488 @
 489
 490 >>> concatV 10 2 [((3,1), [["123"]])]
 491 [["123","       "],["          "]]
 492
 493 >>> concatV 4 3 [((3,2), [["123"], ["ab "]]), ((4,1), [["4567"]])]
 494 [["123"," "],["ab "," "],["4567"]]
 495
 496 >>> concatV 4 3 [((4,3),[["abc"," "],["defg"],["hij"," "]])]
 497 [["abc"," "],["defg"],["hij"," "]]
 498
 499 >>> concatV 4 6 [((4,3),[["123"," "],["4567"],["890"," "]]), ((4,3),[["abc"," "],["defg"],["hij"," "]])]
 500 [["123"," "],["4567"],["890"," "],["abc"," "],["defg"],["hij"," "]]
 501
 502 @
 503 -}
 504 concatV :: Padable o => Show o => Natural -> Natural -> [((Natural, Natural), [[o]])] -> [[o]]
 505 concatV maxH maxV [] = List.replicate (fromIntegral maxV) [padding maxH | maxH /= 0]
 506 concatV maxH maxV (((rH, rV), r) : rs) = case maxV `minusNaturalMaybe` rV of
 507   Nothing -> error "concatV: given maxH is lower than actual maximal H length"
 508   Just dV -> rPlusHPad <> concatV maxH dV rs
 509   where
 510     rPlusHPad = case maxH `minusNaturalMaybe` rH of
 511       Nothing -> error "concatV: given maxV is lower than actual maximal V length"
 512       Just dH
 513         | dH == 0 -> r
 514         | otherwise -> List.zipWith (<>) r $ List.replicate (fromIntegral rV) [padding dH]
 515
 516 {- |
 517 @
 518 >>> concatHV 10 2 [[((3,2), [["123"], ["ab "]]), ((4,1), [["4567"]])]]
 519 [["123","4567","   "],["ab ","    ","   "]]
 520
 521 >>> concatHV 10 3 [[((3,2), [["123"], ["ab "]]), ((4,1), [["4567"]])]]
 522 [["123","4567","   "],["ab ","    ","   "],["          "]]
 523
 524 >>> concatHV 4 6 [ [((4,3),[["123"," "],["4567"],["890"," "]])], [((4,3),[["abc"," "],["defg"],["hij"," "]])] ]
 525 [["123"," "],["4567"],["890"," "],["abc"," "],["defg"],["hij"," "]]
 526 -}
 527 concatHV :: Padable o => Show o => Natural -> Natural -> [[((Natural, Natural), [[o]])]] -> [[o]]
 528 concatHV maxH maxV rs = concatV maxH maxV $ f <$> rs
 529   where
 530     f r = ((maxH, rV), concatH maxH rV r)
 531       where
 532         rV = List.maximum $ snd . fst <$> r
 533
 534 {-
 535 @
 536 >>> concatV 10 2 [[((3,2), [["123"], ["ab "]]), ((4,1), [["4567"]])]]
 537 [["123","4567","   "],["ab ","    ","   "]]
 538
 539 >>> concatV 10 3 [[((3,2), [["123"], ["ab "]]), ((4,1), [["4567"]])]]
 540 [["123","4567","   "],["ab ","    ","   "],["          "]]
 541
 542 >>> concatV3 4 6 [ [((4,3),[["123"," "],["4567"],["890"," "]])], [((4,3),[["abc"," "],["defg"],["hij"," "]])] ]
 543 [["123"," "],["4567"],["890"," "],["abc"," "],["defg"],["hij"," "]]
 544 concatV :: Padable o => Show o => Natural -> Natural -> [[((Natural, Natural), [[o]])]] -> [[o]]
 545 concatV maxH maxV rs =
 546   traceShow
 547     ("concatV" :: String, maxH, maxV, rs, "res" :: String, res)
 548     res
 549   where
 550     (res, rsV) =
 551       List.foldr
 552         ( \r (acc, accV) ->
 553             let rV = List.maximum $ snd . fst <$> r
 554              in (concatH maxH rV r <> acc, accV + rV)
 555         )
 556         (List.replicate (fromIntegral $ maxV - rsV) [padding maxH], 0)
 557         rs
 558 -}
 559
 560 {-
 561 concatV maxH maxV []
 562   | maxV == 0 = []
 563   | otherwise = List.replicate (fromIntegral maxV) [padding maxH]
 564 concatV maxH maxV (r : rs) =
 565   List.zipWith (<>) (concatH maxH rV r) (concatV maxH (maxV - rV) rs)
 566   where
 567     rV = List.maximum $ snd . fst <$> r
 568 -}
 569 -- where
 570 --   paddedR = case maxH `minusNaturalMaybe` rH of
 571 --     Nothing -> r
 572 --     Just p -> r <> List.replicate (fromIntegral p) [padding rH]
 573
 574 {- | @('zipWithLongest xPadLen yPadLen xs ys')@ zips together the lists @(xs)@ and @(ys)@
 575  padding the @(xs)@ (resp. @(ys)@) elements with a 'padding' of @(xPadLen)@ (resp. @(yPadLen)@)
 576  when it is shorter than the corresponding one in @(ys)@ (resp. @(xs)@).
 577
 578 >>> zipWithLongest []
 579 -}
 580 zipWithLongest :: Padable o => Natural -> Natural -> [[o]] -> [[o]] -> [[o]]
 581 zipWithLongest _ _ [] [] = []
 582 zipWithLongest xP yP (x0 : xs) (y0 : ys) = x0 <> y0 : zipWithLongest xP yP xs ys
 583 zipWithLongest _xP yP [] ys
 584   | yP <= 0 = ys
 585   | otherwise = List.map (padding yP :) ys
 586 zipWithLongest xP _yP xs []
 587   | xP <= 0 = xs
 588   | otherwise = List.map (<> [padding xP]) xs
 589
 590 class Padable o where
 591   padding :: Natural -> o
 592 instance Padable String where
 593   padding n = List.replicate (fromIntegral n) ' '
 594
 595 {-
 596 >>> renderRect $ measureRect (Just 2) Nothing rect1{rectWrap=True, rectDirection = DirectionVertical}
 597 ["abc","abcd","abc"]
 598 renderRect :: Dimensionable o => Rect (Natural, Natural) o -> [o]
 599 renderRect = \case
 600   Rect{..} -> [rectContent]
 601   Rects{rectMeasure = (measureH, measureV), ..} ->
 602     List.concat $ renderRect <$> rectAxis
 603 -}
 604
 605 -- fitRect :: Rect o -> Measured (Rect o)
 606 -- fitRect r = case r of
 607 --   Rect m -> m{unMeasured r}
 608 --   Rects{..} ->
 609 --     let rectsCount = fromIntegral $ max 0 $ List.length rectAxis - 1 in
 610 --     case rectDirection of
 611 --       DirectionHorizontal ->
 612 --         Rects
 613 --           {
 614 --             rectAxis =
 615 --               List.mapAccumL
 616 --                 (\r acc ->
 617 --                     let m = fitRect r in
 618 --                     case measuredHeight acc `compare` measuredHeight m of
 619 --                       LT -> undefined -- acc must be justified upto m
 620 --                       EQ -> acc{measureWidth = measuredWidth acc + measuredWidth m}
 621 --                       GT -> undefined -- m must be justified upto acc
 622 --                 ) rectAxis
 623 --           }
 624 -- renderRect :: Maybe Natural -> Maybe Natural -> Rect o -> [[o]]
 625 -- renderRect horizLimit vertLimit = \case
 626 --   Rect (Measured w h c) -> [[c]]
 627 --   Rects{..} ->
 628 --     renderRect rectAxis
 629
 630 -- * Type 'Rect'
 631 data Rect o
 632   = Rect
 633       { rectContent :: (Natural, [o])
 634       }
 635   | Rects
 636       { rectDirection :: Direction
 637       , rectJustify :: Justify
 638       , rectWrap :: Bool
 639       , rectAxis :: [Rect o]
 640       }
 641   deriving (Show)
 642
 643 {-
 644 instance Dimensionable o => Dimensionable (Rect (Natural, Natural) o) where
 645   width = \case
 646     Rect{..} -> width rectContent
 647     Rects{rectMeasure = (h, _)} -> h
 648   height = \case
 649     Rect{..} -> height rectContent
 650     Rects{rectMeasure = (_, v)} -> v
 651 -}
 652 instance Dimensionable String where
 653   width s = fromIntegral $ List.maximum $ List.length <$> splitOnChar (== '\n') s
 654   height s = fromIntegral $ List.length $ splitOnChar (== '\n') s
 655
 656 data Adjustment o
 657   = AdjustmentVariable Natural
 658   | AdjustmentFixed o
 659
 660 -- ** Type 'Chunk'
 661 data Chunk o
 662   = ChunkItem !o
 663   | -- | Whites preserved to be interleaved
 664     -- correctly with 'ChunkInvisible'.
 665     ChunkSpaces !Natural
 666   | -- | Ignored by the justification but kept in place.
 667     -- Used to put ANSI sequences.
 668     ChunkInvisible !o
 669   deriving (Functor)
 670
 671 runChunk :: Outputable o => Chunk o -> o
 672 runChunk = \case
 673   ChunkInvisible o -> o
 674   ChunkItem o -> o
 675   ChunkSpaces s -> repeatedChar s ' '
 676
 677 instance Show o => Show (Chunk o) where
 678   showsPrec p x =
 679     showParen (p > 10) $
 680       case x of
 681         ChunkInvisible o -> showString "Ignored" . showsPrec 11 o
 682         ChunkItem o -> showString "Item " . showsPrec 11 o
 683         ChunkSpaces w -> showString "Spaces " . showsPrec 11 w
 684
 685 -- instance Lengthable o => Lengthable (Chunk (Line o)) where
 686 --   length = \case
 687 --     ChunkInvisible{} -> 0
 688 --     ChunkItem o
 689 --       | isEmpty o -> 0
 690 --       | otherwise -> 1
 691 --     ChunkSpaces w -> w
 692 --   isEmpty = \case
 693 --     ChunkInvisible{} -> True
 694 --     ChunkItem o -> isEmpty o
 695 --     ChunkSpaces w -> w == 0
 696 -- instance Lengthable o => Lengthable (Chunk (Word o)) where
 697 --   length = \case
 698 --     ChunkInvisible{} -> 0
 699 --     ChunkItem o -> length o
 700 --     ChunkSpaces w -> w
 701 --   isEmpty = \case
 702 --     ChunkInvisible{} -> True
 703 --     ChunkItem o -> isEmpty o
 704 --     ChunkSpaces w -> w == 0
 705 -- instance Lengthable (Chunk o) => Lengthable [Chunk o] where
 706 --   length = List.foldl' (\acc out -> acc + length out) 0
 707 --  isEmpty = List.all isEmpty
 708
 709 {- | @('wordsCount' ps)@ returns the number of words in @(ps)@
 710  clearly separated by spaces.
 711 -}
 712 countItems :: [Chunk o] -> Natural
 713 countItems = go False 0
 714   where
 715     go isAdjacentItem acc = \case
 716       [] -> acc
 717       ChunkInvisible{} : xs -> go isAdjacentItem acc xs
 718       ChunkSpaces w : xs
 719         | w == 0 -> go isAdjacentItem acc xs
 720         | otherwise -> go False acc xs
 721       ChunkItem{} : xs ->
 722         if isAdjacentItem
 723           then go isAdjacentItem acc xs
 724           else go True (acc + 1) xs
 725
 726 {- | @('justifyPadding' a b)@ returns the padding lengths
 727 to reach @(a)@ in @(b)@ pads,
 728 using the formula: @(a '==' m'*'(q '+' q'+'1) '+' ('r'-'m)'*'(q'+'1) '+' (b'-'r'-'m)'*'q)@
 729 where @(q+1)@ and @(q)@ are the two padding lengths used and @(m = min (b-r) r)@.
 730
 731 A simple implementation of 'justifyPadding' could be:
 732 @
 733 'justifyPadding' a b =
 734   'join' ('List.replicate' m [q,q'+'1])
 735   <> ('List.replicate' (r'-'m) (q'+'1)
 736   <> ('List.replicate' ((b'-'r)'-'m) q
 737   where
 738   (q,r) = a`divMod`b
 739   m = 'min' (b-r) r
 740 @
 741
 742 >>> justifyPadding 30 7
 743 [4,5,4,5,4,4,4]
 744 -}
 745 justifyPadding :: Natural -> Natural -> [Natural]
 746 justifyPadding a b = go r (b - r) -- NOTE: r >= 0 && b-r >= 0 due to 'divMod'
 747   where
 748     (q, r) = a `quotRemNatural` b
 749     go 0 bmr = List.replicate (fromIntegral bmr) q -- when min (b-r) r == b-r
 750     go rr 0 = List.replicate (fromIntegral rr) (q + 1) -- when min (b-r) r == r
 751     go rr bmr = q : (q + 1) : go (rr `minusNatural` 1) (bmr `minusNatural` 1)
 752
 753 takeExactly :: o -> Natural -> [o] -> [o]
 754 takeExactly pad len inp =
 755   if len <= 0
 756     then inp
 757     else case inp of
 758       [] -> List.replicate (fromIntegral len) pad
 759       o : next -> o : takeExactly pad (len - 1) next
 760
 761 -- https://codepen.io/enxaneta/full/adLPwv/
 762 -- https://github.com/jordwalke/flex/blob/master/src/lib/Layout.re
 763 data Direction
 764   = DirectionHorizontal
 765   | DirectionVertical
 766   deriving (Eq, Show)
 767 data Justify
 768   = JustifyStart
 769   | JustifyEnd
 770   | JustifyCenter
 771   | JustifyStretch
 772   | JustifySpaceBetween
 773   | JustifySpaceAround
 774   deriving (Show)
 775
 776 {-
 777 type ItemAlignSelf = Maybe Align
 778
 779 data Container o = Container
 780   { containerDirection :: Direction
 781   , containerWrap :: Bool
 782   , containerAlignItems :: Align
 783   , containerJustifyContent :: Align
 784   , containerAlignContent :: Align
 785   , containerItems :: [Item o]
 786   }
 787 data Item o = Item
 788   { itemAlignSelf :: Maybe Align
 789   , itemFlexGrow :: Natural
 790   , itemFlexShrink :: Natural
 791   , itemFlexOrder :: Natural
 792   , itemContent :: o
 793   }
 794
 795 2. Determine the available main and cross space for the flex items.
 796 3. Determine the flex base size and hypothetical main size of each item:
 797 4. Determine the main size of the flex container using the rules of the formatting context in which it participates.
 798 5. Collect flex items into flex lines
 799 6. Resolve the flexible lengths of all the flex items to find their used main size.
 800 7. Determine the hypothetical cross size of each item by performing layout with the used main size and the available space, treating auto as fit-content.
 801 8. Calculate the cross size of each flex line.
 802 9. Handle 'align-content: stretch'.
 803 10. Collapse visibility:collapse items.
 804 11. Determine the used cross size of each flex item.
 805 12. Distribute any remaining free space.
 806 13. Resolve cross-axis auto margins.
 807 14. Align all flex items along the cross-axis per align-self, if neither of the item’s cross-axis margins are auto.
 808 15. Determine the flex container’s used cross size
 809 16. Align all flex lines per align-content.
 810
 811 Resolving Flexible Lengths
 812 1. Determine the used flex factor.
 813 2. Size inflexible items.
 814 3. Calculate initial free space.
 815 4. Loop:
 816   4.1 Check for flexible items.
 817   4.2 Calculate the remaining free space as for initial free space, above.
 818   4.3 Distribute free space proportional to the flex factors.
 819   4.4 Fix min/max violations.
 820   4.5 Freeze over-flexed items.
 821
 822 -}
 823
 824 -- * Type 'Writer'
 825
 826 -- -- | Church encoded for performance concerns.
 827 -- -- Kinda like 'ParsecT' in @megaparsec@ but a little bit different
 828 -- -- due to the use of 'WriterFit' for implementing 'breakingSpace' correctly
 829 -- -- when in the left hand side of ('<.>').
 830 -- -- Prepending is done using continuation, like in a difference list.
 831 -- newtype Writer (o :: Type) a = Writer
 832 --   { unWriter ::
 833 --       a ->
 834 --       {-curr-} WriterInh o ->
 835 --       {-curr-} WriterState o ->
 836 --       {-ok-} (({-prepend-} (o -> o {-new-}), WriterState o) -> WriterFit o) ->
 837 --       WriterFit o
 838 --       -- NOTE: equivalent to:
 839 --       -- ReaderT WriterInh (StateT (WriterState o) (Cont (WriterFit o))) (o->o)
 840 --   }
 841 --
 842 -- runWriter :: Monoid o => Writer o a -> a -> o
 843 -- runWriter x a =
 844 --   unWriter
 845 --     x
 846 --     a
 847 --     defWriterInh
 848 --     defWriterState
 849 --     {-k-} ( \(px, _sx) fits _overflow ->
 850 --               -- NOTE: if px fits, then appending mempty fits
 851 --               fits (px mempty)
 852 --           )
 853 --     {-fits-} id
 854 --     {-overflow-} id
 855
 856 -- ** Type 'WriterFit'
 857
 858 {-
 859 -- | Double continuation to qualify the returned document
 860 -- as fitting or overflowing the given 'plainInh_width'.
 861 -- It's like @('Bool',o)@ in a normal style
 862 -- (a non continuation-passing-style).
 863 type WriterFit o =
 864   {-fits-} (o -> o) ->
 865   {-overflow-} (o -> o) ->
 866   o
 867
 868 -- ** Type 'WriterInh'
 869 data WriterInh o = WriterInh
 870   { plainInh_width :: !(Maybe Column)
 871   , plainInh_justify :: !Bool
 872   , plainInh_indent :: !Indent
 873   , plainInh_indenting :: !(Writer o ())
 874   , plainInh_sgr :: ![SGR]
 875   }
 876
 877 defWriterInh :: Monoid o => WriterInh o
 878 defWriterInh =
 879   WriterInh
 880     { plainInh_width = Nothing
 881     , plainInh_justify = False
 882     , plainInh_indent = 0
 883     , plainInh_indenting = empty
 884     , plainInh_sgr = []
 885     }
 886
 887 -- ** Type 'WriterState'
 888 data WriterState o = WriterState
 889   { plainState_buffer :: ![WriterChunk o]
 890   , -- | The 'Column' from which the 'plainState_buffer'
 891     -- must be written.
 892     plainState_bufferStart :: !Column
 893   , -- | The 'Width' of the 'plainState_buffer' so far.
 894     plainState_bufferWidth :: !Width
 895   , -- | The amount of 'Indent' added by 'breakspace'
 896     -- that can be reached by breaking the 'space'
 897     -- into a 'newlineJustifyingWriter'.
 898     plainState_breakIndent :: !Indent
 899   }
 900   deriving (Show)
 901
 902 defWriterState :: WriterState o
 903 defWriterState =
 904   WriterState
 905     { plainState_buffer = mempty
 906     , plainState_bufferStart = 0
 907     , plainState_bufferWidth = 0
 908     , plainState_breakIndent = 0
 909     }
 910
 911 -- ** Type 'WriterChunk'
 912 data WriterChunk o
 913   = -- | Ignored by the justification but kept in place.
 914     -- Used for instance to put ANSI sequences.
 915     WriterChunk_Ignored !o
 916   | WriterChunk_Word !(Word o)
 917   | -- | 'spaces' preserved to be interleaved
 918     -- correctly with 'WriterChunk_Ignored'.
 919     WriterChunk_Spaces !Width
 920 instance Show o => Show (WriterChunk o) where
 921   showsPrec p x =
 922     showParen (p > 10) $
 923       case x of
 924         WriterChunk_Ignored o ->
 925           showString "Z "
 926             . showsPrec 11 o
 927         WriterChunk_Word (Word o) ->
 928           showString "W "
 929             . showsPrec 11 o
 930         WriterChunk_Spaces s ->
 931           showString "S "
 932             . showsPrec 11 s
 933 instance Lengthable o => Lengthable (WriterChunk o) where
 934   length = \case
 935     WriterChunk_Ignored{} -> 0
 936     WriterChunk_Word o -> length o
 937     WriterChunk_Spaces s -> s
 938   isEmpty = \case
 939     WriterChunk_Ignored{} -> True
 940     WriterChunk_Word o -> isEmpty o
 941     WriterChunk_Spaces s -> s == 0
 942
 943 --instance From [SGR] o => From [SGR] (WriterChunk o) where
 944 --  from sgr = WriterChunk_Ignored (from sgr)
 945
 946 instance Emptyable (Writer o) where
 947   empty = Writer $ \_a _inh st k -> k (id, st)
 948
 949 -}
 950
 951 -- >>> wordsNoEmpty (Line (" a b c "::String))
 952 -- [Word {unWord = "a"},Word {unWord = "b"},Word {unWord = "c"}]
 953 instance Convertible String o => Convertible String [Chunk (Line [Chunk (Word o)])] where
 954   convert =
 955     ( ChunkItem . Line
 956         . List.intersperse (ChunkSpaces 1)
 957         . (ChunkItem . convert <$>)
 958         . wordsNoEmpty
 959         <$>
 960     )
 961       . lines