{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}

module Unison.Util.Pretty
  ( Pretty,
    ColorText,
    align,
    align',
    alternations,
    background,
    backticked,
    backticked',
    boxForkLeft,
    boxLeft,
    boxLeftM,
    boxRight,
    boxRightM,
    bulleted,
    bracket,
    -- breakable
    callout,
    excerptSep,
    excerptSep',
    excerptColumn2,
    excerptColumn2Headed,
    warnCallout,
    blockedCallout,
    fatalCallout,
    okCallout,
    column2,
    column2sep,
    column2Header,
    column2M,
    column2UnzippedM,
    column3,
    column3M,
    column3UnzippedM,
    column3sep,
    column3Header,
    columnNHeader,
    commas,
    commented,
    oxfordCommas,
    oxfordCommasWith,
    plural,
    dashed,
    flatMap,
    group,
    hang',
    hang,
    hangUngrouped',
    hangUngrouped,
    softHang',
    softHang,
    softHangNoSpace',
    indent,
    indentAfterNewline,
    indentN,
    indentNonEmptyN,
    indentNAfterNewline,
    invert,
    isMultiLine,
    isEmpty,
    leftPad,
    lines,
    linesNonEmpty,
    linesSpaced,
    lit,
    map,
    mayColumn2,
    nest,
    num,
    newline,
    leftJustify,
    lineSkip,
    nonEmpty,
    numbered,
    numberedColumn2ListFrom,
    numberedColumn2Header,
    numberedColumnNHeader,
    numberedList,
    numberedListFrom,
    orElse,
    orElses,
    paragraphyText,
    parenthesize,
    parenthesizeCommas,
    parenthesizeIf,
    render,
    renderUnbroken,
    rightPad,
    sep,
    sepNonEmpty,
    sepSpaced,
    shown,
    pshown,
    singleQuoted,
    singleQuoted',
    softbreak,
    spaceIfBreak,
    spaceIfNeeded,
    spaced,
    spacedMap,
    spacedTraverse,
    spacesIfBreak,
    string,
    surroundCommas,
    syntaxToColor,
    table,
    text,
    toANSI,
    toAnsiUnbroken,
    toHTML,
    toPlain,
    toPlainUnbroken,
    underline,
    withSyntax,
    wrap,
    wrap',
    wrapColumn2,
    wrapString,
    black,
    red,
    green,
    yellow,
    blue,
    purple,
    cyan,
    white,
    hiBlack,
    hiRed,
    hiGreen,
    hiYellow,
    hiBlue,
    hiPurple,
    hiCyan,
    hiWhite,
    bold,
    border,
    Width (..),

    -- * Exported for testing
    delta,
    Delta,
  )
where

import Data.Char (isSpace)
import Data.List (intersperse)
import Data.List qualified as List
import Data.ListLike qualified as LL
import Data.Sequence qualified as Seq
import Data.Text qualified as Text
import Data.Text.Lazy qualified as Text.Lazy
import Text.Pretty.Simple (pShow)
import Unison.Prelude
import Unison.Util.AnnotatedText (annotateMaybe)
import Unison.Util.AnnotatedText qualified as AT
import Unison.Util.ColorText qualified as CT
import Unison.Util.Monoid (intercalateMap)
import Unison.Util.SyntaxText qualified as ST
import Prelude hiding (lines, map)

newtype Width = Width {Width -> Int
widthToInt :: Int}
  deriving stock (Width -> Width -> Bool
(Width -> Width -> Bool) -> (Width -> Width -> Bool) -> Eq Width
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Width -> Width -> Bool
== :: Width -> Width -> Bool
$c/= :: Width -> Width -> Bool
/= :: Width -> Width -> Bool
Eq, Eq Width
Eq Width =>
(Width -> Width -> Ordering)
-> (Width -> Width -> Bool)
-> (Width -> Width -> Bool)
-> (Width -> Width -> Bool)
-> (Width -> Width -> Bool)
-> (Width -> Width -> Width)
-> (Width -> Width -> Width)
-> Ord Width
Width -> Width -> Bool
Width -> Width -> Ordering
Width -> Width -> Width
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Width -> Width -> Ordering
compare :: Width -> Width -> Ordering
$c< :: Width -> Width -> Bool
< :: Width -> Width -> Bool
$c<= :: Width -> Width -> Bool
<= :: Width -> Width -> Bool
$c> :: Width -> Width -> Bool
> :: Width -> Width -> Bool
$c>= :: Width -> Width -> Bool
>= :: Width -> Width -> Bool
$cmax :: Width -> Width -> Width
max :: Width -> Width -> Width
$cmin :: Width -> Width -> Width
min :: Width -> Width -> Width
Ord, Int -> Width -> ShowS
[Width] -> ShowS
Width -> String
(Int -> Width -> ShowS)
-> (Width -> String) -> ([Width] -> ShowS) -> Show Width
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Width -> ShowS
showsPrec :: Int -> Width -> ShowS
$cshow :: Width -> String
show :: Width -> String
$cshowList :: [Width] -> ShowS
showList :: [Width] -> ShowS
Show, (forall x. Width -> Rep Width x)
-> (forall x. Rep Width x -> Width) -> Generic Width
forall x. Rep Width x -> Width
forall x. Width -> Rep Width x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Width -> Rep Width x
from :: forall x. Width -> Rep Width x
$cto :: forall x. Rep Width x -> Width
to :: forall x. Rep Width x -> Width
Generic)
  deriving newtype (Integer -> Width
Width -> Width
Width -> Width -> Width
(Width -> Width -> Width)
-> (Width -> Width -> Width)
-> (Width -> Width -> Width)
-> (Width -> Width)
-> (Width -> Width)
-> (Width -> Width)
-> (Integer -> Width)
-> Num Width
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Width -> Width -> Width
+ :: Width -> Width -> Width
$c- :: Width -> Width -> Width
- :: Width -> Width -> Width
$c* :: Width -> Width -> Width
* :: Width -> Width -> Width
$cnegate :: Width -> Width
negate :: Width -> Width
$cabs :: Width -> Width
abs :: Width -> Width
$csignum :: Width -> Width
signum :: Width -> Width
$cfromInteger :: Integer -> Width
fromInteger :: Integer -> Width
Num, Width
Width -> Width -> Bounded Width
forall a. a -> a -> Bounded a
$cminBound :: Width
minBound :: Width
$cmaxBound :: Width
maxBound :: Width
Bounded)

type ColorText = CT.ColorText

data Pretty s = Pretty {forall s. Pretty s -> Delta
delta :: Delta, forall s. Pretty s -> F s (Pretty s)
out :: F s (Pretty s)} deriving (Pretty s -> Pretty s -> Bool
(Pretty s -> Pretty s -> Bool)
-> (Pretty s -> Pretty s -> Bool) -> Eq (Pretty s)
forall s. Eq s => Pretty s -> Pretty s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall s. Eq s => Pretty s -> Pretty s -> Bool
== :: Pretty s -> Pretty s -> Bool
$c/= :: forall s. Eq s => Pretty s -> Pretty s -> Bool
/= :: Pretty s -> Pretty s -> Bool
Eq)

instance Functor Pretty where
  fmap :: forall a b. (a -> b) -> Pretty a -> Pretty b
fmap a -> b
f (Pretty Delta
d F a (Pretty a)
o) = Delta -> F b (Pretty b) -> Pretty b
forall s. Delta -> F s (Pretty s) -> Pretty s
Pretty Delta
d ((a -> b) -> F a (Pretty b) -> F b (Pretty b)
forall s t r. (s -> t) -> F s r -> F t r
mapLit a -> b
f (F a (Pretty b) -> F b (Pretty b))
-> F a (Pretty b) -> F b (Pretty b)
forall a b. (a -> b) -> a -> b
$ (Pretty a -> Pretty b) -> F a (Pretty a) -> F a (Pretty b)
forall a b. (a -> b) -> F a a -> F a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Pretty a -> Pretty b
forall a b. (a -> b) -> Pretty a -> Pretty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) F a (Pretty a)
o)

data F s r
  = Empty
  | -- | A group adds a level of breaking. Layout tries not to break a group
    -- unless needed to fit in available width. Breaking is done "outside in".
    --
    --   (a | b) <> (c | d) will try (a <> c), then (b <> d)
    --
    --   (a | b) <> group (c | d) will try (a <> c), then (b <> c), then (b <> d)
    Group r
  | Lit s
  | Wrap (Seq r)
  | OrElse r r
  | Append (Seq r)
  deriving (F s r -> F s r -> Bool
(F s r -> F s r -> Bool) -> (F s r -> F s r -> Bool) -> Eq (F s r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall s r. (Eq s, Eq r) => F s r -> F s r -> Bool
$c== :: forall s r. (Eq s, Eq r) => F s r -> F s r -> Bool
== :: F s r -> F s r -> Bool
$c/= :: forall s r. (Eq s, Eq r) => F s r -> F s r -> Bool
/= :: F s r -> F s r -> Bool
Eq, Int -> F s r -> ShowS
[F s r] -> ShowS
F s r -> String
(Int -> F s r -> ShowS)
-> (F s r -> String) -> ([F s r] -> ShowS) -> Show (F s r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall s r. (Show s, Show r) => Int -> F s r -> ShowS
forall s r. (Show s, Show r) => [F s r] -> ShowS
forall s r. (Show s, Show r) => F s r -> String
$cshowsPrec :: forall s r. (Show s, Show r) => Int -> F s r -> ShowS
showsPrec :: Int -> F s r -> ShowS
$cshow :: forall s r. (Show s, Show r) => F s r -> String
show :: F s r -> String
$cshowList :: forall s r. (Show s, Show r) => [F s r] -> ShowS
showList :: [F s r] -> ShowS
Show, (forall m. Monoid m => F s m -> m)
-> (forall m a. Monoid m => (a -> m) -> F s a -> m)
-> (forall m a. Monoid m => (a -> m) -> F s a -> m)
-> (forall a b. (a -> b -> b) -> b -> F s a -> b)
-> (forall a b. (a -> b -> b) -> b -> F s a -> b)
-> (forall b a. (b -> a -> b) -> b -> F s a -> b)
-> (forall b a. (b -> a -> b) -> b -> F s a -> b)
-> (forall a. (a -> a -> a) -> F s a -> a)
-> (forall a. (a -> a -> a) -> F s a -> a)
-> (forall a. F s a -> [a])
-> (forall a. F s a -> Bool)
-> (forall a. F s a -> Int)
-> (forall a. Eq a => a -> F s a -> Bool)
-> (forall a. Ord a => F s a -> a)
-> (forall a. Ord a => F s a -> a)
-> (forall a. Num a => F s a -> a)
-> (forall a. Num a => F s a -> a)
-> Foldable (F s)
forall a. Eq a => a -> F s a -> Bool
forall a. Num a => F s a -> a
forall a. Ord a => F s a -> a
forall m. Monoid m => F s m -> m
forall a. F s a -> Bool
forall a. F s a -> Int
forall a. F s a -> [a]
forall a. (a -> a -> a) -> F s a -> a
forall s a. Eq a => a -> F s a -> Bool
forall s a. Num a => F s a -> a
forall s a. Ord a => F s a -> a
forall m a. Monoid m => (a -> m) -> F s a -> m
forall s m. Monoid m => F s m -> m
forall s a. F s a -> Bool
forall s a. F s a -> Int
forall s a. F s a -> [a]
forall b a. (b -> a -> b) -> b -> F s a -> b
forall a b. (a -> b -> b) -> b -> F s a -> b
forall s a. (a -> a -> a) -> F s a -> a
forall s m a. Monoid m => (a -> m) -> F s a -> m
forall s b a. (b -> a -> b) -> b -> F s a -> b
forall s a b. (a -> b -> b) -> b -> F s a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall s m. Monoid m => F s m -> m
fold :: forall m. Monoid m => F s m -> m
$cfoldMap :: forall s m a. Monoid m => (a -> m) -> F s a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> F s a -> m
$cfoldMap' :: forall s m a. Monoid m => (a -> m) -> F s a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> F s a -> m
$cfoldr :: forall s a b. (a -> b -> b) -> b -> F s a -> b
foldr :: forall a b. (a -> b -> b) -> b -> F s a -> b
$cfoldr' :: forall s a b. (a -> b -> b) -> b -> F s a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> F s a -> b
$cfoldl :: forall s b a. (b -> a -> b) -> b -> F s a -> b
foldl :: forall b a. (b -> a -> b) -> b -> F s a -> b
$cfoldl' :: forall s b a. (b -> a -> b) -> b -> F s a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> F s a -> b
$cfoldr1 :: forall s a. (a -> a -> a) -> F s a -> a
foldr1 :: forall a. (a -> a -> a) -> F s a -> a
$cfoldl1 :: forall s a. (a -> a -> a) -> F s a -> a
foldl1 :: forall a. (a -> a -> a) -> F s a -> a
$ctoList :: forall s a. F s a -> [a]
toList :: forall a. F s a -> [a]
$cnull :: forall s a. F s a -> Bool
null :: forall a. F s a -> Bool
$clength :: forall s a. F s a -> Int
length :: forall a. F s a -> Int
$celem :: forall s a. Eq a => a -> F s a -> Bool
elem :: forall a. Eq a => a -> F s a -> Bool
$cmaximum :: forall s a. Ord a => F s a -> a
maximum :: forall a. Ord a => F s a -> a
$cminimum :: forall s a. Ord a => F s a -> a
minimum :: forall a. Ord a => F s a -> a
$csum :: forall s a. Num a => F s a -> a
sum :: forall a. Num a => F s a -> a
$cproduct :: forall s a. Num a => F s a -> a
product :: forall a. Num a => F s a -> a
Foldable, Functor (F s)
Foldable (F s)
(Functor (F s), Foldable (F s)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> F s a -> f (F s b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    F s (f a) -> f (F s a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> F s a -> m (F s b))
-> (forall (m :: * -> *) a. Monad m => F s (m a) -> m (F s a))
-> Traversable (F s)
forall s. Functor (F s)
forall s. Foldable (F s)
forall s (m :: * -> *) a. Monad m => F s (m a) -> m (F s a)
forall s (f :: * -> *) a. Applicative f => F s (f a) -> f (F s a)
forall s (m :: * -> *) a b.
Monad m =>
(a -> m b) -> F s a -> m (F s b)
forall s (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> F s a -> f (F s b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => F s (m a) -> m (F s a)
forall (f :: * -> *) a. Applicative f => F s (f a) -> f (F s a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> F s a -> m (F s b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> F s a -> f (F s b)
$ctraverse :: forall s (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> F s a -> f (F s b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> F s a -> f (F s b)
$csequenceA :: forall s (f :: * -> *) a. Applicative f => F s (f a) -> f (F s a)
sequenceA :: forall (f :: * -> *) a. Applicative f => F s (f a) -> f (F s a)
$cmapM :: forall s (m :: * -> *) a b.
Monad m =>
(a -> m b) -> F s a -> m (F s b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> F s a -> m (F s b)
$csequence :: forall s (m :: * -> *) a. Monad m => F s (m a) -> m (F s a)
sequence :: forall (m :: * -> *) a. Monad m => F s (m a) -> m (F s a)
Traversable, (forall a b. (a -> b) -> F s a -> F s b)
-> (forall a b. a -> F s b -> F s a) -> Functor (F s)
forall a b. a -> F s b -> F s a
forall a b. (a -> b) -> F s a -> F s b
forall s a b. a -> F s b -> F s a
forall s a b. (a -> b) -> F s a -> F s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall s a b. (a -> b) -> F s a -> F s b
fmap :: forall a b. (a -> b) -> F s a -> F s b
$c<$ :: forall s a b. a -> F s b -> F s a
<$ :: forall a b. a -> F s b -> F s a
Functor)

isEmpty :: (Eq s) => (IsString s) => Pretty s -> Bool
isEmpty :: forall s. (Eq s, IsString s) => Pretty s -> Bool
isEmpty Pretty s
s = Pretty s -> F s (Pretty s)
forall s. Pretty s -> F s (Pretty s)
out Pretty s
s F s (Pretty s) -> F s (Pretty s) -> Bool
forall a. Eq a => a -> a -> Bool
== F s (Pretty s)
forall s r. F s r
Empty Bool -> Bool -> Bool
|| Pretty s -> F s (Pretty s)
forall s. Pretty s -> F s (Pretty s)
out Pretty s
s F s (Pretty s) -> F s (Pretty s) -> Bool
forall a. Eq a => a -> a -> Bool
== s -> F s (Pretty s)
forall s r. s -> F s r
Lit s
""

mapLit :: (s -> t) -> F s r -> F t r
mapLit :: forall s t r. (s -> t) -> F s r -> F t r
mapLit s -> t
f (Lit s
s) = t -> F t r
forall s r. s -> F s r
Lit (s -> t
f s
s)
mapLit s -> t
_ F s r
Empty = F t r
forall s r. F s r
Empty
mapLit s -> t
_ (Group r
r) = r -> F t r
forall s r. r -> F s r
Group r
r
mapLit s -> t
_ (Wrap Seq r
s) = Seq r -> F t r
forall s r. Seq r -> F s r
Wrap Seq r
s
mapLit s -> t
_ (OrElse r
r r
s) = r -> r -> F t r
forall s r. r -> r -> F s r
OrElse r
r r
s
mapLit s -> t
_ (Append Seq r
s) = Seq r -> F t r
forall s r. Seq r -> F s r
Append Seq r
s

lit :: (IsString s, LL.ListLike s Char) => s -> Pretty s
lit :: forall s. (IsString s, ListLike s Char) => s -> Pretty s
lit s
s = Delta -> s -> Pretty s
forall s. Delta -> s -> Pretty s
lit' ((Char -> Delta) -> String -> Delta
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Char -> Delta
chDelta (String -> Delta) -> String -> Delta
forall a b. (a -> b) -> a -> b
$ s -> [Item s]
forall l. IsList l => l -> [Item l]
LL.toList s
s) s
s

lit' :: Delta -> s -> Pretty s
lit' :: forall s. Delta -> s -> Pretty s
lit' Delta
d s
s = Delta -> F s (Pretty s) -> Pretty s
forall s. Delta -> F s (Pretty s) -> Pretty s
Pretty Delta
d (s -> F s (Pretty s)
forall s r. s -> F s r
Lit s
s)

orElse :: Pretty s -> Pretty s -> Pretty s
orElse :: forall s. Pretty s -> Pretty s -> Pretty s
orElse Pretty s
p1 Pretty s
p2 = Delta -> F s (Pretty s) -> Pretty s
forall s. Delta -> F s (Pretty s) -> Pretty s
Pretty (Pretty s -> Delta
forall s. Pretty s -> Delta
delta Pretty s
p1) (Pretty s -> Pretty s -> F s (Pretty s)
forall s r. r -> r -> F s r
OrElse Pretty s
p1 Pretty s
p2)

orElses :: [Pretty s] -> Pretty s
orElses :: forall s. [Pretty s] -> Pretty s
orElses [] = Pretty s
forall a. Monoid a => a
mempty
orElses [Pretty s]
ps = (Pretty s -> Pretty s -> Pretty s) -> [Pretty s] -> Pretty s
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Pretty s -> Pretty s -> Pretty s
forall s. Pretty s -> Pretty s -> Pretty s
orElse [Pretty s]
ps

wrapImpl :: (IsString s) => [Pretty s] -> Pretty s
wrapImpl :: forall s. IsString s => [Pretty s] -> Pretty s
wrapImpl [] = Pretty s
forall a. Monoid a => a
mempty
wrapImpl (Pretty s
p : [Pretty s]
ps) =
  Seq (Pretty s) -> Pretty s
forall s. Seq (Pretty s) -> Pretty s
wrap_ (Seq (Pretty s) -> Pretty s)
-> ([Pretty s] -> Seq (Pretty s)) -> [Pretty s] -> Pretty s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty s] -> Seq (Pretty s)
forall a. [a] -> Seq a
Seq.fromList ([Pretty s] -> Pretty s) -> [Pretty s] -> Pretty s
forall a b. (a -> b) -> a -> b
$
    Pretty s
p Pretty s -> [Pretty s] -> [Pretty s]
forall a. a -> [a] -> [a]
: (Pretty s -> Pretty s) -> [Pretty s] -> [Pretty s]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Pretty s
p -> (Pretty s
" " Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
p) Pretty s -> Pretty s -> Pretty s
forall s. Pretty s -> Pretty s -> Pretty s
`orElse` (Pretty s
forall s. IsString s => Pretty s
newline Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
p)) [Pretty s]
ps

wrapImplPreserveSpaces :: (LL.ListLike s Char, IsString s) => [Pretty s] -> Pretty s
wrapImplPreserveSpaces :: forall s. (ListLike s Char, IsString s) => [Pretty s] -> Pretty s
wrapImplPreserveSpaces = \case
  [] -> Pretty s
forall a. Monoid a => a
mempty
  (Pretty s
p : [Pretty s]
ps) -> Seq (Pretty s) -> Pretty s
forall s. Seq (Pretty s) -> Pretty s
wrap_ (Seq (Pretty s) -> Pretty s)
-> ([Pretty s] -> Seq (Pretty s)) -> [Pretty s] -> Pretty s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty s] -> Seq (Pretty s)
forall a. [a] -> Seq a
Seq.fromList ([Pretty s] -> Pretty s) -> [Pretty s] -> Pretty s
forall a b. (a -> b) -> a -> b
$ Pretty s
p Pretty s -> [Pretty s] -> [Pretty s]
forall a. a -> [a] -> [a]
: (Pretty s -> Pretty s) -> [Pretty s] -> [Pretty s]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pretty s -> Pretty s
forall {s}.
(Item s ~ Char, ListLike s Char, IsString s) =>
Pretty s -> Pretty s
f [Pretty s]
ps
  where
    startsWithSpace :: Pretty b -> Bool
startsWithSpace Pretty b
p = case Pretty b -> F b (Pretty b)
forall s. Pretty s -> F s (Pretty s)
out Pretty b
p of
      (Lit b
s) -> Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (((Char, b) -> Bool) -> Maybe (Char, b) -> Maybe Bool
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char -> Bool
isSpaceNotNewline (Char -> Bool) -> ((Char, b) -> Char) -> (Char, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, b) -> Char
forall a b. (a, b) -> a
fst) (Maybe (Char, b) -> Maybe Bool) -> Maybe (Char, b) -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ b -> Maybe (Char, b)
forall full item. ListLike full item => full -> Maybe (item, full)
LL.uncons b
s)
      F b (Pretty b)
_ -> Bool
False
    f :: Pretty s -> Pretty s
f Pretty s
p | Pretty s -> Bool
forall {b}. (Item b ~ Char, ListLike b Char) => Pretty b -> Bool
startsWithSpace Pretty s
p = Pretty s
p Pretty s -> Pretty s -> Pretty s
forall s. Pretty s -> Pretty s -> Pretty s
`orElse` Pretty s
forall s. IsString s => Pretty s
newline
    f Pretty s
p = Pretty s
p Pretty s -> Pretty s -> Pretty s
forall s. Pretty s -> Pretty s -> Pretty s
`orElse` (Pretty s
forall s. IsString s => Pretty s
newline Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
p)

isSpaceNotNewline :: Char -> Bool
isSpaceNotNewline :: Char -> Bool
isSpaceNotNewline Char
c = Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
&& Bool -> Bool
not (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')

wrapString :: (LL.ListLike s Char, IsString s) => String -> Pretty s
wrapString :: forall s. (ListLike s Char, IsString s) => String -> Pretty s
wrapString String
s = Pretty s -> Pretty s
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
wrap (s -> Pretty s
forall s. (IsString s, ListLike s Char) => s -> Pretty s
lit (s -> Pretty s) -> s -> Pretty s
forall a b. (a -> b) -> a -> b
$ String -> s
forall a. IsString a => String -> a
fromString String
s)

-- Wrap text, preserving whitespace (apart from at the wrap points.)
-- Used in particular for viewing/displaying doc literals.
-- Should be understood in tandem with TermParser.docNormalize.
-- See also unison-src/transcripts/doc-formatting.md.
paragraphyText :: (LL.ListLike s Char, IsString s) => Text -> Pretty s
paragraphyText :: forall s. (ListLike s Char, IsString s) => Text -> Pretty s
paragraphyText = Pretty s -> [Pretty s] -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
sep Pretty s
"\n" ([Pretty s] -> Pretty s)
-> (Text -> [Pretty s]) -> Text -> Pretty s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Pretty s) -> [Text] -> [Pretty s]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Pretty s -> Pretty s
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
wrapPreserveSpaces (Pretty s -> Pretty s) -> (Text -> Pretty s) -> Text -> Pretty s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Pretty s
forall s. IsString s => Text -> Pretty s
text) ([Text] -> [Pretty s]) -> (Text -> [Text]) -> Text -> [Pretty s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
Text.splitOn Text
"\n"

wrap' :: (IsString s) => (s -> [Pretty s]) -> Pretty s -> Pretty s
wrap' :: forall s. IsString s => (s -> [Pretty s]) -> Pretty s -> Pretty s
wrap' s -> [Pretty s]
wordify Pretty s
p = [Pretty s] -> Pretty s
forall s. IsString s => [Pretty s] -> Pretty s
wrapImpl ([Pretty s] -> [Pretty s]
toLeaves [Pretty s
p])
  where
    toLeaves :: [Pretty s] -> [Pretty s]
toLeaves [] = []
    toLeaves (Pretty s
hd : [Pretty s]
tl) = case Pretty s -> F s (Pretty s)
forall s. Pretty s -> F s (Pretty s)
out Pretty s
hd of
      F s (Pretty s)
Empty -> [Pretty s] -> [Pretty s]
toLeaves [Pretty s]
tl
      Lit s
s -> s -> [Pretty s]
wordify s
s [Pretty s] -> [Pretty s] -> [Pretty s]
forall a. [a] -> [a] -> [a]
++ [Pretty s] -> [Pretty s]
toLeaves [Pretty s]
tl
      Group Pretty s
_ -> Pretty s
hd Pretty s -> [Pretty s] -> [Pretty s]
forall a. a -> [a] -> [a]
: [Pretty s] -> [Pretty s]
toLeaves [Pretty s]
tl
      OrElse Pretty s
a Pretty s
_ -> [Pretty s] -> [Pretty s]
toLeaves (Pretty s
a Pretty s -> [Pretty s] -> [Pretty s]
forall a. a -> [a] -> [a]
: [Pretty s]
tl)
      Wrap Seq (Pretty s)
_ -> Pretty s
hd Pretty s -> [Pretty s] -> [Pretty s]
forall a. a -> [a] -> [a]
: [Pretty s] -> [Pretty s]
toLeaves [Pretty s]
tl
      Append Seq (Pretty s)
hds -> [Pretty s] -> [Pretty s]
toLeaves (Seq (Pretty s) -> [Pretty s]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Pretty s)
hds [Pretty s] -> [Pretty s] -> [Pretty s]
forall a. [a] -> [a] -> [a]
++ [Pretty s]
tl)

wrap :: (LL.ListLike s Char, IsString s) => Pretty s -> Pretty s
wrap :: forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
wrap = (s -> [Pretty s]) -> Pretty s -> Pretty s
forall s. IsString s => (s -> [Pretty s]) -> Pretty s -> Pretty s
wrap' s -> [Pretty s]
forall {t}.
(Item t ~ Char, IsString t, ListLike t Char) =>
t -> [Pretty t]
wordify
  where
    wordify :: t -> [Pretty t]
wordify t
s0 =
      let s :: t
s = (Char -> Bool) -> t -> t
forall full item.
ListLike full item =>
(item -> Bool) -> full -> full
LL.dropWhile Char -> Bool
isSpace t
s0
       in if t -> Bool
forall full item. ListLike full item => full -> Bool
LL.null t
s
            then []
            else case (Char -> Bool) -> t -> (t, t)
forall full item.
ListLike full item =>
(item -> Bool) -> full -> (full, full)
LL.break Char -> Bool
isSpace t
s of (t
word1, t
s) -> t -> Pretty t
forall s. (IsString s, ListLike s Char) => s -> Pretty s
lit t
word1 Pretty t -> [Pretty t] -> [Pretty t]
forall a. a -> [a] -> [a]
: t -> [Pretty t]
wordify t
s

-- Does not insert spaces where none were present, and does not collapse
-- sequences of spaces into one.
-- It'd be a bit painful to just replace wrap with the following version, because
-- lots of OutputMessages code depends on wrap's behaviour of sometimes adding
-- extra spaces.
wrapPreserveSpaces :: (LL.ListLike s Char, IsString s) => Pretty s -> Pretty s
wrapPreserveSpaces :: forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
wrapPreserveSpaces Pretty s
p = [Pretty s] -> Pretty s
forall s. (ListLike s Char, IsString s) => [Pretty s] -> Pretty s
wrapImplPreserveSpaces ([Pretty s] -> [Pretty s]
forall {a}.
(Item a ~ Char, IsString a, ListLike a Char) =>
[Pretty a] -> [Pretty a]
toLeaves [Pretty s
p])
  where
    toLeaves :: [Pretty a] -> [Pretty a]
toLeaves [] = []
    toLeaves (Pretty a
hd : [Pretty a]
tl) = case Pretty a -> F a (Pretty a)
forall s. Pretty s -> F s (Pretty s)
out Pretty a
hd of
      F a (Pretty a)
Empty -> [Pretty a] -> [Pretty a]
toLeaves [Pretty a]
tl
      Lit a
s -> ((a -> Pretty a) -> [a] -> [Pretty a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Pretty a
forall s. (IsString s, ListLike s Char) => s -> Pretty s
lit ([a] -> [Pretty a]) -> [a] -> [Pretty a]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> a -> [a]
forall s c. ListLike s c => (c -> Bool) -> s -> [s]
alternations Char -> Bool
isSpaceNotNewline a
s) [Pretty a] -> [Pretty a] -> [Pretty a]
forall a. [a] -> [a] -> [a]
++ [Pretty a] -> [Pretty a]
toLeaves [Pretty a]
tl
      Group Pretty a
_ -> Pretty a
hd Pretty a -> [Pretty a] -> [Pretty a]
forall a. a -> [a] -> [a]
: [Pretty a] -> [Pretty a]
toLeaves [Pretty a]
tl
      OrElse Pretty a
a Pretty a
_ -> [Pretty a] -> [Pretty a]
toLeaves (Pretty a
a Pretty a -> [Pretty a] -> [Pretty a]
forall a. a -> [a] -> [a]
: [Pretty a]
tl)
      Wrap Seq (Pretty a)
_ -> Pretty a
hd Pretty a -> [Pretty a] -> [Pretty a]
forall a. a -> [a] -> [a]
: [Pretty a] -> [Pretty a]
toLeaves [Pretty a]
tl
      Append Seq (Pretty a)
hds -> [Pretty a] -> [Pretty a]
toLeaves (Seq (Pretty a) -> [Pretty a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Pretty a)
hds [Pretty a] -> [Pretty a] -> [Pretty a]
forall a. [a] -> [a] -> [a]
++ [Pretty a]
tl)

-- Cut a list every time a predicate changes.  Produces a list of
-- non-empty lists.
alternations :: (LL.ListLike s c) => (c -> Bool) -> s -> [s]
alternations :: forall s c. ListLike s c => (c -> Bool) -> s -> [s]
alternations c -> Bool
p s
s = [s] -> [s]
forall a. [a] -> [a]
reverse ([s] -> [s]) -> [s] -> [s]
forall a b. (a -> b) -> a -> b
$ Bool -> s -> [s] -> [s]
forall {t}. (Item t ~ c, ListLike t c) => Bool -> t -> [t] -> [t]
go Bool
True s
s []
  where
    go :: Bool -> t -> [t] -> [t]
go Bool
_ t
s [t]
acc | t -> Bool
forall full item. ListLike full item => full -> Bool
LL.null t
s = [t]
acc
    go Bool
w t
s [t]
acc = Bool -> t -> [t] -> [t]
go (Bool -> Bool
not Bool
w) t
rest [t]
acc'
      where
        (t
t, t
rest) = (c -> Bool) -> t -> (t, t)
forall full item.
ListLike full item =>
(item -> Bool) -> full -> (full, full)
LL.span c -> Bool
p' t
s
        p' :: c -> Bool
p' = if Bool
w then c -> Bool
p else (\c
x -> Bool -> Bool
not (c -> Bool
p c
x))
        acc' :: [t]
acc' = if (t -> Bool
forall full item. ListLike full item => full -> Bool
LL.null t
t) then [t]
acc else t
t t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t]
acc

wrap_ :: Seq (Pretty s) -> Pretty s
wrap_ :: forall s. Seq (Pretty s) -> Pretty s
wrap_ Seq (Pretty s)
ps = Delta -> F s (Pretty s) -> Pretty s
forall s. Delta -> F s (Pretty s) -> Pretty s
Pretty ((Pretty s -> Delta) -> Seq (Pretty s) -> Delta
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pretty s -> Delta
forall s. Pretty s -> Delta
delta Seq (Pretty s)
ps) (Seq (Pretty s) -> F s (Pretty s)
forall s r. Seq r -> F s r
Wrap Seq (Pretty s)
ps)

group :: Pretty s -> Pretty s
group :: forall s. Pretty s -> Pretty s
group Pretty s
p = Delta -> F s (Pretty s) -> Pretty s
forall s. Delta -> F s (Pretty s) -> Pretty s
Pretty (Pretty s -> Delta
forall s. Pretty s -> Delta
delta Pretty s
p) (Pretty s -> F s (Pretty s)
forall s r. r -> F s r
Group Pretty s
p)

toANSI :: Width -> Pretty CT.ColorText -> String
toANSI :: Width -> Pretty ColorText -> String
toANSI Width
avail Pretty ColorText
p = ColorText -> String
CT.toANSI (Width -> Pretty ColorText -> ColorText
forall s. (Monoid s, IsString s) => Width -> Pretty s -> s
render Width
avail Pretty ColorText
p)

toAnsiUnbroken :: Pretty ColorText -> String
toAnsiUnbroken :: Pretty ColorText -> String
toAnsiUnbroken Pretty ColorText
p = ColorText -> String
CT.toANSI (Pretty ColorText -> ColorText
forall s. (Monoid s, IsString s) => Pretty s -> s
renderUnbroken Pretty ColorText
p)

toPlain :: Width -> Pretty CT.ColorText -> String
toPlain :: Width -> Pretty ColorText -> String
toPlain Width
avail Pretty ColorText
p = ColorText -> String
CT.toPlain (Width -> Pretty ColorText -> ColorText
forall s. (Monoid s, IsString s) => Width -> Pretty s -> s
render Width
avail Pretty ColorText
p)

toHTML :: String -> Width -> Pretty CT.ColorText -> String
toHTML :: String -> Width -> Pretty ColorText -> String
toHTML String
cssPrefix Width
avail Pretty ColorText
p = String -> ColorText -> String
CT.toHTML String
cssPrefix (Width -> Pretty ColorText -> ColorText
forall s. (Monoid s, IsString s) => Width -> Pretty s -> s
render Width
avail Pretty ColorText
p)

toPlainUnbroken :: Pretty ColorText -> String
toPlainUnbroken :: Pretty ColorText -> String
toPlainUnbroken Pretty ColorText
p = ColorText -> String
CT.toPlain (Pretty ColorText -> ColorText
forall s. (Monoid s, IsString s) => Pretty s -> s
renderUnbroken Pretty ColorText
p)

syntaxToColor :: Pretty (ST.SyntaxText' r) -> Pretty ColorText
syntaxToColor :: forall r. Pretty (SyntaxText' r) -> Pretty ColorText
syntaxToColor = (SyntaxText' r -> ColorText)
-> Pretty (SyntaxText' r) -> Pretty ColorText
forall a b. (a -> b) -> Pretty a -> Pretty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SyntaxText' r -> ColorText)
 -> Pretty (SyntaxText' r) -> Pretty ColorText)
-> (SyntaxText' r -> ColorText)
-> Pretty (SyntaxText' r)
-> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ AnnotatedText (Maybe Color) -> ColorText
forall a. AnnotatedText (Maybe a) -> AnnotatedText a
annotateMaybe (AnnotatedText (Maybe Color) -> ColorText)
-> (SyntaxText' r -> AnnotatedText (Maybe Color))
-> SyntaxText' r
-> ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element r -> Maybe Color)
-> SyntaxText' r -> AnnotatedText (Maybe Color)
forall a b. (a -> b) -> AnnotatedText a -> AnnotatedText b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element r -> Maybe Color
forall r. Element r -> Maybe Color
CT.defaultColors

-- set the syntax, overriding any present syntax
withSyntax ::
  ST.Element r -> Pretty (ST.SyntaxText' r) -> Pretty (ST.SyntaxText' r)
withSyntax :: forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
withSyntax Element r
e = (SyntaxText' r -> SyntaxText' r)
-> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
forall a b. (a -> b) -> Pretty a -> Pretty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SyntaxText' r -> SyntaxText' r)
 -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r))
-> (SyntaxText' r -> SyntaxText' r)
-> Pretty (SyntaxText' r)
-> Pretty (SyntaxText' r)
forall a b. (a -> b) -> a -> b
$ Element r -> SyntaxText' r -> SyntaxText' r
forall r. Element r -> SyntaxText' r -> SyntaxText' r
ST.syntax Element r
e

renderUnbroken :: (Monoid s, IsString s) => Pretty s -> s
renderUnbroken :: forall s. (Monoid s, IsString s) => Pretty s -> s
renderUnbroken = Width -> Pretty s -> s
forall s. (Monoid s, IsString s) => Width -> Pretty s -> s
render Width
forall a. Bounded a => a
maxBound

render :: (Monoid s, IsString s) => Width -> Pretty s -> s
render :: forall s. (Monoid s, IsString s) => Width -> Pretty s -> s
render Width
availableWidth Pretty s
p = Delta -> [Either (Pretty s) (Pretty s)] -> s
forall {s}.
Monoid s =>
Delta -> [Either (Pretty s) (Pretty s)] -> s
go Delta
forall a. Monoid a => a
mempty [Pretty s -> Either (Pretty s) (Pretty s)
forall a b. b -> Either a b
Right Pretty s
p]
  where
    go :: Delta -> [Either (Pretty s) (Pretty s)] -> s
go Delta
_ [] = s
forall a. Monoid a => a
mempty
    go Delta
cur (Either (Pretty s) (Pretty s)
p : [Either (Pretty s) (Pretty s)]
rest) = case Either (Pretty s) (Pretty s)
p of
      Right Pretty s
p ->
        -- `p` might fit, let's try it!
        if Pretty s
p Pretty s -> Delta -> Bool
forall {s}. Pretty s -> Delta -> Bool
`fits` Delta
cur
          then Pretty s -> s
forall {m}. Monoid m => Pretty m -> m
flow Pretty s
p s -> s -> s
forall a. Semigroup a => a -> a -> a
<> Delta -> [Either (Pretty s) (Pretty s)] -> s
go (Delta
cur Delta -> Delta -> Delta
forall a. Semigroup a => a -> a -> a
<> Pretty s -> Delta
forall s. Pretty s -> Delta
delta Pretty s
p) [Either (Pretty s) (Pretty s)]
rest
          else Delta -> [Either (Pretty s) (Pretty s)] -> s
go Delta
cur (Pretty s -> Either (Pretty s) (Pretty s)
forall a b. a -> Either a b
Left Pretty s
p Either (Pretty s) (Pretty s)
-> [Either (Pretty s) (Pretty s)] -> [Either (Pretty s) (Pretty s)]
forall a. a -> [a] -> [a]
: [Either (Pretty s) (Pretty s)]
rest) -- nope, switch to breaking mode
      Left Pretty s
p -> case Pretty s -> F s (Pretty s)
forall s. Pretty s -> F s (Pretty s)
out Pretty s
p of -- `p` requires breaking
        Append Seq (Pretty s)
ps -> Delta -> [Either (Pretty s) (Pretty s)] -> s
go Delta
cur ((Pretty s -> Either (Pretty s) (Pretty s)
forall a b. a -> Either a b
Left (Pretty s -> Either (Pretty s) (Pretty s))
-> [Pretty s] -> [Either (Pretty s) (Pretty s)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (Pretty s) -> [Pretty s]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Pretty s)
ps) [Either (Pretty s) (Pretty s)]
-> [Either (Pretty s) (Pretty s)] -> [Either (Pretty s) (Pretty s)]
forall a. Semigroup a => a -> a -> a
<> [Either (Pretty s) (Pretty s)]
rest)
        F s (Pretty s)
Empty -> Delta -> [Either (Pretty s) (Pretty s)] -> s
go Delta
cur [Either (Pretty s) (Pretty s)]
rest
        Group Pretty s
p -> Delta -> [Either (Pretty s) (Pretty s)] -> s
go Delta
cur (Pretty s -> Either (Pretty s) (Pretty s)
forall a b. b -> Either a b
Right Pretty s
p Either (Pretty s) (Pretty s)
-> [Either (Pretty s) (Pretty s)] -> [Either (Pretty s) (Pretty s)]
forall a. a -> [a] -> [a]
: [Either (Pretty s) (Pretty s)]
rest)
        -- Note: literals can't be broken further so they're
        -- added to output unconditionally
        Lit s
l -> s
l s -> s -> s
forall a. Semigroup a => a -> a -> a
<> Delta -> [Either (Pretty s) (Pretty s)] -> s
go (Delta
cur Delta -> Delta -> Delta
forall a. Semigroup a => a -> a -> a
<> Pretty s -> Delta
forall s. Pretty s -> Delta
delta Pretty s
p) [Either (Pretty s) (Pretty s)]
rest
        OrElse Pretty s
_ Pretty s
p -> Delta -> [Either (Pretty s) (Pretty s)] -> s
go Delta
cur (Pretty s -> Either (Pretty s) (Pretty s)
forall a b. b -> Either a b
Right Pretty s
p Either (Pretty s) (Pretty s)
-> [Either (Pretty s) (Pretty s)] -> [Either (Pretty s) (Pretty s)]
forall a. a -> [a] -> [a]
: [Either (Pretty s) (Pretty s)]
rest)
        Wrap Seq (Pretty s)
ps -> Delta -> [Either (Pretty s) (Pretty s)] -> s
go Delta
cur ((Pretty s -> Either (Pretty s) (Pretty s)
forall a b. b -> Either a b
Right (Pretty s -> Either (Pretty s) (Pretty s))
-> [Pretty s] -> [Either (Pretty s) (Pretty s)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (Pretty s) -> [Pretty s]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Pretty s)
ps) [Either (Pretty s) (Pretty s)]
-> [Either (Pretty s) (Pretty s)] -> [Either (Pretty s) (Pretty s)]
forall a. Semigroup a => a -> a -> a
<> [Either (Pretty s) (Pretty s)]
rest)

    flow :: Pretty m -> m
flow Pretty m
p = case Pretty m -> F m (Pretty m)
forall s. Pretty s -> F s (Pretty s)
out Pretty m
p of
      Append Seq (Pretty m)
ps -> (Pretty m -> m) -> Seq (Pretty m) -> m
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pretty m -> m
flow Seq (Pretty m)
ps
      F m (Pretty m)
Empty -> m
forall a. Monoid a => a
mempty
      Group Pretty m
p -> Pretty m -> m
flow Pretty m
p
      Lit m
s -> m
s
      OrElse Pretty m
p Pretty m
_ -> Pretty m -> m
flow Pretty m
p
      Wrap Seq (Pretty m)
ps -> (Pretty m -> m) -> Seq (Pretty m) -> m
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pretty m -> m
flow Seq (Pretty m)
ps

    fits :: Pretty s -> Delta -> Bool
fits Pretty s
p Delta
cur =
      Delta -> Width
maxCol (Delta -> Delta
surgery Delta
cur Delta -> Delta -> Delta
forall a. Semigroup a => a -> a -> a
<> Pretty s -> Delta
forall s. Pretty s -> Delta
delta Pretty s
p) Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
< Width
availableWidth
      where
        -- Surgically modify 'cur' to pretend it has not exceeded availableWidth.
        -- This is necessary because sometimes things cannot be split and *must*
        -- exceed availableWidth; in this case, we do not want to entirely "blame"
        -- the new proposed (cur <> delta p) for this overflow.
        --
        -- For example, when appending
        --
        --       availableWidth
        --       |
        --   xxx |
        --   yyyyyy
        --   zz  |
        --
        -- with
        --
        --   aa  |
        --   bb  |
        --
        -- we want to end up with
        --
        --   xxx |
        --   yyyyyy
        --   zzaa|
        --   bb  |
        --
        surgery :: Delta -> Delta
surgery = \case
          SingleLine Width
c -> Width -> Delta
SingleLine (Width -> Width -> Width
forall a. Ord a => a -> a -> a
min Width
c (Width
availableWidth Width -> Width -> Width
forall a. Num a => a -> a -> a
- Width
1))
          MultiLine Width
fc Width
lc Width
mc -> Width -> Width -> Width -> Delta
MultiLine Width
fc Width
lc (Width -> Width -> Width
forall a. Ord a => a -> a -> a
min Width
mc (Width
availableWidth Width -> Width -> Width
forall a. Num a => a -> a -> a
- Width
1))

newline :: (IsString s) => Pretty s
newline :: forall s. IsString s => Pretty s
newline = Pretty s
"\n"

lineSkip :: (IsString s) => Pretty s
lineSkip :: forall s. IsString s => Pretty s
lineSkip = Pretty s
forall s. IsString s => Pretty s
newline Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
forall s. IsString s => Pretty s
newline

spaceIfNeeded :: (Eq s) => (IsString s) => Pretty s -> Pretty s -> Pretty s
spaceIfNeeded :: forall s. (Eq s, IsString s) => Pretty s -> Pretty s -> Pretty s
spaceIfNeeded Pretty s
a Pretty s
b = if Pretty s -> Bool
forall s. (Eq s, IsString s) => Pretty s -> Bool
isEmpty Pretty s
a then Pretty s
b else Pretty s
a Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
" " Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
b

spaceIfBreak :: (IsString s) => Pretty s
spaceIfBreak :: forall s. IsString s => Pretty s
spaceIfBreak = Pretty s
"" Pretty s -> Pretty s -> Pretty s
forall s. Pretty s -> Pretty s -> Pretty s
`orElse` Pretty s
" "

spacesIfBreak :: (IsString s) => Int -> Pretty s
spacesIfBreak :: forall s. IsString s => Int -> Pretty s
spacesIfBreak Int
n = Pretty s
"" Pretty s -> Pretty s -> Pretty s
forall s. Pretty s -> Pretty s -> Pretty s
`orElse` String -> Pretty s
forall a. IsString a => String -> a
fromString (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' ')

softbreak :: (IsString s) => Pretty s
softbreak :: forall s. IsString s => Pretty s
softbreak = Pretty s
" " Pretty s -> Pretty s -> Pretty s
forall s. Pretty s -> Pretty s -> Pretty s
`orElse` Pretty s
forall s. IsString s => Pretty s
newline

spaced :: (Foldable f, IsString s) => f (Pretty s) -> Pretty s
spaced :: forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
spaced = Pretty s -> (Pretty s -> Pretty s) -> f (Pretty s) -> Pretty s
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap Pretty s
forall s. IsString s => Pretty s
softbreak Pretty s -> Pretty s
forall a. a -> a
id

spacedMap :: (Foldable f, IsString s) => (a -> Pretty s) -> f a -> Pretty s
spacedMap :: forall (f :: * -> *) s a.
(Foldable f, IsString s) =>
(a -> Pretty s) -> f a -> Pretty s
spacedMap a -> Pretty s
f f a
as = [Pretty s] -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
spaced ([Pretty s] -> Pretty s) -> ([a] -> [Pretty s]) -> [a] -> Pretty s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Pretty s) -> [a] -> [Pretty s]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Pretty s
f ([a] -> Pretty s) -> [a] -> Pretty s
forall a b. (a -> b) -> a -> b
$ f a -> [a]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f a
as

spacedTraverse :: (Traversable f, IsString s, Applicative m) => (a -> m (Pretty s)) -> f a -> m (Pretty s)
spacedTraverse :: forall (f :: * -> *) s (m :: * -> *) a.
(Traversable f, IsString s, Applicative m) =>
(a -> m (Pretty s)) -> f a -> m (Pretty s)
spacedTraverse a -> m (Pretty s)
f f a
as = f (Pretty s) -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
spaced (f (Pretty s) -> Pretty s) -> m (f (Pretty s)) -> m (Pretty s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m (Pretty s)) -> f a -> m (f (Pretty s))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
traverse a -> m (Pretty s)
f f a
as

commas :: (Foldable f, IsString s) => f (Pretty s) -> Pretty s
commas :: forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
commas = Pretty s -> (Pretty s -> Pretty s) -> f (Pretty s) -> Pretty s
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap (Pretty s
"," Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
forall s. IsString s => Pretty s
softbreak) Pretty s -> Pretty s
forall a. a -> a
id

oxfordCommas :: (Foldable f, IsString s) => f (Pretty s) -> Pretty s
oxfordCommas :: forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
oxfordCommas = Pretty s -> f (Pretty s) -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
oxfordCommasWith Pretty s
""

-- Like `oxfordCommas`, but attaches `end` at the end (without a space).
-- For example, `oxfordCommasWith "."` will attach a period.
oxfordCommasWith ::
  (Foldable f, IsString s) => Pretty s -> f (Pretty s) -> Pretty s
oxfordCommasWith :: forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
oxfordCommasWith Pretty s
end f (Pretty s)
xs = case f (Pretty s) -> [Pretty s]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (Pretty s)
xs of
  [] -> Pretty s
""
  [Pretty s
x] -> Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
group (Pretty s
x Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
end)
  [Pretty s
x, Pretty s
y] -> Pretty s
x Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
" and " Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
group (Pretty s
y Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
end)
  [Pretty s]
xs ->
    Pretty s -> (Pretty s -> Pretty s) -> [Pretty s] -> Pretty s
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap (Pretty s
"," Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
forall s. IsString s => Pretty s
softbreak) Pretty s -> Pretty s
forall a. a -> a
id ([Pretty s] -> [Pretty s]
forall a. HasCallStack => [a] -> [a]
init [Pretty s]
xs)
      Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
","
      Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
forall s. IsString s => Pretty s
softbreak
      Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
"and"
      Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
forall s. IsString s => Pretty s
softbreak
      Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
group ([Pretty s] -> Pretty s
forall a. HasCallStack => [a] -> a
last [Pretty s]
xs Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
end)

parenthesizeCommas :: (Foldable f, IsString s) => f (Pretty s) -> Pretty s
parenthesizeCommas :: forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
parenthesizeCommas = Pretty s -> Pretty s -> f (Pretty s) -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> Pretty s -> f (Pretty s) -> Pretty s
surroundCommas Pretty s
"(" Pretty s
")"

surroundCommas ::
  (Foldable f, IsString s) =>
  Pretty s ->
  Pretty s ->
  f (Pretty s) ->
  Pretty s
surroundCommas :: forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> Pretty s -> f (Pretty s) -> Pretty s
surroundCommas Pretty s
start Pretty s
stop f (Pretty s)
fs =
  Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
group (Pretty s -> Pretty s) -> Pretty s -> Pretty s
forall a b. (a -> b) -> a -> b
$
    Pretty s
start
      Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
forall s. IsString s => Pretty s
spaceIfBreak
      Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s -> (Pretty s -> Pretty s) -> f (Pretty s) -> Pretty s
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap (Pretty s
"," Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
forall s. IsString s => Pretty s
softbreak Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
align) Pretty s -> Pretty s
forall a. a -> a
id f (Pretty s)
fs
      Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
stop
  where
    align :: Pretty s
align = Int -> Pretty s
forall s. IsString s => Int -> Pretty s
spacesIfBreak (Width -> Int
widthToInt (Width -> Int) -> Width -> Int
forall a b. (a -> b) -> a -> b
$ Pretty s -> Width
forall s. Pretty s -> Width
preferredWidth Pretty s
start Width -> Width -> Width
forall a. Num a => a -> a -> a
+ Width
1)

sepSpaced :: (Foldable f, IsString s) => Pretty s -> f (Pretty s) -> Pretty s
sepSpaced :: forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
sepSpaced Pretty s
between = Pretty s -> f (Pretty s) -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
sep (Pretty s
between Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
forall s. IsString s => Pretty s
softbreak)

sep :: (Foldable f, IsString s) => Pretty s -> f (Pretty s) -> Pretty s
sep :: forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
sep Pretty s
between = Pretty s -> (Pretty s -> Pretty s) -> f (Pretty s) -> Pretty s
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap Pretty s
between Pretty s -> Pretty s
forall a. a -> a
id

sepNonEmpty :: (Foldable f, IsString s) => Pretty s -> f (Pretty s) -> Pretty s
sepNonEmpty :: forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
sepNonEmpty Pretty s
between f (Pretty s)
ps = Pretty s -> [Pretty s] -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
sep Pretty s
between (f (Pretty s) -> [Pretty s]
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> [Pretty s]
nonEmpty f (Pretty s)
ps)

-- if list is too long, adds `... 22 more` to the end
excerptSep :: (IsString s) => Maybe Int -> Pretty s -> [Pretty s] -> Pretty s
excerptSep :: forall s.
IsString s =>
Maybe Int -> Pretty s -> [Pretty s] -> Pretty s
excerptSep Maybe Int
maxCount =
  Maybe Int
-> (Int -> Pretty s) -> Pretty s -> [Pretty s] -> Pretty s
forall s.
IsString s =>
Maybe Int
-> (Int -> Pretty s) -> Pretty s -> [Pretty s] -> Pretty s
excerptSep' Maybe Int
maxCount (\Int
i -> Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
group (Pretty s
"... " Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Int -> Pretty s
forall a s. (Show a, IsString s) => a -> Pretty s
shown Int
i Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
" more"))

excerptSep' ::
  (IsString s) =>
  Maybe Int ->
  (Int -> Pretty s) ->
  Pretty s ->
  [Pretty s] ->
  Pretty s
excerptSep' :: forall s.
IsString s =>
Maybe Int
-> (Int -> Pretty s) -> Pretty s -> [Pretty s] -> Pretty s
excerptSep' Maybe Int
maxCount Int -> Pretty s
summarize Pretty s
s [Pretty s]
ps = case Maybe Int
maxCount of
  Just Int
max
    | [Pretty s] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pretty s]
ps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
max ->
        Pretty s -> [Pretty s] -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
sep Pretty s
s (Int -> [Pretty s] -> [Pretty s]
forall a. Int -> [a] -> [a]
take Int
max [Pretty s]
ps) Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Int -> Pretty s
summarize ([Pretty s] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pretty s]
ps Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
max)
  Maybe Int
_ -> Pretty s -> [Pretty s] -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
sep Pretty s
s [Pretty s]
ps

nonEmpty :: (Foldable f, IsString s) => f (Pretty s) -> [Pretty s]
nonEmpty :: forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> [Pretty s]
nonEmpty (f (Pretty s) -> [Pretty s]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList -> [Pretty s]
l) = case [Pretty s]
l of
  (Pretty s -> F s (Pretty s)
forall s. Pretty s -> F s (Pretty s)
out -> F s (Pretty s)
Empty) : [Pretty s]
t -> [Pretty s] -> [Pretty s]
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> [Pretty s]
nonEmpty [Pretty s]
t
  Pretty s
h : [Pretty s]
t -> Pretty s
h Pretty s -> [Pretty s] -> [Pretty s]
forall a. a -> [a] -> [a]
: [Pretty s] -> [Pretty s]
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> [Pretty s]
nonEmpty [Pretty s]
t
  [] -> []

parenthesize :: (IsString s) => Pretty s -> Pretty s
parenthesize :: forall s. IsString s => Pretty s -> Pretty s
parenthesize Pretty s
p = Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
group (Pretty s -> Pretty s) -> Pretty s -> Pretty s
forall a b. (a -> b) -> a -> b
$ Pretty s
"(" Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
p Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
")"

parenthesizeIf :: (IsString s) => Bool -> Pretty s -> Pretty s
parenthesizeIf :: forall s. IsString s => Bool -> Pretty s -> Pretty s
parenthesizeIf Bool
False Pretty s
s = Pretty s
s
parenthesizeIf Bool
True Pretty s
s = Pretty s -> Pretty s
forall s. IsString s => Pretty s -> Pretty s
parenthesize Pretty s
s

lines :: (Foldable f, IsString s) => f (Pretty s) -> Pretty s
lines :: forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
lines = Pretty s -> (Pretty s -> Pretty s) -> f (Pretty s) -> Pretty s
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap (Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
append Pretty s
forall s. IsString s => Pretty s
newline) Pretty s -> Pretty s
forall a. a -> a
id
  where
    append :: Pretty s -> Pretty s
append Pretty s
p = Delta -> F s (Pretty s) -> Pretty s
forall s. Delta -> F s (Pretty s) -> Pretty s
Pretty (Pretty s -> Delta
forall s. Pretty s -> Delta
delta Pretty s
p) (Seq (Pretty s) -> F s (Pretty s)
forall s r. Seq r -> F s r
Append (Seq (Pretty s) -> F s (Pretty s))
-> Seq (Pretty s) -> F s (Pretty s)
forall a b. (a -> b) -> a -> b
$ Pretty s -> Seq (Pretty s)
forall a. a -> Seq a
Seq.singleton Pretty s
p)

linesNonEmpty :: (Foldable f, IsString s) => f (Pretty s) -> Pretty s
linesNonEmpty :: forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
linesNonEmpty = [Pretty s] -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
lines ([Pretty s] -> Pretty s)
-> (f (Pretty s) -> [Pretty s]) -> f (Pretty s) -> Pretty s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Pretty s) -> [Pretty s]
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> [Pretty s]
nonEmpty

linesSpaced :: (Foldable f, IsString s) => f (Pretty s) -> Pretty s
linesSpaced :: forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
linesSpaced f (Pretty s)
ps = [Pretty s] -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
lines (Pretty s -> [Pretty s] -> [Pretty s]
forall a. a -> [a] -> [a]
intersperse Pretty s
"" ([Pretty s] -> [Pretty s]) -> [Pretty s] -> [Pretty s]
forall a b. (a -> b) -> a -> b
$ f (Pretty s) -> [Pretty s]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (Pretty s)
ps)

prefixed ::
  (Foldable f, LL.ListLike s Char, IsString s) =>
  Pretty s ->
  Pretty s ->
  f (Pretty s) ->
  Pretty s
prefixed :: forall (f :: * -> *) s.
(Foldable f, ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> f (Pretty s) -> Pretty s
prefixed Pretty s
first Pretty s
rest =
  Pretty s -> (Pretty s -> Pretty s) -> f (Pretty s) -> Pretty s
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap Pretty s
forall s. IsString s => Pretty s
newline (\Pretty s
b -> Pretty s
first Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
indentAfterNewline Pretty s
rest Pretty s
b)

bulleted ::
  (Foldable f, LL.ListLike s Char, IsString s) => f (Pretty s) -> Pretty s
bulleted :: forall (f :: * -> *) s.
(Foldable f, ListLike s Char, IsString s) =>
f (Pretty s) -> Pretty s
bulleted = Pretty s -> Pretty s -> f (Pretty s) -> Pretty s
forall (f :: * -> *) s.
(Foldable f, ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> f (Pretty s) -> Pretty s
prefixed Pretty s
"* " Pretty s
"  "

dashed ::
  (Foldable f, LL.ListLike s Char, IsString s) => f (Pretty s) -> Pretty s
dashed :: forall (f :: * -> *) s.
(Foldable f, ListLike s Char, IsString s) =>
f (Pretty s) -> Pretty s
dashed = Pretty s -> Pretty s -> f (Pretty s) -> Pretty s
forall (f :: * -> *) s.
(Foldable f, ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> f (Pretty s) -> Pretty s
prefixed Pretty s
"- " Pretty s
"  "

commented ::
  (Foldable f, LL.ListLike s Char, IsString s) => f (Pretty s) -> Pretty s
commented :: forall (f :: * -> *) s.
(Foldable f, ListLike s Char, IsString s) =>
f (Pretty s) -> Pretty s
commented = Pretty s -> Pretty s -> f (Pretty s) -> Pretty s
forall (f :: * -> *) s.
(Foldable f, ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> f (Pretty s) -> Pretty s
prefixed Pretty s
"-- " Pretty s
"-- "

numbered ::
  (Foldable f, LL.ListLike s Char, IsString s) =>
  (Int -> Pretty s) ->
  f (Pretty s) ->
  Pretty s
numbered :: forall (f :: * -> *) s.
(Foldable f, ListLike s Char, IsString s) =>
(Int -> Pretty s) -> f (Pretty s) -> Pretty s
numbered Int -> Pretty s
num f (Pretty s)
ps = [(Pretty s, Pretty s)] -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
column2 ((Int -> Pretty s) -> [Int] -> [Pretty s]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Pretty s
num [Int
1 ..] [Pretty s] -> [Pretty s] -> [(Pretty s, Pretty s)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` f (Pretty s) -> [Pretty s]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (Pretty s)
ps)

numberedHeader ::
  (Foldable f, LL.ListLike s Char, IsString s) =>
  (Maybe Int -> Pretty s) ->
  f (Pretty s) ->
  Pretty s
numberedHeader :: forall (f :: * -> *) s.
(Foldable f, ListLike s Char, IsString s) =>
(Maybe Int -> Pretty s) -> f (Pretty s) -> Pretty s
numberedHeader Maybe Int -> Pretty s
num f (Pretty s)
ps = [(Pretty s, Pretty s)] -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
column2 ((Maybe Int -> Pretty s) -> [Maybe Int] -> [Pretty s]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Int -> Pretty s
num (Maybe Int
forall a. Maybe a
Nothing Maybe Int -> [Maybe Int] -> [Maybe Int]
forall a. a -> [a] -> [a]
: (Int -> Maybe Int) -> [Int] -> [Maybe Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Maybe Int
forall a. a -> Maybe a
Just [Int
1 ..]) [Pretty s] -> [Pretty s] -> [(Pretty s, Pretty s)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` f (Pretty s) -> [Pretty s]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (Pretty s)
ps)

-- Like `column2` but with the lines numbered. For instance:
--
-- 1. one thing     : this is a thing
-- 2. another thing : this is another thing
-- 3. and another   : yet one more thing
numberedColumn2ListFrom ::
  (Foldable f) =>
  Int ->
  f (Pretty ColorText, Pretty ColorText) ->
  Pretty ColorText
numberedColumn2ListFrom :: forall (f :: * -> *).
Foldable f =>
Int -> f (Pretty ColorText, Pretty ColorText) -> Pretty ColorText
numberedColumn2ListFrom Int
num f (Pretty ColorText, Pretty ColorText)
ps = Int -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *).
Foldable f =>
Int -> f (Pretty ColorText) -> Pretty ColorText
numberedListFrom Int
num ([(Pretty ColorText, Pretty ColorText)] -> [Pretty ColorText]
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> [Pretty s]
align ([(Pretty ColorText, Pretty ColorText)] -> [Pretty ColorText])
-> [(Pretty ColorText, Pretty ColorText)] -> [Pretty ColorText]
forall a b. (a -> b) -> a -> b
$ f (Pretty ColorText, Pretty ColorText)
-> [(Pretty ColorText, Pretty ColorText)]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (Pretty ColorText, Pretty ColorText)
ps)

numberedColumn2Header ::
  (Foldable f, LL.ListLike s Char, IsString s) =>
  (Int -> Pretty s) ->
  f (Pretty s, Pretty s) ->
  Pretty s
numberedColumn2Header :: forall (f :: * -> *) s.
(Foldable f, ListLike s Char, IsString s) =>
(Int -> Pretty s) -> f (Pretty s, Pretty s) -> Pretty s
numberedColumn2Header Int -> Pretty s
num f (Pretty s, Pretty s)
ps = (Maybe Int -> Pretty s) -> [Pretty s] -> Pretty s
forall (f :: * -> *) s.
(Foldable f, ListLike s Char, IsString s) =>
(Maybe Int -> Pretty s) -> f (Pretty s) -> Pretty s
numberedHeader (Pretty s -> (Int -> Pretty s) -> Maybe Int -> Pretty s
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Pretty s
forall a. Monoid a => a
mempty Int -> Pretty s
num) ([(Pretty s, Pretty s)] -> [Pretty s]
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> [Pretty s]
align ([(Pretty s, Pretty s)] -> [Pretty s])
-> [(Pretty s, Pretty s)] -> [Pretty s]
forall a b. (a -> b) -> a -> b
$ f (Pretty s, Pretty s) -> [(Pretty s, Pretty s)]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (Pretty s, Pretty s)
ps)

numberedColumnNHeader ::
  [Pretty ColorText] ->
  [[Pretty ColorText]] ->
  Pretty ColorText
numberedColumnNHeader :: [Pretty ColorText] -> [[Pretty ColorText]] -> Pretty ColorText
numberedColumnNHeader [Pretty ColorText]
headers [[Pretty ColorText]]
rows =
  let numbers :: [Pretty ColorText]
numbers = ([Int
1 :: Int ..] [Int] -> (Int -> Pretty ColorText) -> [Pretty ColorText]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Int
n -> Pretty ColorText -> Pretty ColorText
hiBlack (Int -> Pretty ColorText
forall a s. (Show a, IsString s) => a -> Pretty s
shown Int
n Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"."))
   in [Pretty ColorText] -> [[Pretty ColorText]] -> Pretty ColorText
columnNHeader (Pretty ColorText
"" Pretty ColorText -> [Pretty ColorText] -> [Pretty ColorText]
forall a. a -> [a] -> [a]
: [Pretty ColorText]
headers) ((Pretty ColorText -> [Pretty ColorText] -> [Pretty ColorText])
-> [Pretty ColorText]
-> [[Pretty ColorText]]
-> [[Pretty ColorText]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (:) [Pretty ColorText]
numbers [[Pretty ColorText]]
rows)

-- Opinionated `numbered` that uses hiBlack numbers in front
numberedList :: (Foldable f) => f (Pretty ColorText) -> Pretty ColorText
numberedList :: forall (f :: * -> *).
Foldable f =>
f (Pretty ColorText) -> Pretty ColorText
numberedList = Int -> f (Pretty ColorText) -> Pretty ColorText
forall (f :: * -> *).
Foldable f =>
Int -> f (Pretty ColorText) -> Pretty ColorText
numberedListFrom Int
0

numberedListFrom :: (Foldable f) => Int -> f (Pretty ColorText) -> Pretty ColorText
numberedListFrom :: forall (f :: * -> *).
Foldable f =>
Int -> f (Pretty ColorText) -> Pretty ColorText
numberedListFrom Int
n = (Int -> Pretty ColorText)
-> f (Pretty ColorText) -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, ListLike s Char, IsString s) =>
(Int -> Pretty s) -> f (Pretty s) -> Pretty s
numbered (\Int
i -> Pretty ColorText -> Pretty ColorText
hiBlack (Pretty ColorText -> Pretty ColorText)
-> (String -> Pretty ColorText) -> String -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Pretty ColorText
forall a. IsString a => String -> a
fromString (String -> Pretty ColorText) -> String -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
".")

leftPad, rightPad :: (IsString s) => Width -> Pretty s -> Pretty s
leftPad :: forall s. IsString s => Width -> Pretty s -> Pretty s
leftPad Width
n Pretty s
p =
  let rem :: Width
rem = Width
n Width -> Width -> Width
forall a. Num a => a -> a -> a
- Pretty s -> Width
forall s. Pretty s -> Width
preferredWidth Pretty s
p
   in if Width
rem Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
> Width
0 then String -> Pretty s
forall a. IsString a => String -> a
fromString (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Width -> Int
widthToInt Width
rem) Char
' ') Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
p else Pretty s
p
rightPad :: forall s. IsString s => Width -> Pretty s -> Pretty s
rightPad Width
n Pretty s
p =
  let rem :: Width
rem = Width
n Width -> Width -> Width
forall a. Num a => a -> a -> a
- Pretty s -> Width
forall s. Pretty s -> Width
preferredWidth Pretty s
p
   in if Width
rem Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
> Width
0 then Pretty s
p Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> String -> Pretty s
forall a. IsString a => String -> a
fromString (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Width -> Int
widthToInt Width
rem) Char
' ') else Pretty s
p

excerptColumn2Headed ::
  (LL.ListLike s Char, IsString s) =>
  Maybe Int ->
  (Pretty s, Pretty s) ->
  [(Pretty s, Pretty s)] ->
  Pretty s
excerptColumn2Headed :: forall s.
(ListLike s Char, IsString s) =>
Maybe Int
-> (Pretty s, Pretty s) -> [(Pretty s, Pretty s)] -> Pretty s
excerptColumn2Headed Maybe Int
max (Pretty s, Pretty s)
hd [(Pretty s, Pretty s)]
cols = case Maybe Int
max of
  Just Int
max
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
max ->
        [Pretty s] -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
lines [[(Pretty s, Pretty s)] -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
column2 ((Pretty s, Pretty s)
hd (Pretty s, Pretty s)
-> [(Pretty s, Pretty s)] -> [(Pretty s, Pretty s)]
forall a. a -> [a] -> [a]
: Int -> [(Pretty s, Pretty s)] -> [(Pretty s, Pretty s)]
forall a. Int -> [a] -> [a]
take Int
max [(Pretty s, Pretty s)]
cols), Pretty s
"... " Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Int -> Pretty s
forall a s. (Show a, IsString s) => a -> Pretty s
shown (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
max) Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
" more"]
  Maybe Int
_ -> [(Pretty s, Pretty s)] -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
column2 ((Pretty s, Pretty s)
hd (Pretty s, Pretty s)
-> [(Pretty s, Pretty s)] -> [(Pretty s, Pretty s)]
forall a. a -> [a] -> [a]
: [(Pretty s, Pretty s)]
cols)
  where
    len :: Int
len = [(Pretty s, Pretty s)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Pretty s, Pretty s)]
cols

excerptColumn2 ::
  (LL.ListLike s Char, IsString s) =>
  Maybe Int ->
  [(Pretty s, Pretty s)] ->
  Pretty s
excerptColumn2 :: forall s.
(ListLike s Char, IsString s) =>
Maybe Int -> [(Pretty s, Pretty s)] -> Pretty s
excerptColumn2 Maybe Int
max [(Pretty s, Pretty s)]
cols = case Maybe Int
max of
  Just Int
max | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
max -> [Pretty s] -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
lines [[(Pretty s, Pretty s)] -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
column2 [(Pretty s, Pretty s)]
cols, Pretty s
"... " Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Int -> Pretty s
forall a s. (Show a, IsString s) => a -> Pretty s
shown (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
max)]
  Maybe Int
_ -> [(Pretty s, Pretty s)] -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
column2 [(Pretty s, Pretty s)]
cols
  where
    len :: Int
len = [(Pretty s, Pretty s)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Pretty s, Pretty s)]
cols

table :: (IsString s, LL.ListLike s Char) => [[Pretty s]] -> Pretty s
table :: forall s. (IsString s, ListLike s Char) => [[Pretty s]] -> Pretty s
table [[Pretty s]]
rows = [Pretty s] -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
lines ([[Pretty s]] -> [Pretty s]
forall s.
(IsString s, ListLike s Char) =>
[[Pretty s]] -> [Pretty s]
table' [[Pretty s]]
rows)

table' :: (IsString s, LL.ListLike s Char) => [[Pretty s]] -> [Pretty s]
table' :: forall s.
(IsString s, ListLike s Char) =>
[[Pretty s]] -> [Pretty s]
table' [] = [Pretty s]
forall a. Monoid a => a
mempty
table' [[Pretty s]]
rows = case [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Pretty s] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length ([Pretty s] -> Int) -> [[Pretty s]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Pretty s]]
rows) of
  Int
1 ->
    [[Pretty s]]
rows [[Pretty s]] -> ([Pretty s] -> [Pretty s]) -> [Pretty s]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      [] -> [Pretty s
forall a. Monoid a => a
mempty]
      Pretty s
hd : [Pretty s]
_ -> [Pretty s
hd]
  Int
_ ->
    let colHd :: [Pretty s]
colHd = [Pretty s
h | (Pretty s
h : [Pretty s]
_) <- [[Pretty s]]
rows]
        colTl :: [[Pretty s]]
colTl = [[Pretty s]
t | (Pretty s
_ : [Pretty s]
t) <- [[Pretty s]]
rows]
     in [(Pretty s, Pretty s)] -> [Pretty s]
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> [Pretty s]
align ((Pretty s -> Pretty s) -> [Pretty s] -> [Pretty s]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
"  ") [Pretty s]
colHd [Pretty s] -> [Pretty s] -> [(Pretty s, Pretty s)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` ([[Pretty s]] -> [Pretty s]
forall s.
(IsString s, ListLike s Char) =>
[[Pretty s]] -> [Pretty s]
table' [[Pretty s]]
colTl))

column2 ::
  (LL.ListLike s Char, IsString s) => [(Pretty s, Pretty s)] -> Pretty s
column2 :: forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
column2 = Pretty s -> [(Pretty s, Pretty s)] -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> [(Pretty s, Pretty s)] -> Pretty s
column2sep Pretty s
""

column2Header ::
  Pretty ColorText -> Pretty ColorText -> [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
column2Header :: Pretty ColorText
-> Pretty ColorText
-> [(Pretty ColorText, Pretty ColorText)]
-> Pretty ColorText
column2Header Pretty ColorText
left Pretty ColorText
right = Pretty ColorText
-> [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> [(Pretty s, Pretty s)] -> Pretty s
column2sep Pretty ColorText
"  " ([(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText)
-> ([(Pretty ColorText, Pretty ColorText)]
    -> [(Pretty ColorText, Pretty ColorText)])
-> [(Pretty ColorText, Pretty ColorText)]
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((ColorText -> ColorText) -> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> Pretty a -> Pretty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ColorText -> ColorText
CT.hiBlack Pretty ColorText
left, (ColorText -> ColorText) -> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> Pretty a -> Pretty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ColorText -> ColorText
CT.hiBlack Pretty ColorText
right) (Pretty ColorText, Pretty ColorText)
-> [(Pretty ColorText, Pretty ColorText)]
-> [(Pretty ColorText, Pretty ColorText)]
forall a. a -> [a] -> [a]
:)

column2sep ::
  (LL.ListLike s Char, IsString s) => Pretty s -> [(Pretty s, Pretty s)] -> Pretty s
column2sep :: forall s.
(ListLike s Char, IsString s) =>
Pretty s -> [(Pretty s, Pretty s)] -> Pretty s
column2sep Pretty s
sep [(Pretty s, Pretty s)]
rows = [Pretty s] -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
lines ([Pretty s] -> Pretty s)
-> ([(Pretty s, Pretty s)] -> [Pretty s])
-> [(Pretty s, Pretty s)]
-> Pretty s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
group (Pretty s -> Pretty s) -> [Pretty s] -> [Pretty s]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([Pretty s] -> [Pretty s])
-> ([(Pretty s, Pretty s)] -> [Pretty s])
-> [(Pretty s, Pretty s)]
-> [Pretty s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Pretty s, Pretty s)] -> [Pretty s]
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> [Pretty s]
align ([(Pretty s, Pretty s)] -> Pretty s)
-> [(Pretty s, Pretty s)] -> Pretty s
forall a b. (a -> b) -> a -> b
$ [(Pretty s
a, Pretty s -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
indent Pretty s
sep Pretty s
b) | (Pretty s
a, Pretty s
b) <- [(Pretty s, Pretty s)]
rows]

column2M ::
  (Applicative m, LL.ListLike s Char, IsString s) =>
  [m (Pretty s, Pretty s)] ->
  m (Pretty s)
column2M :: forall (m :: * -> *) s.
(Applicative m, ListLike s Char, IsString s) =>
[m (Pretty s, Pretty s)] -> m (Pretty s)
column2M = ([(Pretty s, Pretty s)] -> Pretty s)
-> m [(Pretty s, Pretty s)] -> m (Pretty s)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Pretty s, Pretty s)] -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
column2 (m [(Pretty s, Pretty s)] -> m (Pretty s))
-> ([m (Pretty s, Pretty s)] -> m [(Pretty s, Pretty s)])
-> [m (Pretty s, Pretty s)]
-> m (Pretty s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [m (Pretty s, Pretty s)] -> m [(Pretty s, Pretty s)]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA

mayColumn2 ::
  (LL.ListLike s Char, IsString s) =>
  [(Pretty s, Maybe (Pretty s))] ->
  Pretty s
mayColumn2 :: forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Maybe (Pretty s))] -> Pretty s
mayColumn2 = [Pretty s] -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
lines ([Pretty s] -> Pretty s)
-> ([(Pretty s, Maybe (Pretty s))] -> [Pretty s])
-> [(Pretty s, Maybe (Pretty s))]
-> Pretty s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
group (Pretty s -> Pretty s) -> [Pretty s] -> [Pretty s]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([Pretty s] -> [Pretty s])
-> ([(Pretty s, Maybe (Pretty s))] -> [Pretty s])
-> [(Pretty s, Maybe (Pretty s))]
-> [Pretty s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Pretty s -> Pretty s -> Pretty s)
-> (Pretty s, Pretty s) -> Pretty s
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
(<>)) ((Pretty s, Pretty s) -> Pretty s)
-> [(Pretty s, Pretty s)] -> [Pretty s]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([(Pretty s, Pretty s)] -> [Pretty s])
-> ([(Pretty s, Maybe (Pretty s))] -> [(Pretty s, Pretty s)])
-> [(Pretty s, Maybe (Pretty s))]
-> [Pretty s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Pretty s, Maybe (Pretty s))] -> [(Pretty s, Pretty s)]
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Maybe (Pretty s))] -> [(Pretty s, Pretty s)]
align'

column3 ::
  (LL.ListLike s Char, IsString s) =>
  [(Pretty s, Pretty s, Pretty s)] ->
  Pretty s
column3 :: forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s, Pretty s)] -> Pretty s
column3 = Pretty s -> [(Pretty s, Pretty s, Pretty s)] -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> [(Pretty s, Pretty s, Pretty s)] -> Pretty s
column3sep Pretty s
""

column3Header ::
  Pretty ColorText -> Pretty ColorText -> Pretty ColorText -> [(Pretty ColorText, Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
column3Header :: Pretty ColorText
-> Pretty ColorText
-> Pretty ColorText
-> [(Pretty ColorText, Pretty ColorText, Pretty ColorText)]
-> Pretty ColorText
column3Header Pretty ColorText
left Pretty ColorText
middle Pretty ColorText
right = Pretty ColorText
-> [(Pretty ColorText, Pretty ColorText, Pretty ColorText)]
-> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> [(Pretty s, Pretty s, Pretty s)] -> Pretty s
column3sep Pretty ColorText
"  " ([(Pretty ColorText, Pretty ColorText, Pretty ColorText)]
 -> Pretty ColorText)
-> ([(Pretty ColorText, Pretty ColorText, Pretty ColorText)]
    -> [(Pretty ColorText, Pretty ColorText, Pretty ColorText)])
-> [(Pretty ColorText, Pretty ColorText, Pretty ColorText)]
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Pretty ColorText -> Pretty ColorText
hiBlack Pretty ColorText
left, Pretty ColorText -> Pretty ColorText
hiBlack Pretty ColorText
middle, Pretty ColorText -> Pretty ColorText
hiBlack Pretty ColorText
right) (Pretty ColorText, Pretty ColorText, Pretty ColorText)
-> [(Pretty ColorText, Pretty ColorText, Pretty ColorText)]
-> [(Pretty ColorText, Pretty ColorText, Pretty ColorText)]
forall a. a -> [a] -> [a]
:)

column3M ::
  (LL.ListLike s Char, IsString s, Monad m) =>
  [m (Pretty s, Pretty s, Pretty s)] ->
  m (Pretty s)
column3M :: forall s (m :: * -> *).
(ListLike s Char, IsString s, Monad m) =>
[m (Pretty s, Pretty s, Pretty s)] -> m (Pretty s)
column3M = ([(Pretty s, Pretty s, Pretty s)] -> Pretty s)
-> m [(Pretty s, Pretty s, Pretty s)] -> m (Pretty s)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Pretty s, Pretty s, Pretty s)] -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s, Pretty s)] -> Pretty s
column3 (m [(Pretty s, Pretty s, Pretty s)] -> m (Pretty s))
-> ([m (Pretty s, Pretty s, Pretty s)]
    -> m [(Pretty s, Pretty s, Pretty s)])
-> [m (Pretty s, Pretty s, Pretty s)]
-> m (Pretty s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [m (Pretty s, Pretty s, Pretty s)]
-> m [(Pretty s, Pretty s, Pretty s)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence

column3UnzippedM ::
  forall m s.
  (LL.ListLike s Char, IsString s, Monad m) =>
  Pretty s ->
  [m (Pretty s)] ->
  [m (Pretty s)] ->
  [m (Pretty s)] ->
  m (Pretty s)
column3UnzippedM :: forall (m :: * -> *) s.
(ListLike s Char, IsString s, Monad m) =>
Pretty s
-> [m (Pretty s)]
-> [m (Pretty s)]
-> [m (Pretty s)]
-> m (Pretty s)
column3UnzippedM Pretty s
bottomPadding [m (Pretty s)]
left [m (Pretty s)]
mid [m (Pretty s)]
right =
  let rowCount :: Int
rowCount = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (([m (Pretty s)] -> Int) -> [[m (Pretty s)]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [m (Pretty s)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[m (Pretty s)]
left, [m (Pretty s)]
mid, [m (Pretty s)]
right])
      pad :: [m (Pretty s)] -> [m (Pretty s)]
      pad :: [m (Pretty s)] -> [m (Pretty s)]
pad [m (Pretty s)]
a = [m (Pretty s)]
a [m (Pretty s)] -> [m (Pretty s)] -> [m (Pretty s)]
forall a. [a] -> [a] -> [a]
++ Int -> m (Pretty s) -> [m (Pretty s)]
forall a. Int -> a -> [a]
replicate (Int
rowCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- [m (Pretty s)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [m (Pretty s)]
a) (Pretty s -> m (Pretty s)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty s
bottomPadding)
      ([m (Pretty s)]
pleft, [m (Pretty s)]
pmid, [m (Pretty s)]
pright) = ([m (Pretty s)] -> [m (Pretty s)]
pad [m (Pretty s)]
left, [m (Pretty s)] -> [m (Pretty s)]
pad [m (Pretty s)]
mid, [m (Pretty s)] -> [m (Pretty s)]
pad [m (Pretty s)]
right)
   in [m (Pretty s, Pretty s, Pretty s)] -> m (Pretty s)
forall s (m :: * -> *).
(ListLike s Char, IsString s, Monad m) =>
[m (Pretty s, Pretty s, Pretty s)] -> m (Pretty s)
column3M ([m (Pretty s, Pretty s, Pretty s)] -> m (Pretty s))
-> [m (Pretty s, Pretty s, Pretty s)] -> m (Pretty s)
forall a b. (a -> b) -> a -> b
$ (m (Pretty s)
 -> m (Pretty s)
 -> m (Pretty s)
 -> m (Pretty s, Pretty s, Pretty s))
-> [m (Pretty s)]
-> [m (Pretty s)]
-> [m (Pretty s)]
-> [m (Pretty s, Pretty s, Pretty s)]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 ((Pretty s
 -> Pretty s -> Pretty s -> (Pretty s, Pretty s, Pretty s))
-> m (Pretty s)
-> m (Pretty s)
-> m (Pretty s)
-> m (Pretty s, Pretty s, Pretty s)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (,,)) [m (Pretty s)]
pleft [m (Pretty s)]
pmid [m (Pretty s)]
pright

column2UnzippedM ::
  forall m s.
  (LL.ListLike s Char, IsString s, Monad m) =>
  Pretty s ->
  [m (Pretty s)] ->
  [m (Pretty s)] ->
  m (Pretty s)
column2UnzippedM :: forall (m :: * -> *) s.
(ListLike s Char, IsString s, Monad m) =>
Pretty s -> [m (Pretty s)] -> [m (Pretty s)] -> m (Pretty s)
column2UnzippedM Pretty s
bottomPadding [m (Pretty s)]
left [m (Pretty s)]
right =
  let rowCount :: Int
rowCount = [m (Pretty s)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [m (Pretty s)]
left Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` [m (Pretty s)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [m (Pretty s)]
right
      pad :: [m (Pretty s)] -> [m (Pretty s)]
      pad :: [m (Pretty s)] -> [m (Pretty s)]
pad [m (Pretty s)]
a = [m (Pretty s)]
a [m (Pretty s)] -> [m (Pretty s)] -> [m (Pretty s)]
forall a. [a] -> [a] -> [a]
++ Int -> m (Pretty s) -> [m (Pretty s)]
forall a. Int -> a -> [a]
replicate (Int
rowCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- [m (Pretty s)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [m (Pretty s)]
a) (Pretty s -> m (Pretty s)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty s
bottomPadding)
      sep :: [m (Pretty s)] -> [m (Pretty s)]
      sep :: [m (Pretty s)] -> [m (Pretty s)]
sep = (m (Pretty s) -> m (Pretty s)) -> [m (Pretty s)] -> [m (Pretty s)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Pretty s -> Pretty s) -> m (Pretty s) -> m (Pretty s)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Pretty s
" " Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<>))
      ([m (Pretty s)]
pleft, [m (Pretty s)]
pright) = ([m (Pretty s)] -> [m (Pretty s)]
pad [m (Pretty s)]
left, [m (Pretty s)] -> [m (Pretty s)]
sep ([m (Pretty s)] -> [m (Pretty s)])
-> [m (Pretty s)] -> [m (Pretty s)]
forall a b. (a -> b) -> a -> b
$ [m (Pretty s)] -> [m (Pretty s)]
pad [m (Pretty s)]
right)
   in [m (Pretty s, Pretty s)] -> m (Pretty s)
forall (m :: * -> *) s.
(Applicative m, ListLike s Char, IsString s) =>
[m (Pretty s, Pretty s)] -> m (Pretty s)
column2M ([m (Pretty s, Pretty s)] -> m (Pretty s))
-> [m (Pretty s, Pretty s)] -> m (Pretty s)
forall a b. (a -> b) -> a -> b
$ (m (Pretty s) -> m (Pretty s) -> m (Pretty s, Pretty s))
-> [m (Pretty s)] -> [m (Pretty s)] -> [m (Pretty s, Pretty s)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((Pretty s -> Pretty s -> (Pretty s, Pretty s))
-> m (Pretty s) -> m (Pretty s) -> m (Pretty s, Pretty s)
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,)) [m (Pretty s)]
pleft [m (Pretty s)]
pright

column3sep ::
  (LL.ListLike s Char, IsString s) => Pretty s -> [(Pretty s, Pretty s, Pretty s)] -> Pretty s
column3sep :: forall s.
(ListLike s Char, IsString s) =>
Pretty s -> [(Pretty s, Pretty s, Pretty s)] -> Pretty s
column3sep Pretty s
sep [(Pretty s, Pretty s, Pretty s)]
rows =
  let bc :: [Pretty s]
bc = [(Pretty s, Pretty s)] -> [Pretty s]
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> [Pretty s]
align [(Pretty s
b, Pretty s
sep Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
c) | (Pretty s
_, Pretty s
b, Pretty s
c) <- [(Pretty s, Pretty s, Pretty s)]
rows]
      abc :: [Pretty s]
abc = Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
group (Pretty s -> Pretty s) -> [Pretty s] -> [Pretty s]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Pretty s, Pretty s)] -> [Pretty s]
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> [Pretty s]
align [(Pretty s
a, Pretty s
sep Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
bc) | ((Pretty s
a, Pretty s
_, Pretty s
_), Pretty s
bc) <- [(Pretty s, Pretty s, Pretty s)]
rows [(Pretty s, Pretty s, Pretty s)]
-> [Pretty s] -> [((Pretty s, Pretty s, Pretty s), Pretty s)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Pretty s]
bc]
   in [Pretty s] -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
lines [Pretty s]
abc

-- | Creates an aligned table with an arbitrary number of columns separated by `sep`
-- Ensure all rows have the same number of columns or the alignment may be off.
columnNSep ::
  (LL.ListLike s Char, IsString s) => Pretty s -> [[Pretty s]] -> Pretty s
columnNSep :: forall s.
(ListLike s Char, IsString s) =>
Pretty s -> [[Pretty s]] -> Pretty s
columnNSep Pretty s
_sep [] = Pretty s
forall a. Monoid a => a
mempty
columnNSep Pretty s
sep [[Pretty s]]
rows =
  -- Groups up columns
  -- converts [[A1, B1, C1], [A2, B2, C2]] -> [[C1, C2], [B1, B2], [A1, A2]]
  case [[Pretty s]] -> [[Pretty s]]
forall a. [a] -> [a]
reverse ([[Pretty s]] -> [[Pretty s]]) -> [[Pretty s]] -> [[Pretty s]]
forall a b. (a -> b) -> a -> b
$ [[Pretty s]] -> [[Pretty s]]
forall a. [[a]] -> [[a]]
List.transpose [[Pretty s]]
rows of
    [] -> Pretty s
forall a. Monoid a => a
mempty
    ([Pretty s]
lastCol : [[Pretty s]]
restCols) ->
      let go :: [Pretty s] -> [Pretty s] -> [Pretty s]
go [Pretty s]
formatted [Pretty s]
prevCol = [(Pretty s, Pretty s)] -> [Pretty s]
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> [Pretty s]
align ([Pretty s] -> [Pretty s] -> [(Pretty s, Pretty s)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Pretty s]
prevCol ((Pretty s
sep Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<>) (Pretty s -> Pretty s) -> [Pretty s] -> [Pretty s]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pretty s]
formatted))
       in ([Pretty s] -> [Pretty s] -> [Pretty s])
-> [Pretty s] -> [[Pretty s]] -> [Pretty s]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' [Pretty s] -> [Pretty s] -> [Pretty s]
go [Pretty s]
lastCol [[Pretty s]]
restCols
            [Pretty s] -> ([Pretty s] -> [Pretty s]) -> [Pretty s]
forall a b. a -> (a -> b) -> b
& (Pretty s -> Pretty s) -> [Pretty s] -> [Pretty s]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
group
            [Pretty s] -> ([Pretty s] -> Pretty s) -> Pretty s
forall a b. a -> (a -> b) -> b
& [Pretty s] -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
lines

-- | Creates an aligned table with an arbitrary number of columns and column headers.
-- Ensure all rows have the same number of columns or the alignment may be off.
columnNHeader :: [Pretty ColorText] -> [[Pretty ColorText]] -> Pretty ColorText
columnNHeader :: [Pretty ColorText] -> [[Pretty ColorText]] -> Pretty ColorText
columnNHeader [Pretty ColorText]
headers [[Pretty ColorText]]
rows = Pretty ColorText -> [[Pretty ColorText]] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> [[Pretty s]] -> Pretty s
columnNSep Pretty ColorText
"  " ([[Pretty ColorText]] -> Pretty ColorText)
-> [[Pretty ColorText]] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ ((Pretty ColorText -> Pretty ColorText)
-> [Pretty ColorText] -> [Pretty ColorText]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ColorText -> ColorText) -> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> Pretty a -> Pretty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ColorText -> ColorText
CT.hiBlack) [Pretty ColorText]
headers [Pretty ColorText] -> [[Pretty ColorText]] -> [[Pretty ColorText]]
forall a. a -> [a] -> [a]
: [[Pretty ColorText]]
rows)

wrapColumn2 ::
  (LL.ListLike s Char, IsString s) => [(Pretty s, Pretty s)] -> Pretty s
wrapColumn2 :: forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
wrapColumn2 [(Pretty s, Pretty s)]
rows = [Pretty s] -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
lines ([(Pretty s, Pretty s)] -> [Pretty s]
forall {s}.
(Item s ~ Char, IsString s, ListLike s Char) =>
[(Pretty s, Pretty s)] -> [Pretty s]
align [(Pretty s, Pretty s)]
rows)
  where
    align :: [(Pretty s, Pretty s)] -> [Pretty s]
align [(Pretty s, Pretty s)]
rows =
      let lwidth :: Width
lwidth = (Width -> Width -> Width) -> Width -> [Width] -> Width
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Width -> Width -> Width
forall a. Ord a => a -> a -> a
max Width
0 (Pretty s -> Width
forall s. Pretty s -> Width
preferredWidth (Pretty s -> Width)
-> ((Pretty s, Pretty s) -> Pretty s)
-> (Pretty s, Pretty s)
-> Width
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pretty s, Pretty s) -> Pretty s
forall a b. (a, b) -> a
fst ((Pretty s, Pretty s) -> Width)
-> [(Pretty s, Pretty s)] -> [Width]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Pretty s, Pretty s)]
rows) Width -> Width -> Width
forall a. Num a => a -> a -> a
+ Width
2
       in [ Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
group (Width -> Pretty s -> Pretty s
forall s. IsString s => Width -> Pretty s -> Pretty s
rightPad Width
lwidth Pretty s
l Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
indentNAfterNewline Width
lwidth (Pretty s -> Pretty s
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
wrap Pretty s
r))
            | (Pretty s
l, Pretty s
r) <- [(Pretty s, Pretty s)]
rows
          ]

-- Pad with enough space on the right to make all rows the same width
leftJustify ::
  (Eq s, LL.ListLike s Char, IsString s) =>
  [(Pretty s, a)] ->
  [(Pretty s, a)]
leftJustify :: forall s a.
(Eq s, ListLike s Char, IsString s) =>
[(Pretty s, a)] -> [(Pretty s, a)]
leftJustify [(Pretty s, a)]
rows =
  [Pretty s] -> [a] -> [(Pretty s, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip
    ( ((Pretty s, Pretty s) -> Pretty s)
-> [(Pretty s, Pretty s)] -> [Pretty s]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Pretty s, Pretty s) -> Pretty s
forall a b. (a, b) -> a
fst ([(Pretty s, Pretty s)] -> [Pretty s])
-> ([(Pretty s, Maybe (Pretty s))] -> [(Pretty s, Pretty s)])
-> [(Pretty s, Maybe (Pretty s))]
-> [Pretty s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Pretty s, Maybe (Pretty s))] -> [(Pretty s, Pretty s)]
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Maybe (Pretty s))] -> [(Pretty s, Pretty s)]
align' ([(Pretty s, Maybe (Pretty s))] -> [Pretty s])
-> [(Pretty s, Maybe (Pretty s))] -> [Pretty s]
forall a b. (a -> b) -> a -> b
$
        (Pretty s -> (Pretty s, Maybe (Pretty s)))
-> [Pretty s] -> [(Pretty s, Maybe (Pretty s))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          (\Pretty s
x -> (Pretty s
x, if Pretty s -> Bool
forall s. (Eq s, IsString s) => Pretty s -> Bool
isEmpty Pretty s
x then Maybe (Pretty s)
forall a. Maybe a
Nothing else Pretty s -> Maybe (Pretty s)
forall a. a -> Maybe a
Just Pretty s
""))
          [Pretty s]
ss
    )
    [a]
as
  where
    ([Pretty s]
ss, [a]
as) = [(Pretty s, a)] -> ([Pretty s], [a])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Pretty s, a)]
rows

align ::
  (LL.ListLike s Char, IsString s) => [(Pretty s, Pretty s)] -> [Pretty s]
align :: forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> [Pretty s]
align [(Pretty s, Pretty s)]
rows = ((((Pretty s -> Pretty s -> Pretty s)
-> (Pretty s, Pretty s) -> Pretty s
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
(<>)) ((Pretty s, Pretty s) -> Pretty s)
-> [(Pretty s, Pretty s)] -> [Pretty s]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([(Pretty s, Pretty s)] -> [Pretty s])
-> ([(Pretty s, Maybe (Pretty s))] -> [(Pretty s, Pretty s)])
-> [(Pretty s, Maybe (Pretty s))]
-> [Pretty s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Pretty s, Maybe (Pretty s))] -> [(Pretty s, Pretty s)]
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Maybe (Pretty s))] -> [(Pretty s, Pretty s)]
align') ((Pretty s -> Maybe (Pretty s))
-> (Pretty s, Pretty s) -> (Pretty s, Maybe (Pretty s))
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Pretty s -> Maybe (Pretty s)
forall a. a -> Maybe a
Just ((Pretty s, Pretty s) -> (Pretty s, Maybe (Pretty s)))
-> [(Pretty s, Pretty s)] -> [(Pretty s, Maybe (Pretty s))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Pretty s, Pretty s)]
rows)

-- [("foo", Just "bar")
-- ,("barabaz", Nothing)
-- ,("qux","quux")]
--
-- results in:
--
-- [("foo ", "bar"),
-- [("barabaz", ""),
-- [("qux ", "quuxbill")]
--
-- The first component has padding added, sufficient to align the second
-- component.  The second component has whitespace added after its
-- newlines, again sufficient to line it up in a second column.
align' ::
  (LL.ListLike s Char, IsString s) =>
  [(Pretty s, Maybe (Pretty s))] ->
  [(Pretty s, Pretty s)]
align' :: forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Maybe (Pretty s))] -> [(Pretty s, Pretty s)]
align' [(Pretty s, Maybe (Pretty s))]
rows = [(Pretty s, Pretty s)]
alignedRows
  where
    col0Width :: Width
col0Width = (Width -> Width -> Width) -> Width -> [Width] -> Width
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Width -> Width -> Width
forall a. Ord a => a -> a -> a
max Width
0 [Pretty s -> Width
forall s. Pretty s -> Width
preferredWidth Pretty s
col1 | (Pretty s
col1, Just Pretty s
_) <- [(Pretty s, Maybe (Pretty s))]
rows] Width -> Width -> Width
forall a. Num a => a -> a -> a
+ Width
1
    alignedRows :: [(Pretty s, Pretty s)]
alignedRows =
      [ case Maybe (Pretty s)
col1 of
          Just Pretty s
s -> (Width -> Pretty s -> Pretty s
forall s. IsString s => Width -> Pretty s -> Pretty s
rightPad Width
col0Width Pretty s
col0, Width -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
indentNAfterNewline Width
col0Width Pretty s
s)
          Maybe (Pretty s)
Nothing -> (Pretty s
col0, Pretty s
forall a. Monoid a => a
mempty)
        | (Pretty s
col0, Maybe (Pretty s)
col1) <- [(Pretty s, Maybe (Pretty s))]
rows
      ]

text :: (IsString s) => Text -> Pretty s
text :: forall s. IsString s => Text -> Pretty s
text Text
t = String -> Pretty s
forall a. IsString a => String -> a
fromString (Text -> String
Text.unpack Text
t)

num :: (Show n, Num n, IsString s) => n -> Pretty s
num :: forall n s. (Show n, Num n, IsString s) => n -> Pretty s
num n
n = String -> Pretty s
forall a. IsString a => String -> a
fromString (n -> String
forall a. Show a => a -> String
show n
n)

string :: (IsString s) => String -> Pretty s
string :: forall s. IsString s => String -> Pretty s
string = String -> Pretty s
forall a. IsString a => String -> a
fromString

shown :: (Show a, IsString s) => a -> Pretty s
shown :: forall a s. (Show a, IsString s) => a -> Pretty s
shown = String -> Pretty s
forall a. IsString a => String -> a
fromString (String -> Pretty s) -> (a -> String) -> a -> Pretty s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | Like 'shown', but uses a pretty layout (so long as the Show instance is derived).
pshown :: (Show a, IsString s) => a -> Pretty s
pshown :: forall a s. (Show a, IsString s) => a -> Pretty s
pshown = Text -> Pretty s
forall s. IsString s => Text -> Pretty s
text (Text -> Pretty s) -> (a -> Text) -> a -> Pretty s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.Lazy.toStrict (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. Show a => a -> Text
pShow

-- `softHang foo bar` will attempt to put the first line of `bar` right after
-- `foo` on the same line, but will behave like `hang foo bar` if there's not
-- enough horizontal space.
--
-- Used for example to allow the `let` keyword to appear on the same line as
-- an equals sign.
--
-- myDef x = 'let
--   y = f x
--   g y
--
-- But if the name is too long, the `'let` is allowed to float to the next line:
--
-- myLongDef x =
--   'let
--     y = f x
--     g y
--
-- To do this, we'd use `softHang "=" "'let" <> newline <> ...`
--
softHang ::
  (LL.ListLike s Char, IsString s) =>
  Pretty s ->
  Pretty s ->
  Pretty s
softHang :: forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
softHang Pretty s
from = Pretty s -> Pretty s -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s -> Pretty s
softHang' Pretty s
from Pretty s
"  "

-- `softHang' by foo bar` will attempt to put `bar` right after `foo` on the same
-- line, but will behave like `hang by foo bar` if there's not enough horizontal
-- space for both `foo` and `bar`.
softHang' ::
  (LL.ListLike s Char, IsString s) =>
  Pretty s ->
  Pretty s ->
  Pretty s ->
  Pretty s
softHang' :: forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s -> Pretty s
softHang' Pretty s
from Pretty s
by Pretty s
p =
  Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
group (Pretty s -> Pretty s) -> Pretty s -> Pretty s
forall a b. (a -> b) -> a -> b
$
    (Pretty s
from Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
" " Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
group Pretty s
p) Pretty s -> Pretty s -> Pretty s
forall s. Pretty s -> Pretty s -> Pretty s
`orElse` (Pretty s
from Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
"\n" Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
group (Pretty s -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
indent Pretty s
by Pretty s
p))

softHangNoSpace' ::
  (LL.ListLike s Char, IsString s) =>
  Pretty s ->
  Pretty s ->
  Pretty s ->
  Pretty s
softHangNoSpace' :: forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s -> Pretty s
softHangNoSpace' Pretty s
from Pretty s
by Pretty s
p =
  Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
group (Pretty s -> Pretty s) -> Pretty s -> Pretty s
forall a b. (a -> b) -> a -> b
$ (Pretty s
from Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
group Pretty s
p) Pretty s -> Pretty s -> Pretty s
forall s. Pretty s -> Pretty s -> Pretty s
`orElse` (Pretty s
from Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
"\n" Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
group (Pretty s -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
indent Pretty s
by Pretty s
p))

-- Same as `hang`, except instead of indenting by two spaces, it indents by
-- the `by` argument.
hang' ::
  (LL.ListLike s Char, IsString s) =>
  Pretty s ->
  Pretty s ->
  Pretty s ->
  Pretty s
hang' :: forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s -> Pretty s
hang' Pretty s
from Pretty s
by Pretty s
p =
  Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
group (Pretty s -> Pretty s) -> Pretty s -> Pretty s
forall a b. (a -> b) -> a -> b
$
    if Pretty s -> Bool
forall s. Pretty s -> Bool
isMultiLine Pretty s
p
      then Pretty s
from Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
"\n" Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
group (Pretty s -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
indent Pretty s
by Pretty s
p)
      else Pretty s -> Pretty s -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s -> Pretty s
softHang' Pretty s
from Pretty s
by Pretty s
p

-- Indents its argument by two spaces, following `from`, so that the text
-- seems to "hang" from it.
--
-- For example, `hang "foo" ("bar" <> newline <> "baz")` results in:
--
-- foo
--   bar
--   baz
--
-- If the argument spans multiple lines, `hang` will always put it on the
-- next line. But if it's only a single line, `hang` will attempt to fit it
-- on the same line as `from`.
--
-- For example, `hang "foo" "bar"`:
--
-- foo bar
--
hang :: (LL.ListLike s Char, IsString s) => Pretty s -> Pretty s -> Pretty s
hang :: forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
hang Pretty s
from = Pretty s -> Pretty s -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s -> Pretty s
hang' Pretty s
from Pretty s
"  "

hangUngrouped' ::
  (LL.ListLike s Char, IsString s) =>
  Pretty s ->
  Pretty s ->
  Pretty s ->
  Pretty s
hangUngrouped' :: forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s -> Pretty s
hangUngrouped' Pretty s
from Pretty s
by Pretty s
p =
  if Pretty s -> Bool
forall s. Pretty s -> Bool
isMultiLine Pretty s
p
    then Pretty s
from Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
"\n" Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
indent Pretty s
by Pretty s
p
    else (Pretty s
from Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
" " Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
p) Pretty s -> Pretty s -> Pretty s
forall s. Pretty s -> Pretty s -> Pretty s
`orElse` (Pretty s
from Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
"\n" Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
indent Pretty s
by Pretty s
p)

hangUngrouped ::
  (LL.ListLike s Char, IsString s) => Pretty s -> Pretty s -> Pretty s
hangUngrouped :: forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
hangUngrouped Pretty s
from = Pretty s -> Pretty s -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s -> Pretty s
hangUngrouped' Pretty s
from Pretty s
"  "

nest :: (LL.ListLike s Char, IsString s) => Pretty s -> Pretty s -> Pretty s
nest :: forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
nest = Pretty s -> Pretty s -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s -> Pretty s
hang' Pretty s
""

indent :: (LL.ListLike s Char, IsString s) => Pretty s -> Pretty s -> Pretty s
indent :: forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
indent Pretty s
by Pretty s
p = Pretty s
by Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
indentAfterNewline Pretty s
by Pretty s
p

indentN :: (LL.ListLike s Char, IsString s) => Width -> Pretty s -> Pretty s
indentN :: forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
indentN Width
by = Pretty s -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
indent (String -> Pretty s
forall a. IsString a => String -> a
fromString (String -> Pretty s) -> String -> Pretty s
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Width -> Int
widthToInt Width
by) Char
' ')

indentNonEmptyN ::
  (LL.ListLike s Char, IsString s) => Width -> Pretty s -> Pretty s
indentNonEmptyN :: forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
indentNonEmptyN Width
_ (Pretty s -> F s (Pretty s)
forall s. Pretty s -> F s (Pretty s)
out -> F s (Pretty s)
Empty) = Pretty s
forall a. Monoid a => a
mempty
indentNonEmptyN Width
by Pretty s
p = Width -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
indentN Width
by Pretty s
p

indentNAfterNewline ::
  (LL.ListLike s Char, IsString s) => Width -> Pretty s -> Pretty s
indentNAfterNewline :: forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
indentNAfterNewline Width
by =
  Pretty s -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
indentAfterNewline (String -> Pretty s
forall a. IsString a => String -> a
fromString (String -> Pretty s) -> String -> Pretty s
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Width -> Int
widthToInt Width
by) Char
' ')

indentAfterNewline ::
  (LL.ListLike s Char, IsString s) => Pretty s -> Pretty s -> Pretty s
indentAfterNewline :: forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
indentAfterNewline Pretty s
by = (s -> Pretty s) -> Pretty s -> Pretty s
forall s s2. (s -> Pretty s2) -> Pretty s -> Pretty s2
flatMap s -> Pretty s
f
  where
    f :: s -> Pretty s
f s
s0 = case (Char -> Bool) -> s -> (s, s)
forall full item.
ListLike full item =>
(item -> Bool) -> full -> (full, full)
LL.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') s
s0 of
      (s
hd, s
s) ->
        if s -> Bool
forall full item. ListLike full item => full -> Bool
LL.null s
s
          then s -> Pretty s
forall s. (IsString s, ListLike s Char) => s -> Pretty s
lit s
s0
          else -- use `take` and `drop` to preserve annotations or
          -- or other extra info attached to the original `s`
            s -> Pretty s
forall s. (IsString s, ListLike s Char) => s -> Pretty s
lit (Int -> s -> s
forall full item. ListLike full item => Int -> full -> full
LL.take (s -> Int
forall full item. ListLike full item => full -> Int
LL.length s
hd) s
s0) Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
"\n" Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
by Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> s -> Pretty s
f (Int -> s -> s
forall full item. ListLike full item => Int -> full -> full
LL.drop Int
1 s
s)

instance (IsString s) => IsString (Pretty s) where
  fromString :: String -> Pretty s
fromString String
s = Delta -> s -> Pretty s
forall s. Delta -> s -> Pretty s
lit' ((Char -> Delta) -> String -> Delta
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Char -> Delta
chDelta String
s) (String -> s
forall a. IsString a => String -> a
fromString String
s)

instance Semigroup (Pretty s) where
  Pretty s
p1 <> :: Pretty s -> Pretty s -> Pretty s
<> Pretty s
p2 = Delta -> F s (Pretty s) -> Pretty s
forall s. Delta -> F s (Pretty s) -> Pretty s
Pretty (Pretty s -> Delta
forall s. Pretty s -> Delta
delta Pretty s
p1 Delta -> Delta -> Delta
forall a. Semigroup a => a -> a -> a
<> Pretty s -> Delta
forall s. Pretty s -> Delta
delta Pretty s
p2)
    (F s (Pretty s) -> Pretty s)
-> (Seq (Pretty s) -> F s (Pretty s)) -> Seq (Pretty s) -> Pretty s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (Pretty s) -> F s (Pretty s)
forall s r. Seq r -> F s r
Append
    (Seq (Pretty s) -> Pretty s) -> Seq (Pretty s) -> Pretty s
forall a b. (a -> b) -> a -> b
$ case (Pretty s -> F s (Pretty s)
forall s. Pretty s -> F s (Pretty s)
out Pretty s
p1, Pretty s -> F s (Pretty s)
forall s. Pretty s -> F s (Pretty s)
out Pretty s
p2) of
      (Append Seq (Pretty s)
ps1, Append Seq (Pretty s)
ps2) -> Seq (Pretty s)
ps1 Seq (Pretty s) -> Seq (Pretty s) -> Seq (Pretty s)
forall a. Semigroup a => a -> a -> a
<> Seq (Pretty s)
ps2
      (Append Seq (Pretty s)
ps1, F s (Pretty s)
_) -> Seq (Pretty s)
ps1 Seq (Pretty s) -> Seq (Pretty s) -> Seq (Pretty s)
forall a. Semigroup a => a -> a -> a
<> Pretty s -> Seq (Pretty s)
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty s
p2
      (F s (Pretty s)
_, Append Seq (Pretty s)
ps2) -> Pretty s -> Seq (Pretty s)
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty s
p1 Seq (Pretty s) -> Seq (Pretty s) -> Seq (Pretty s)
forall a. Semigroup a => a -> a -> a
<> Seq (Pretty s)
ps2
      (F s (Pretty s)
_, F s (Pretty s)
_) -> Pretty s -> Seq (Pretty s)
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty s
p1 Seq (Pretty s) -> Seq (Pretty s) -> Seq (Pretty s)
forall a. Semigroup a => a -> a -> a
<> Pretty s -> Seq (Pretty s)
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty s
p2

instance Monoid (Pretty s) where
  mempty :: Pretty s
mempty = Delta -> F s (Pretty s) -> Pretty s
forall s. Delta -> F s (Pretty s) -> Pretty s
Pretty Delta
forall a. Monoid a => a
mempty F s (Pretty s)
forall s r. F s r
Empty

data Delta
  = -- | The number of columns.
    SingleLine !Width
  | -- | The number of columns in the first, last, and longest lines.
    MultiLine !Width !Width !Width
  deriving stock (Delta -> Delta -> Bool
(Delta -> Delta -> Bool) -> (Delta -> Delta -> Bool) -> Eq Delta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Delta -> Delta -> Bool
== :: Delta -> Delta -> Bool
$c/= :: Delta -> Delta -> Bool
/= :: Delta -> Delta -> Bool
Eq, Eq Delta
Eq Delta =>
(Delta -> Delta -> Ordering)
-> (Delta -> Delta -> Bool)
-> (Delta -> Delta -> Bool)
-> (Delta -> Delta -> Bool)
-> (Delta -> Delta -> Bool)
-> (Delta -> Delta -> Delta)
-> (Delta -> Delta -> Delta)
-> Ord Delta
Delta -> Delta -> Bool
Delta -> Delta -> Ordering
Delta -> Delta -> Delta
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Delta -> Delta -> Ordering
compare :: Delta -> Delta -> Ordering
$c< :: Delta -> Delta -> Bool
< :: Delta -> Delta -> Bool
$c<= :: Delta -> Delta -> Bool
<= :: Delta -> Delta -> Bool
$c> :: Delta -> Delta -> Bool
> :: Delta -> Delta -> Bool
$c>= :: Delta -> Delta -> Bool
>= :: Delta -> Delta -> Bool
$cmax :: Delta -> Delta -> Delta
max :: Delta -> Delta -> Delta
$cmin :: Delta -> Delta -> Delta
min :: Delta -> Delta -> Delta
Ord, Int -> Delta -> ShowS
[Delta] -> ShowS
Delta -> String
(Int -> Delta -> ShowS)
-> (Delta -> String) -> ([Delta] -> ShowS) -> Show Delta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Delta -> ShowS
showsPrec :: Int -> Delta -> ShowS
$cshow :: Delta -> String
show :: Delta -> String
$cshowList :: [Delta] -> ShowS
showList :: [Delta] -> ShowS
Show)

instance Semigroup Delta where
  SingleLine Width
c <> :: Delta -> Delta -> Delta
<> SingleLine Width
c2 = Width -> Delta
SingleLine (Width
c Width -> Width -> Width
forall a. Num a => a -> a -> a
+ Width
c2)
  SingleLine Width
c <> MultiLine Width
fc Width
lc Width
mc =
    let fc' :: Width
fc' = Width
c Width -> Width -> Width
forall a. Num a => a -> a -> a
+ Width
fc
     in Width -> Width -> Width -> Delta
MultiLine Width
fc' Width
lc (Width -> Width -> Width
forall a. Ord a => a -> a -> a
max Width
fc' Width
mc)
  MultiLine Width
fc Width
lc Width
mc <> SingleLine Width
c =
    let lc' :: Width
lc' = Width
lc Width -> Width -> Width
forall a. Num a => a -> a -> a
+ Width
c
     in Width -> Width -> Width -> Delta
MultiLine Width
fc Width
lc' (Width -> Width -> Width
forall a. Ord a => a -> a -> a
max Width
lc' Width
mc)
  MultiLine Width
fc Width
lc Width
mc <> MultiLine Width
fc2 Width
lc2 Width
mc2 =
    Width -> Width -> Width -> Delta
MultiLine Width
fc Width
lc2 (Width -> Width -> Width
forall a. Ord a => a -> a -> a
max Width
mc (Width -> Width -> Width
forall a. Ord a => a -> a -> a
max Width
mc2 (Width
lc Width -> Width -> Width
forall a. Num a => a -> a -> a
+ Width
fc2)))

instance Monoid Delta where
  mempty :: Delta
mempty = Width -> Delta
SingleLine Width
0

maxCol :: Delta -> Width
maxCol :: Delta -> Width
maxCol = \case
  SingleLine Width
c -> Width
c
  MultiLine Width
_ Width
_ Width
c -> Width
c

lastCol :: Delta -> Width
lastCol :: Delta -> Width
lastCol = \case
  SingleLine Width
c -> Width
c
  MultiLine Width
_ Width
c Width
_ -> Width
c

chDelta :: Char -> Delta
chDelta :: Char -> Delta
chDelta Char
'\n' = Width -> Width -> Width -> Delta
MultiLine Width
0 Width
0 Width
0
chDelta Char
_ = Width -> Delta
SingleLine Width
1

preferredWidth :: Pretty s -> Width
preferredWidth :: forall s. Pretty s -> Width
preferredWidth Pretty s
p = Delta -> Width
lastCol (Pretty s -> Delta
forall s. Pretty s -> Delta
delta Pretty s
p)

isMultiLine :: Pretty s -> Bool
isMultiLine :: forall s. Pretty s -> Bool
isMultiLine Pretty s
p =
  case Pretty s -> Delta
forall s. Pretty s -> Delta
delta Pretty s
p of
    SingleLine {} -> Bool
False
    MultiLine {} -> Bool
True

black,
  red,
  green,
  yellow,
  blue,
  purple,
  cyan,
  white,
  hiBlack,
  hiRed,
  hiGreen,
  hiYellow,
  hiBlue,
  hiPurple,
  hiCyan,
  hiWhite,
  bold,
  underline ::
    Pretty CT.ColorText -> Pretty CT.ColorText
black :: Pretty ColorText -> Pretty ColorText
black = (ColorText -> ColorText) -> Pretty ColorText -> Pretty ColorText
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map ColorText -> ColorText
CT.black
red :: Pretty ColorText -> Pretty ColorText
red = (ColorText -> ColorText) -> Pretty ColorText -> Pretty ColorText
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map ColorText -> ColorText
CT.red
green :: Pretty ColorText -> Pretty ColorText
green = (ColorText -> ColorText) -> Pretty ColorText -> Pretty ColorText
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map ColorText -> ColorText
CT.green
yellow :: Pretty ColorText -> Pretty ColorText
yellow = (ColorText -> ColorText) -> Pretty ColorText -> Pretty ColorText
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map ColorText -> ColorText
CT.yellow
blue :: Pretty ColorText -> Pretty ColorText
blue = (ColorText -> ColorText) -> Pretty ColorText -> Pretty ColorText
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map ColorText -> ColorText
CT.blue
purple :: Pretty ColorText -> Pretty ColorText
purple = (ColorText -> ColorText) -> Pretty ColorText -> Pretty ColorText
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map ColorText -> ColorText
CT.purple
cyan :: Pretty ColorText -> Pretty ColorText
cyan = (ColorText -> ColorText) -> Pretty ColorText -> Pretty ColorText
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map ColorText -> ColorText
CT.cyan
white :: Pretty ColorText -> Pretty ColorText
white = (ColorText -> ColorText) -> Pretty ColorText -> Pretty ColorText
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map ColorText -> ColorText
CT.white
hiBlack :: Pretty ColorText -> Pretty ColorText
hiBlack = (ColorText -> ColorText) -> Pretty ColorText -> Pretty ColorText
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map ColorText -> ColorText
CT.hiBlack
hiRed :: Pretty ColorText -> Pretty ColorText
hiRed = (ColorText -> ColorText) -> Pretty ColorText -> Pretty ColorText
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map ColorText -> ColorText
CT.hiRed
hiGreen :: Pretty ColorText -> Pretty ColorText
hiGreen = (ColorText -> ColorText) -> Pretty ColorText -> Pretty ColorText
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map ColorText -> ColorText
CT.hiGreen
hiYellow :: Pretty ColorText -> Pretty ColorText
hiYellow = (ColorText -> ColorText) -> Pretty ColorText -> Pretty ColorText
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map ColorText -> ColorText
CT.hiYellow
hiBlue :: Pretty ColorText -> Pretty ColorText
hiBlue = (ColorText -> ColorText) -> Pretty ColorText -> Pretty ColorText
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map ColorText -> ColorText
CT.hiBlue
hiPurple :: Pretty ColorText -> Pretty ColorText
hiPurple = (ColorText -> ColorText) -> Pretty ColorText -> Pretty ColorText
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map ColorText -> ColorText
CT.hiPurple
hiCyan :: Pretty ColorText -> Pretty ColorText
hiCyan = (ColorText -> ColorText) -> Pretty ColorText -> Pretty ColorText
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map ColorText -> ColorText
CT.hiCyan
hiWhite :: Pretty ColorText -> Pretty ColorText
hiWhite = (ColorText -> ColorText) -> Pretty ColorText -> Pretty ColorText
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map ColorText -> ColorText
CT.hiWhite
bold :: Pretty ColorText -> Pretty ColorText
bold = (ColorText -> ColorText) -> Pretty ColorText -> Pretty ColorText
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map ColorText -> ColorText
CT.bold
underline :: Pretty ColorText -> Pretty ColorText
underline = (ColorText -> ColorText) -> Pretty ColorText -> Pretty ColorText
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map ColorText -> ColorText
CT.underline

-- invert the foreground and background colors
invert :: Pretty CT.ColorText -> Pretty CT.ColorText
invert :: Pretty ColorText -> Pretty ColorText
invert = (ColorText -> ColorText) -> Pretty ColorText -> Pretty ColorText
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map ColorText -> ColorText
CT.invert

-- set the background color, ex: `background hiBlue`, `background yellow`
background :: (Pretty CT.ColorText -> Pretty CT.ColorText) -> Pretty CT.ColorText -> Pretty CT.ColorText
background :: (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
background Pretty ColorText -> Pretty ColorText
f Pretty ColorText
p =
  -- hack: discover the color of `f` by calling it on a dummy string
  case Pretty ColorText -> Pretty ColorText
f (Delta -> F ColorText (Pretty ColorText) -> Pretty ColorText
forall s. Delta -> F s (Pretty s) -> Pretty s
Pretty Delta
forall a. Monoid a => a
mempty (ColorText -> F ColorText (Pretty ColorText)
forall s r. s -> F s r
Lit ColorText
"-")) of
    Pretty Delta
_ (Lit (AT.AnnotatedText (Seq (Segment Color) -> [Segment Color]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList -> [AT.Segment String
_ (Just Color
c)]))) -> (ColorText -> ColorText) -> Pretty ColorText -> Pretty ColorText
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map (Color -> ColorText -> ColorText
CT.background Color
c) Pretty ColorText
p
    Pretty ColorText
_ -> Pretty ColorText
p

plural ::
  (Foldable f) =>
  f a ->
  Pretty ColorText ->
  Pretty ColorText
plural :: forall (f :: * -> *) a.
Foldable f =>
f a -> Pretty ColorText -> Pretty ColorText
plural f a
f Pretty ColorText
p = case f a -> Int
forall a. f a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length f a
f of
  Int
0 -> Pretty ColorText
forall a. Monoid a => a
mempty
  Int
1 -> Pretty ColorText
p
  -- todo: consider use of plural package
  Int
_ ->
    Pretty ColorText
p Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> case ShowS
forall a. [a] -> [a]
reverse (Pretty ColorText -> String
toPlainUnbroken Pretty ColorText
p) of
      Char
's' : String
_ -> Pretty ColorText
"es"
      String
_ -> Pretty ColorText
"s"

border :: (LL.ListLike s Char, IsString s) => Width -> Pretty s -> Pretty s
border :: forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
border Width
n Pretty s
p = Pretty s
"\n" Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
indentN Width
n Pretty s
p Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
"\n"

callout :: (LL.ListLike s Char, IsString s) => Pretty s -> Pretty s -> Pretty s
callout :: forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
callout Pretty s
header Pretty s
p = Pretty s
header Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
"\n\n" Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
p

bracket :: (LL.ListLike s Char, IsString s) => Pretty s -> Pretty s
bracket :: forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
bracket = Pretty s -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
indent Pretty s
"  "

boxForkLeft,
  boxLeft,
  boxRight ::
    forall s. (LL.ListLike s Char, IsString s) => [Pretty s] -> [Pretty s]
boxForkLeft :: forall s. (ListLike s Char, IsString s) => [Pretty s] -> [Pretty s]
boxForkLeft = BoxStyle s -> [Pretty s] -> [Pretty s]
forall s.
(ListLike s Char, IsString s) =>
BoxStyle s -> [Pretty s] -> [Pretty s]
boxLeft' BoxStyle s
forall s. IsString s => BoxStyle s
lBoxStyle1
boxLeft :: forall s. (ListLike s Char, IsString s) => [Pretty s] -> [Pretty s]
boxLeft = BoxStyle s -> [Pretty s] -> [Pretty s]
forall s.
(ListLike s Char, IsString s) =>
BoxStyle s -> [Pretty s] -> [Pretty s]
boxLeft' BoxStyle s
forall s. IsString s => BoxStyle s
lBoxStyle2
boxRight :: forall s. (ListLike s Char, IsString s) => [Pretty s] -> [Pretty s]
boxRight = BoxStyle s -> [Pretty s] -> [Pretty s]
forall s.
(ListLike s Char, IsString s) =>
BoxStyle s -> [Pretty s] -> [Pretty s]
boxRight' BoxStyle s
forall s. IsString s => BoxStyle s
rBoxStyle2

boxLeft',
  boxRight' ::
    (LL.ListLike s Char, IsString s) =>
    BoxStyle s ->
    [Pretty s] ->
    [Pretty s]
boxLeft' :: forall s.
(ListLike s Char, IsString s) =>
BoxStyle s -> [Pretty s] -> [Pretty s]
boxLeft' BoxStyle s
style = (Identity (Pretty s) -> Pretty s)
-> [Identity (Pretty s)] -> [Pretty s]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identity (Pretty s) -> Pretty s
forall a. Identity a -> a
runIdentity ([Identity (Pretty s)] -> [Pretty s])
-> ([Pretty s] -> [Identity (Pretty s)])
-> [Pretty s]
-> [Pretty s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoxStyle s -> [Identity (Pretty s)] -> [Identity (Pretty s)]
forall (m :: * -> *) s.
(Monad m, ListLike s Char, IsString s) =>
BoxStyle s -> [m (Pretty s)] -> [m (Pretty s)]
boxLeftM' BoxStyle s
style ([Identity (Pretty s)] -> [Identity (Pretty s)])
-> ([Pretty s] -> [Identity (Pretty s)])
-> [Pretty s]
-> [Identity (Pretty s)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pretty s -> Identity (Pretty s))
-> [Pretty s] -> [Identity (Pretty s)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pretty s -> Identity (Pretty s)
forall a. a -> Identity a
Identity
boxRight' :: forall s.
(ListLike s Char, IsString s) =>
BoxStyle s -> [Pretty s] -> [Pretty s]
boxRight' BoxStyle s
style = (Identity (Pretty s) -> Pretty s)
-> [Identity (Pretty s)] -> [Pretty s]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identity (Pretty s) -> Pretty s
forall a. Identity a -> a
runIdentity ([Identity (Pretty s)] -> [Pretty s])
-> ([Pretty s] -> [Identity (Pretty s)])
-> [Pretty s]
-> [Pretty s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoxStyle s -> [Identity (Pretty s)] -> [Identity (Pretty s)]
forall (m :: * -> *) s.
(Monad m, ListLike s Char, IsString s) =>
BoxStyle s -> [m (Pretty s)] -> [m (Pretty s)]
boxRightM' BoxStyle s
style ([Identity (Pretty s)] -> [Identity (Pretty s)])
-> ([Pretty s] -> [Identity (Pretty s)])
-> [Pretty s]
-> [Identity (Pretty s)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pretty s -> Identity (Pretty s))
-> [Pretty s] -> [Identity (Pretty s)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pretty s -> Identity (Pretty s)
forall a. a -> Identity a
Identity

type BoxStyle s =
  ( (Pretty s, Pretty s), -- first (start, continue)
    (Pretty s, Pretty s), -- middle
    (Pretty s, Pretty s), -- last
    (Pretty s, Pretty s) -- singleton
  )

lBoxStyle1, lBoxStyle2, rBoxStyle2 :: (IsString s) => BoxStyle s
lBoxStyle1 :: forall s. IsString s => BoxStyle s
lBoxStyle1 =
  ( (Pretty s
"┌ ", Pretty s
"│ "), -- first
    (Pretty s
"├ ", Pretty s
"│ "), -- middle
    (Pretty s
"└ ", Pretty s
"  "), -- last
    (Pretty s
"", Pretty s
"") -- singleton
  )
lBoxStyle2 :: forall s. IsString s => BoxStyle s
lBoxStyle2 =
  ( (Pretty s
"┌ ", Pretty s
"  "),
    (Pretty s
"│ ", Pretty s
"  "),
    (Pretty s
"└ ", Pretty s
"  "),
    (Pretty s
"", Pretty s
"")
  )
rBoxStyle2 :: forall s. IsString s => BoxStyle s
rBoxStyle2 =
  ( (Pretty s
" ┐", Pretty s
" │"),
    (Pretty s
" │", Pretty s
" │"),
    (Pretty s
" ┘", Pretty s
"  "),
    (Pretty s
"  ", Pretty s
"  ")
  )

boxLeftM,
  boxRightM ::
    forall m s.
    (Monad m, LL.ListLike s Char, IsString s) =>
    [m (Pretty s)] ->
    [m (Pretty s)]
boxLeftM :: forall (m :: * -> *) s.
(Monad m, ListLike s Char, IsString s) =>
[m (Pretty s)] -> [m (Pretty s)]
boxLeftM = BoxStyle s -> [m (Pretty s)] -> [m (Pretty s)]
forall (m :: * -> *) s.
(Monad m, ListLike s Char, IsString s) =>
BoxStyle s -> [m (Pretty s)] -> [m (Pretty s)]
boxLeftM' BoxStyle s
forall s. IsString s => BoxStyle s
lBoxStyle2
boxRightM :: forall (m :: * -> *) s.
(Monad m, ListLike s Char, IsString s) =>
[m (Pretty s)] -> [m (Pretty s)]
boxRightM = BoxStyle s -> [m (Pretty s)] -> [m (Pretty s)]
forall (m :: * -> *) s.
(Monad m, ListLike s Char, IsString s) =>
BoxStyle s -> [m (Pretty s)] -> [m (Pretty s)]
boxRightM' BoxStyle s
forall s. IsString s => BoxStyle s
rBoxStyle2

boxLeftM' ::
  forall m s.
  (Monad m, LL.ListLike s Char, IsString s) =>
  BoxStyle s ->
  [m (Pretty s)] ->
  [m (Pretty s)]
boxLeftM' :: forall (m :: * -> *) s.
(Monad m, ListLike s Char, IsString s) =>
BoxStyle s -> [m (Pretty s)] -> [m (Pretty s)]
boxLeftM' ((Pretty s, Pretty s)
first, (Pretty s, Pretty s)
middle, (Pretty s, Pretty s)
last, (Pretty s, Pretty s)
singleton) [m (Pretty s)]
ps = Seq (m (Pretty s)) -> [m (Pretty s)]
forall {f :: * -> *}.
Functor f =>
Seq (f (Pretty s)) -> [f (Pretty s)]
go ([m (Pretty s)] -> Seq (m (Pretty s))
forall a. [a] -> Seq a
Seq.fromList [m (Pretty s)]
ps)
  where
    go :: Seq (f (Pretty s)) -> [f (Pretty s)]
go Seq (f (Pretty s))
Seq.Empty = []
    go (f (Pretty s)
p Seq.:<| Seq (f (Pretty s))
Seq.Empty) = [(Pretty s, Pretty s) -> Pretty s -> Pretty s
forall {s}.
(Item s ~ Char, ListLike s Char, IsString s) =>
(Pretty s, Pretty s) -> Pretty s -> Pretty s
decorate (Pretty s, Pretty s)
singleton (Pretty s -> Pretty s) -> f (Pretty s) -> f (Pretty s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Pretty s)
p]
    go (f (Pretty s)
a Seq.:<| (Seq (f (Pretty s))
mid Seq.:|> f (Pretty s)
b)) =
      [(Pretty s, Pretty s) -> Pretty s -> Pretty s
forall {s}.
(Item s ~ Char, ListLike s Char, IsString s) =>
(Pretty s, Pretty s) -> Pretty s -> Pretty s
decorate (Pretty s, Pretty s)
first (Pretty s -> Pretty s) -> f (Pretty s) -> f (Pretty s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Pretty s)
a]
        [f (Pretty s)] -> [f (Pretty s)] -> [f (Pretty s)]
forall a. [a] -> [a] -> [a]
++ Seq (f (Pretty s)) -> [f (Pretty s)]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ((Pretty s -> Pretty s) -> f (Pretty s) -> f (Pretty s)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Pretty s, Pretty s) -> Pretty s -> Pretty s
forall {s}.
(Item s ~ Char, ListLike s Char, IsString s) =>
(Pretty s, Pretty s) -> Pretty s -> Pretty s
decorate (Pretty s, Pretty s)
middle) (f (Pretty s) -> f (Pretty s))
-> Seq (f (Pretty s)) -> Seq (f (Pretty s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (f (Pretty s))
mid)
        [f (Pretty s)] -> [f (Pretty s)] -> [f (Pretty s)]
forall a. [a] -> [a] -> [a]
++ [(Pretty s, Pretty s) -> Pretty s -> Pretty s
forall {s}.
(Item s ~ Char, ListLike s Char, IsString s) =>
(Pretty s, Pretty s) -> Pretty s -> Pretty s
decorate (Pretty s, Pretty s)
last (Pretty s -> Pretty s) -> f (Pretty s) -> f (Pretty s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Pretty s)
b]
    decorate :: (Pretty s, Pretty s) -> Pretty s -> Pretty s
decorate (Pretty s
first, Pretty s
mid) Pretty s
p = Pretty s
first Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
indentAfterNewline Pretty s
mid Pretty s
p

-- this implementation doesn't work for multi-line inputs,
-- because i dunno how to inspect multi-line inputs

boxRightM' ::
  forall m s.
  (Monad m, LL.ListLike s Char, IsString s) =>
  BoxStyle s ->
  [m (Pretty s)] ->
  [m (Pretty s)]
boxRightM' :: forall (m :: * -> *) s.
(Monad m, ListLike s Char, IsString s) =>
BoxStyle s -> [m (Pretty s)] -> [m (Pretty s)]
boxRightM' ((Pretty s, Pretty s)
first, (Pretty s, Pretty s)
middle, (Pretty s, Pretty s)
last, (Pretty s, Pretty s)
singleton) [m (Pretty s)]
ps = Seq (m (Pretty s)) -> [m (Pretty s)]
go ([m (Pretty s)] -> Seq (m (Pretty s))
forall a. [a] -> Seq a
Seq.fromList [m (Pretty s)]
ps)
  where
    go :: Seq.Seq (m (Pretty s)) -> [m (Pretty s)]
    go :: Seq (m (Pretty s)) -> [m (Pretty s)]
go Seq (m (Pretty s))
Seq.Empty = []
    go (m (Pretty s)
p Seq.:<| Seq (m (Pretty s))
Seq.Empty) = [(Pretty s, Pretty s) -> Pretty s -> Pretty s
forall {a} {b}. Semigroup a => (a, b) -> a -> a
decorate (Pretty s, Pretty s)
singleton (Pretty s -> Pretty s) -> m (Pretty s) -> m (Pretty s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Pretty s)
p]
    go (m (Pretty s)
a Seq.:<| (Seq (m (Pretty s))
mid Seq.:|> m (Pretty s)
b)) =
      [(Pretty s, Pretty s) -> Pretty s -> Pretty s
forall {a} {b}. Semigroup a => (a, b) -> a -> a
decorate (Pretty s, Pretty s)
first (Pretty s -> Pretty s) -> m (Pretty s) -> m (Pretty s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Pretty s)
a]
        [m (Pretty s)] -> [m (Pretty s)] -> [m (Pretty s)]
forall a. [a] -> [a] -> [a]
++ Seq (m (Pretty s)) -> [m (Pretty s)]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ((Pretty s -> Pretty s) -> m (Pretty s) -> m (Pretty s)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Pretty s, Pretty s) -> Pretty s -> Pretty s
forall {a} {b}. Semigroup a => (a, b) -> a -> a
decorate (Pretty s, Pretty s)
middle) (m (Pretty s) -> m (Pretty s))
-> Seq (m (Pretty s)) -> Seq (m (Pretty s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (m (Pretty s))
mid)
        [m (Pretty s)] -> [m (Pretty s)] -> [m (Pretty s)]
forall a. [a] -> [a] -> [a]
++ [(Pretty s, Pretty s) -> Pretty s -> Pretty s
forall {a} {b}. Semigroup a => (a, b) -> a -> a
decorate (Pretty s, Pretty s)
last (Pretty s -> Pretty s) -> m (Pretty s) -> m (Pretty s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Pretty s)
b]
    decorate :: (a, b) -> a -> a
decorate (a
first, b
_mid) a
p = a
p a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
first

warnCallout,
  blockedCallout,
  fatalCallout,
  okCallout ::
    (LL.ListLike s Char, IsString s) => Pretty s -> Pretty s
warnCallout :: forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
warnCallout = Pretty s -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
callout Pretty s
"⚠️"
fatalCallout :: forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
fatalCallout = Pretty s -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
callout Pretty s
"❗️"
okCallout :: forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
okCallout = Pretty s -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
callout Pretty s
"✅"
blockedCallout :: forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
blockedCallout = Pretty s -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
callout Pretty s
"🚫"

backticked :: (IsString s) => Pretty s -> Pretty s
backticked :: forall s. IsString s => Pretty s -> Pretty s
backticked Pretty s
p = Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
group (Pretty s
"`" Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
p Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
"`")

-- | Attach some punctuation after the closing backtick.
backticked' :: (IsString s) => Pretty s -> Pretty s -> Pretty s
backticked' :: forall s. IsString s => Pretty s -> Pretty s -> Pretty s
backticked' Pretty s
p Pretty s
end = Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
group (Pretty s
"`" Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
p Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
"`" Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
end)

singleQuoted :: (IsString s) => Pretty s -> Pretty s
singleQuoted :: forall s. IsString s => Pretty s -> Pretty s
singleQuoted Pretty s
p = Pretty s
"'" Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
p Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
"'"

singleQuoted' :: (IsString s) => Pretty s -> Pretty s -> Pretty s
singleQuoted' :: forall s. IsString s => Pretty s -> Pretty s -> Pretty s
singleQuoted' Pretty s
p Pretty s
end = Pretty s
"'" Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
p Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
"'" Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
end

instance (Show s) => Show (Pretty s) where
  show :: Pretty s -> String
show Pretty s
p = Width -> Pretty String -> String
forall s. (Monoid s, IsString s) => Width -> Pretty s -> s
render Width
80 (Pretty s -> Pretty String
forall s. Show s => Pretty s -> Pretty String
metaPretty Pretty s
p)

metaPretty :: (Show s) => Pretty s -> Pretty String
metaPretty :: forall s. Show s => Pretty s -> Pretty String
metaPretty = Int -> Pretty s -> Pretty String
forall {t} {a}.
(Ord t, Num t, Show a) =>
t -> Pretty a -> Pretty String
go (Int
0 :: Int)
  where
    go :: t -> Pretty a -> Pretty String
go t
prec Pretty a
p = case Pretty a -> F a (Pretty a)
forall s. Pretty s -> F s (Pretty s)
out Pretty a
p of
      Lit a
s -> Bool -> Pretty String -> Pretty String
forall s. IsString s => Bool -> Pretty s -> Pretty s
parenthesizeIf (t
prec t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
0) (Pretty String -> Pretty String) -> Pretty String -> Pretty String
forall a b. (a -> b) -> a -> b
$ Pretty String
"Lit" Pretty String -> Pretty String -> Pretty String
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
`hang` String -> Pretty String
forall s. (IsString s, ListLike s Char) => s -> Pretty s
lit (a -> String
forall a. Show a => a -> String
show a
s)
      F a (Pretty a)
Empty -> Pretty String
"Empty"
      Group Pretty a
g -> Bool -> Pretty String -> Pretty String
forall s. IsString s => Bool -> Pretty s -> Pretty s
parenthesizeIf (t
prec t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
0) (Pretty String -> Pretty String) -> Pretty String -> Pretty String
forall a b. (a -> b) -> a -> b
$ Pretty String
"Group" Pretty String -> Pretty String -> Pretty String
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
`hang` t -> Pretty a -> Pretty String
go t
1 Pretty a
g
      Wrap Seq (Pretty a)
s ->
        Bool -> Pretty String -> Pretty String
forall s. IsString s => Bool -> Pretty s -> Pretty s
parenthesizeIf (t
prec t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
0) (Pretty String -> Pretty String) -> Pretty String -> Pretty String
forall a b. (a -> b) -> a -> b
$
          Pretty String
"Wrap"
            Pretty String -> Pretty String -> Pretty String
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
`hang` Pretty String
-> Pretty String -> Seq (Pretty String) -> Pretty String
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> Pretty s -> f (Pretty s) -> Pretty s
surroundCommas Pretty String
"[" Pretty String
"]" (t -> Pretty a -> Pretty String
go t
1 (Pretty a -> Pretty String)
-> Seq (Pretty a) -> Seq (Pretty String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (Pretty a)
s)
      OrElse Pretty a
a Pretty a
b ->
        Bool -> Pretty String -> Pretty String
forall s. IsString s => Bool -> Pretty s -> Pretty s
parenthesizeIf (t
prec t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
0) (Pretty String -> Pretty String) -> Pretty String -> Pretty String
forall a b. (a -> b) -> a -> b
$
          Pretty String
"OrElse" Pretty String -> Pretty String -> Pretty String
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
`hang` [Pretty String] -> Pretty String
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
spaced [t -> Pretty a -> Pretty String
go t
1 Pretty a
a, t -> Pretty a -> Pretty String
go t
1 Pretty a
b]
      Append Seq (Pretty a)
s -> Pretty String
-> Pretty String -> Seq (Pretty String) -> Pretty String
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> Pretty s -> f (Pretty s) -> Pretty s
surroundCommas Pretty String
"[" Pretty String
"]" (t -> Pretty a -> Pretty String
go t
1 (Pretty a -> Pretty String)
-> Seq (Pretty a) -> Seq (Pretty String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (Pretty a)
s)

map :: (LL.ListLike s2 Char) => (s -> s2) -> Pretty s -> Pretty s2
map :: forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map s -> s2
f Pretty s
p = case Pretty s -> F s (Pretty s)
forall s. Pretty s -> F s (Pretty s)
out Pretty s
p of
  Append Seq (Pretty s)
ps -> (Pretty s -> Pretty s2) -> Seq (Pretty s) -> Pretty s2
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((s -> s2) -> Pretty s -> Pretty s2
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map s -> s2
f) Seq (Pretty s)
ps
  F s (Pretty s)
Empty -> Pretty s2
forall a. Monoid a => a
mempty
  Group Pretty s
p -> Pretty s2 -> Pretty s2
forall s. Pretty s -> Pretty s
group ((s -> s2) -> Pretty s -> Pretty s2
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map s -> s2
f Pretty s
p)
  Lit s
s -> Delta -> s2 -> Pretty s2
forall s. Delta -> s -> Pretty s
lit' ((Char -> Delta) -> String -> Delta
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Char -> Delta
chDelta (String -> Delta) -> String -> Delta
forall a b. (a -> b) -> a -> b
$ s2 -> [Item s2]
forall l. IsList l => l -> [Item l]
LL.toList s2
s2) s2
s2 where s2 :: s2
s2 = s -> s2
f s
s
  OrElse Pretty s
p1 Pretty s
p2 -> Pretty s2 -> Pretty s2 -> Pretty s2
forall s. Pretty s -> Pretty s -> Pretty s
orElse ((s -> s2) -> Pretty s -> Pretty s2
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map s -> s2
f Pretty s
p1) ((s -> s2) -> Pretty s -> Pretty s2
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map s -> s2
f Pretty s
p2)
  Wrap Seq (Pretty s)
p -> Seq (Pretty s2) -> Pretty s2
forall s. Seq (Pretty s) -> Pretty s
wrap_ ((s -> s2) -> Pretty s -> Pretty s2
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
map s -> s2
f (Pretty s -> Pretty s2) -> Seq (Pretty s) -> Seq (Pretty s2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (Pretty s)
p)

flatMap :: (s -> Pretty s2) -> Pretty s -> Pretty s2
flatMap :: forall s s2. (s -> Pretty s2) -> Pretty s -> Pretty s2
flatMap s -> Pretty s2
f Pretty s
p = case Pretty s -> F s (Pretty s)
forall s. Pretty s -> F s (Pretty s)
out Pretty s
p of
  Append Seq (Pretty s)
ps -> (Pretty s -> Pretty s2) -> Seq (Pretty s) -> Pretty s2
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((s -> Pretty s2) -> Pretty s -> Pretty s2
forall s s2. (s -> Pretty s2) -> Pretty s -> Pretty s2
flatMap s -> Pretty s2
f) Seq (Pretty s)
ps
  F s (Pretty s)
Empty -> Pretty s2
forall a. Monoid a => a
mempty
  Group Pretty s
p -> Pretty s2 -> Pretty s2
forall s. Pretty s -> Pretty s
group ((s -> Pretty s2) -> Pretty s -> Pretty s2
forall s s2. (s -> Pretty s2) -> Pretty s -> Pretty s2
flatMap s -> Pretty s2
f Pretty s
p)
  Lit s
s -> s -> Pretty s2
f s
s
  OrElse Pretty s
p1 Pretty s
p2 -> Pretty s2 -> Pretty s2 -> Pretty s2
forall s. Pretty s -> Pretty s -> Pretty s
orElse ((s -> Pretty s2) -> Pretty s -> Pretty s2
forall s s2. (s -> Pretty s2) -> Pretty s -> Pretty s2
flatMap s -> Pretty s2
f Pretty s
p1) ((s -> Pretty s2) -> Pretty s -> Pretty s2
forall s s2. (s -> Pretty s2) -> Pretty s -> Pretty s2
flatMap s -> Pretty s2
f Pretty s
p2)
  Wrap Seq (Pretty s)
p -> Seq (Pretty s2) -> Pretty s2
forall s. Seq (Pretty s) -> Pretty s
wrap_ ((s -> Pretty s2) -> Pretty s -> Pretty s2
forall s s2. (s -> Pretty s2) -> Pretty s -> Pretty s2
flatMap s -> Pretty s2
f (Pretty s -> Pretty s2) -> Seq (Pretty s) -> Seq (Pretty s2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (Pretty s)
p)