{-# LANGUAGE FlexibleContexts #-}
{-# language LambdaCase #-}
{-# options_ghc -Wno-unused-imports #-}
{-# options_ghc -Wno-unused-top-binds #-}
module Data.RPTree.Draw (
  -- * CSV
  writeCsv
  -- * GraphViz dot
  , writeDot
  -- , draw
                        )where

import Data.Bifoldable (Bifoldable(..))
import Data.Bifunctor (Bifunctor(..))
import Data.Bitraversable (Bitraversable(..))
import Data.List (intercalate)
import Text.Printf (PrintfArg, printf)

-- boxes
import qualified Text.PrettyPrint.Boxes as B (Box, render, emptyBox, vcat, hcat, text, top, bottom, center1)
-- bytestring
import qualified Data.ByteString.Lazy    as LBS (ByteString, writeFile)
import qualified Data.ByteString.Builder as BSB (Builder, toLazyByteString, string7, charUtf8)
-- containers
import qualified Data.Set as S (Set, insert, fromList)
-- mtl
import Control.Monad.State (MonadState(..), modify)
-- text
import qualified Data.Text.Lazy as TL (Text)
import qualified Data.Text.Lazy.Builder as TLB (Builder, toLazyText, fromString)
import qualified Data.Text.Lazy.IO as TL (writeFile)
-- transformers
import Control.Monad.Trans.State (State, evalState)
-- vector
import qualified Data.Vector as V (Vector, replicateM)
import qualified Data.Vector.Generic as VG (Vector(..), map, sum, unfoldr, unfoldrM, length, replicateM, (!))
import qualified Data.Vector.Unboxed as VU (Unbox)

import Data.RPTree.Internal (RPTree(..), RPT(..), DVector, toListDv)




-- | Encode dataset as CSV and save into file
writeCsv :: (Foldable t, VU.Unbox a, Show a, Show b) =>
            FilePath -- ^ path of output file
         -> t (V.Vector (DVector a, b)) -- ^ data point, label
         -> IO ()
writeCsv :: FilePath -> t (Vector (DVector a, b)) -> IO ()
writeCsv FilePath
fp t (Vector (DVector a, b))
ds = FilePath -> Text -> IO ()
TL.writeFile FilePath
fp (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Builder -> Text
TLB.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ t (Vector (DVector a, b)) -> Builder
forall (t :: * -> *) a b.
(Foldable t, Unbox a, Show a, Show b) =>
t (Vector (DVector a, b)) -> Builder
toCsvV t (Vector (DVector a, b))
ds

toCsvV :: (Foldable t, VU.Unbox a, Show a, Show b) =>
          t (V.Vector (DVector a, b)) -> TLB.Builder
toCsvV :: t (Vector (DVector a, b)) -> Builder
toCsvV = (Vector (DVector a, b) -> Builder)
-> t (Vector (DVector a, b)) -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Vector (DVector a, b)
v -> ((DVector a, b) -> Builder) -> Vector (DVector a, b) -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(DVector a
r, b
i) -> DVector a -> b -> Builder
forall a b. (Show a, Show b, Unbox a) => DVector a -> b -> Builder
toCsvRow DVector a
r b
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
newline ) Vector (DVector a, b)
v)

toCsvRow :: (Show a, Show b, VU.Unbox a) =>
            DVector a
         -> b
         -> TLB.Builder
toCsvRow :: DVector a -> b -> Builder
toCsvRow DVector a
dv b
i = FilePath -> Builder
TLB.fromString (FilePath -> Builder) -> FilePath -> Builder
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"," [a -> FilePath
forall a. Show a => a -> FilePath
show a
x, a -> FilePath
forall a. Show a => a -> FilePath
show a
y, b -> FilePath
forall a. Show a => a -> FilePath
show b
i]
  where
    (a
x:a
y:[a]
_) = DVector a -> [a]
forall a. Unbox a => DVector a -> [a]
toListDv DVector a
dv

newline :: TLB.Builder
newline :: Builder
newline = FilePath -> Builder
TLB.fromString FilePath
"\n"

-- toCsv :: (Foldable t, Show a, Show b, VU.Unbox a) =>
--          t (DVector a, b) -> TLB.Builder
-- toCsv = foldMap (\(r, i) -> toCsvRow r i <> newline )


-- | tree to graphviz dot format
writeDot :: Ord t =>
            (t -> String) -- ^ how to render the node content
         -> FilePath -- ^ path of output file
         -> String -- ^ graph name
         -> RPTree d x t
         -> IO ()
writeDot :: (t -> FilePath) -> FilePath -> FilePath -> RPTree d x t -> IO ()
writeDot t -> FilePath
f FilePath
fp FilePath
name RPTree d x t
tt = FilePath -> Text -> IO ()
TL.writeFile FilePath
fp ((t -> FilePath) -> FilePath -> RPTree d x t -> Text
forall a d x.
Ord a =>
(a -> FilePath) -> FilePath -> RPTree d x a -> Text
toDot t -> FilePath
f FilePath
name RPTree d x t
tt) 

toDot :: Ord a => (a -> String) -> String -> RPTree d x a -> TL.Text
toDot :: (a -> FilePath) -> FilePath -> RPTree d x a -> Text
toDot a -> FilePath
f FilePath
name (RPTree Vector (SVector d)
_ RPT d x a
tt) = Builder -> Text
TLB.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Builder
open Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
close
  where
    x :: Builder
x = (Builder -> G a -> Builder) -> Builder -> Set (G a) -> Builder
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Builder -> G a -> Builder
insf Builder
forall a. Monoid a => a
mempty (Set (G a) -> Builder) -> Set (G a) -> Builder
forall a b. (a -> b) -> a -> b
$ RPT d x a -> Set (G a)
forall a d x. Ord a => RPT d x a -> Set (G a)
toEdges RPT d x a
tt
      where
        insf :: Builder -> G a -> Builder
insf Builder
acc = \case
          Edge Int
i1 Int
i2 ->
            Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Builder
TLB.fromString ([FilePath] -> FilePath
unwords [Int -> FilePath
forall a. Show a => a -> FilePath
show Int
i1, FilePath
"->", Int -> FilePath
forall a. Show a => a -> FilePath
show Int
i2]) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
newline
          Node Int
i a
xs -> Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Builder
TLB.fromString ([FilePath] -> FilePath
unwords [Int -> FilePath
forall a. Show a => a -> FilePath
show Int
i, FilePath
nlab ] ) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
newline
            where
              nlab :: FilePath
nlab = [FilePath] -> FilePath
unwords [FilePath
"[", FilePath
"label=\"", a -> FilePath
f a
xs,FilePath
"\"]"]
          BNode Int
i -> Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Builder
TLB.fromString ([FilePath] -> FilePath
unwords [Int -> FilePath
forall a. Show a => a -> FilePath
show Int
i, FilePath
blab]) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
newline
            where
              blab :: FilePath
blab = [FilePath] -> FilePath
unwords [FilePath
"[", FilePath
"shape=point", FilePath
"]"]
    open :: Builder
open = FilePath -> Builder
TLB.fromString (FilePath -> Builder) -> FilePath -> Builder
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords [FilePath
"digraph" , FilePath
name, FilePath
"{\n"]
    close :: Builder
close = FilePath -> Builder
TLB.fromString FilePath
"}"

data G a = Edge Int Int
         | Node Int a -- tip nodes
         | BNode Int -- branching point nodes
         deriving (G a -> G a -> Bool
(G a -> G a -> Bool) -> (G a -> G a -> Bool) -> Eq (G a)
forall a. Eq a => G a -> G a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: G a -> G a -> Bool
$c/= :: forall a. Eq a => G a -> G a -> Bool
== :: G a -> G a -> Bool
$c== :: forall a. Eq a => G a -> G a -> Bool
Eq, Eq (G a)
Eq (G a)
-> (G a -> G a -> Ordering)
-> (G a -> G a -> Bool)
-> (G a -> G a -> Bool)
-> (G a -> G a -> Bool)
-> (G a -> G a -> Bool)
-> (G a -> G a -> G a)
-> (G a -> G a -> G a)
-> Ord (G a)
G a -> G a -> Bool
G a -> G a -> Ordering
G a -> G a -> G a
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
forall a. Ord a => Eq (G a)
forall a. Ord a => G a -> G a -> Bool
forall a. Ord a => G a -> G a -> Ordering
forall a. Ord a => G a -> G a -> G a
min :: G a -> G a -> G a
$cmin :: forall a. Ord a => G a -> G a -> G a
max :: G a -> G a -> G a
$cmax :: forall a. Ord a => G a -> G a -> G a
>= :: G a -> G a -> Bool
$c>= :: forall a. Ord a => G a -> G a -> Bool
> :: G a -> G a -> Bool
$c> :: forall a. Ord a => G a -> G a -> Bool
<= :: G a -> G a -> Bool
$c<= :: forall a. Ord a => G a -> G a -> Bool
< :: G a -> G a -> Bool
$c< :: forall a. Ord a => G a -> G a -> Bool
compare :: G a -> G a -> Ordering
$ccompare :: forall a. Ord a => G a -> G a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (G a)
Ord, Int -> G a -> ShowS
[G a] -> ShowS
G a -> FilePath
(Int -> G a -> ShowS)
-> (G a -> FilePath) -> ([G a] -> ShowS) -> Show (G a)
forall a. Show a => Int -> G a -> ShowS
forall a. Show a => [G a] -> ShowS
forall a. Show a => G a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [G a] -> ShowS
$cshowList :: forall a. Show a => [G a] -> ShowS
show :: G a -> FilePath
$cshow :: forall a. Show a => G a -> FilePath
showsPrec :: Int -> G a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> G a -> ShowS
Show)


toEdges :: (Ord a) => RPT d x a -> S.Set (G a)
toEdges :: RPT d x a -> Set (G a)
toEdges = [G a] -> Set (G a)
forall a. Ord a => [a] -> Set a
S.fromList ([G a] -> Set (G a))
-> (RPT d x a -> [G a]) -> RPT d x a -> Set (G a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack Int -> [G a] -> RPT d Int a -> [G a]
forall a d. Stack Int -> Stack (G a) -> RPT d Int a -> Stack (G a)
go [] [] (RPT d Int a -> [G a])
-> (RPT d x a -> RPT d Int a) -> RPT d x a -> [G a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RPT d x a -> RPT d Int a
forall (t :: * -> * -> *) x d. Bitraversable t => t x d -> t Int d
labelBranches
  where
    go :: Stack Int -> Stack (G a) -> RPT d Int a -> Stack (G a)
go Stack Int
s Stack (G a)
acc = \case
      Tip Int
i1 a
x ->
        let
          n :: G a
n = Int -> a -> G a
forall a. Int -> a -> G a
Node Int
i1 a
x
          acc' :: Stack (G a)
acc' = G a -> Stack (G a) -> Stack (G a)
forall a. a -> Stack a -> Stack a
push G a
n Stack (G a)
acc
          acc'' :: Stack (G a)
acc'' = Stack (G a) -> (Int -> Stack (G a)) -> Maybe Int -> Stack (G a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Stack (G a)
acc' (\Int
i0 -> G a -> Stack (G a) -> Stack (G a)
forall a. a -> Stack a -> Stack a
push (Int -> Int -> G a
forall a. Int -> Int -> G a
Edge Int
i0 Int
i1) Stack (G a)
acc') (Stack Int -> Maybe Int
forall a. Stack a -> Maybe a
pop Stack Int
s)
        in
          Stack (G a)
acc''
      Bin Int
i1 d
_ Margin d
_ RPT d Int a
tl RPT d Int a
tr ->
        let
          b1 :: G a
b1 = Int -> G a
forall a. Int -> G a
BNode Int
i1
          acc' :: Stack (G a)
acc' = G a -> Stack (G a) -> Stack (G a)
forall a. a -> Stack a -> Stack a
push G a
forall a. G a
b1 Stack (G a)
acc
          acc'' :: Stack (G a)
acc'' = case Stack Int -> Maybe Int
forall a. Stack a -> Maybe a
pop Stack Int
s of
            Maybe Int
Nothing -> Stack (G a)
acc'
            Just Int
i0 ->
              let
                e :: G a
e = Int -> Int -> G a
forall a. Int -> Int -> G a
Edge Int
i0 Int
i1
                b0 :: G a
b0 = Int -> G a
forall a. Int -> G a
BNode Int
i0
              in G a -> Stack (G a) -> Stack (G a)
forall a. a -> Stack a -> Stack a
push G a
forall a. G a
e (G a -> Stack (G a) -> Stack (G a)
forall a. a -> Stack a -> Stack a
push G a
forall a. G a
b0 Stack (G a)
acc')
          s' :: Stack Int
s' = Int -> Stack Int -> Stack Int
forall a. a -> Stack a -> Stack a
push Int
i1 Stack Int
s
        in
          Stack Int -> Stack (G a) -> RPT d Int a -> Stack (G a)
go Stack Int
s' Stack (G a)
acc'' RPT d Int a
tl Stack (G a) -> Stack (G a) -> Stack (G a)
forall a. Semigroup a => a -> a -> a
<> Stack Int -> Stack (G a) -> RPT d Int a -> Stack (G a)
go Stack Int
s' Stack (G a)
acc RPT d Int a
tr



labelBranches :: Bitraversable t => t x d -> t Int d
labelBranches :: t x d -> t Int d
labelBranches = (State Int (t Int d) -> Int -> t Int d)
-> Int -> State Int (t Int d) -> t Int d
forall a b c. (a -> b -> c) -> b -> a -> c
flip State Int (t Int d) -> Int -> t Int d
forall s a. State s a -> s -> a
evalState Int
0 (State Int (t Int d) -> t Int d)
-> (t x d -> State Int (t Int d)) -> t x d -> t Int d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> StateT Int Identity Int)
-> (d -> StateT Int Identity d) -> t x d -> State Int (t Int d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse x -> StateT Int Identity Int
forall (m :: * -> *) x. MonadState Int m => x -> m Int
counter d -> StateT Int Identity d
forall (f :: * -> *) a. Applicative f => a -> f a
pure

counter :: (MonadState Int m) => x -> m Int
counter :: x -> m Int
counter x
_ = do
  Int
i <- m Int
forall s (m :: * -> *). MonadState s m => m s
get
  (Int -> Int) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify Int -> Int
forall a. Enum a => a -> a
succ
  Int -> m Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i

type Stack a = [a]
push :: a -> Stack a -> Stack a
push :: a -> Stack a -> Stack a
push = (:)
pop :: Stack a -> Maybe a
pop :: Stack a -> Maybe a
pop Stack a
xs
  | Stack a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Stack a
xs = Maybe a
forall a. Maybe a
Nothing
  | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Stack a -> a
forall a. [a] -> a
head Stack a
xs


-- tt0 :: RPT Integer () [a]
tt0 :: RPT Integer [a1] [a2]
tt0 :: RPT Integer [a1] [a2]
tt0 = [a1]
-> Integer
-> Margin Integer
-> RPT Integer [a1] [a2]
-> RPT Integer [a1] [a2]
-> RPT Integer [a1] [a2]
forall d l a.
l -> d -> Margin d -> RPT d l a -> RPT d l a -> RPT d l a
Bin [] Integer
0 Margin Integer
forall a. Monoid a => a
mempty RPT Integer [a1] [a2]
forall a a. RPT Integer [a] [a]
tl RPT Integer [a1] [a2]
forall d a a. RPT d [a] [a]
t
  where
    tl :: RPT Integer [a] [a]
tl = [a]
-> Integer
-> Margin Integer
-> RPT Integer [a] [a]
-> RPT Integer [a] [a]
-> RPT Integer [a] [a]
forall d l a.
l -> d -> Margin d -> RPT d l a -> RPT d l a -> RPT d l a
Bin [] Integer
1 Margin Integer
forall a. Monoid a => a
mempty ([a]
-> Integer
-> Margin Integer
-> RPT Integer [a] [a]
-> RPT Integer [a] [a]
-> RPT Integer [a] [a]
forall d l a.
l -> d -> Margin d -> RPT d l a -> RPT d l a -> RPT d l a
Bin [] Integer
2 Margin Integer
forall a. Monoid a => a
mempty RPT Integer [a] [a]
forall d a a. RPT d [a] [a]
t RPT Integer [a] [a]
forall d a a. RPT d [a] [a]
t) ([a]
-> Integer
-> Margin Integer
-> RPT Integer [a] [a]
-> RPT Integer [a] [a]
-> RPT Integer [a] [a]
forall d l a.
l -> d -> Margin d -> RPT d l a -> RPT d l a -> RPT d l a
Bin [] Integer
3 Margin Integer
forall a. Monoid a => a
mempty RPT Integer [a] [a]
forall d a a. RPT d [a] [a]
t RPT Integer [a] [a]
forall d a a. RPT d [a] [a]
t)
    t :: RPT d [a] [a]
t = [a] -> [a] -> RPT d [a] [a]
forall d l a. l -> a -> RPT d l a
Tip [] []



-- 


-- | Render a tree to stdout
--
-- Useful for debugging
--
-- This should be called only for small trees, otherwise the printed result quickly overflows the screen and becomes hard to read.
--
-- NB : prints distance information rounded to two decimal digits
draw :: (Show a, Boxed a, PrintfArg v) => RPTree v l a -> IO ()
draw :: RPTree v l a -> IO ()
draw = RPT v l a -> IO ()
forall a v l. (Show a, Boxed a, PrintfArg v) => RPT v l a -> IO ()
drawRPT (RPT v l a -> IO ())
-> (RPTree v l a -> RPT v l a) -> RPTree v l a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RPTree v l a -> RPT v l a
forall d l a. RPTree d l a -> RPT d l a
_rpTree

drawRPT :: (Show a, Boxed a, PrintfArg v) => RPT v l a -> IO ()
drawRPT :: RPT v l a -> IO ()
drawRPT = FilePath -> IO ()
putStrLn (FilePath -> IO ())
-> (RPT v l a -> FilePath) -> RPT v l a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RPT v l a -> FilePath
forall a v l.
(Show a, Boxed a, PrintfArg v) =>
RPT v l a -> FilePath
toStringRPT

toStringRPT :: (Show a, Boxed a, PrintfArg v) => RPT v l a -> String
toStringRPT :: RPT v l a -> FilePath
toStringRPT = Box -> FilePath
B.render (Box -> FilePath) -> (RPT v l a -> Box) -> RPT v l a -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RPT v l a -> Box
forall a v l. (Show a, Boxed a, PrintfArg v) => RPT v l a -> Box
toBox

toBox :: (Show a, Boxed a, PrintfArg v) => RPT v l a -> B.Box
toBox :: RPT v l a -> Box
toBox = \case
  (Bin l
_ v
thr Margin v
_ RPT v l a
tl RPT v l a
tr) ->
    FilePath -> Box
txt (v -> FilePath
forall t t. (PrintfArg t, PrintfType t) => t -> t
node v
thr) Box -> Box -> Box
`stack` (RPT v l a -> Box
forall a v l. (Show a, Boxed a, PrintfArg v) => RPT v l a -> Box
toBox RPT v l a
tl Box -> Box -> Box
`byside` RPT v l a -> Box
forall a v l. (Show a, Boxed a, PrintfArg v) => RPT v l a -> Box
toBox RPT v l a
tr)
  Tip l
_ a
xs -> a -> Box
forall a. Boxed a => a -> Box
boxed a
xs -- tipData xs -- txt $ show x
  where
    node :: t -> t
node t
x = FilePath -> t -> t
forall r. PrintfType r => FilePath -> r
printf FilePath
"%5.2f" t
x -- (show x)

class Boxed a where
  boxed :: a -> B.Box
instance (Show a) => Boxed [a] where
  boxed :: [a] -> Box
boxed = (Box -> a -> Box) -> Box -> [a] -> Box
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Box
bx a
x -> Box
bx Box -> Box -> Box
`stack` FilePath -> Box
txt (a -> FilePath
forall a. Show a => a -> FilePath
show a
x)) (Box -> [a] -> Box) -> Box -> [a] -> Box
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Box
B.emptyBox Int
0 Int
0
instance Boxed () where
  boxed :: () -> Box
boxed ()
_ = FilePath -> Box
txt FilePath
"*"

tipData :: (Show a, Foldable t) => t a -> B.Box
tipData :: t a -> Box
tipData = (Box -> a -> Box) -> Box -> t a -> Box
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Box
bx a
x -> Box
bx Box -> Box -> Box
`stack` FilePath -> Box
txt (a -> FilePath
forall a. Show a => a -> FilePath
show a
x)) (Box -> t a -> Box) -> Box -> t a -> Box
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Box
B.emptyBox Int
1 Int
1

txt :: String -> B.Box
txt :: FilePath -> Box
txt FilePath
t = Box
spc Box -> Box -> Box
`byside` FilePath -> Box
B.text FilePath
t Box -> Box -> Box
`byside` Box
spc
  where spc :: Box
spc = Int -> Int -> Box
B.emptyBox Int
1 Int
1

byside :: B.Box -> B.Box -> B.Box
byside :: Box -> Box -> Box
byside Box
l Box
r = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
B.hcat Alignment
B.top [Box
l, Box
r]

stack :: B.Box -> B.Box -> B.Box
stack :: Box -> Box -> Box
stack Box
t Box
b = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
B.vcat Alignment
B.center1 [Box
t, Box
b]