{-# LANGUAGE CPP #-}
#include "boxes.h"

-----------------------------------------------------------------------------
-- |
-- Module      :  Text.PrettyPrint.Boxes
-- Copyright   :  (c) Brent Yorgey 2009
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  David.Feuer@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- A pretty-printing library for laying out text in two dimensions,
-- using a simple box model.
--
-----------------------------------------------------------------------------
module Text.PrettyPrint.Boxes
    ( -- * Constructing boxes
#ifdef TESTING
      Box(Box, content)
#else
      Box
#endif
    , nullBox
    , emptyBox
    , char
    , text
    , para
    , columns

      -- * Layout of boxes

    , (<>)
    , (<+>)
    , hcat
    , hsep

    , (//)
    , (/+/)
    , vcat
    , vsep

    , punctuateH, punctuateV

    -- * Alignment

#ifdef TESTING
    , Alignment(..)
#else
    , Alignment
#endif

#ifdef TESTING
    , Content(..)
#endif
    , left, right
    , top, bottom
    , center1, center2

    , moveLeft
    , moveRight
    , moveUp
    , moveDown

    , alignHoriz
    , alignVert
    , align

    -- * Inspecting boxes

    , rows
    , cols

    -- * Rendering boxes

    , render
    , printBox

    ) where

#if MIN_VERSION_base(4,11,0)
import Prelude hiding ( (<>), Word )
#elif MIN_VERSION_base(4,8,0)
import Prelude hiding (Word)
#else
import Data.Foldable (Foldable (foldr))
import Prelude hiding (foldr)
#endif
import Data.Foldable (toList)

#if MIN_VERSION_base(4,4,0)
import Data.String (words, unwords)
#else
import Data.List (words, unwords)
#endif

#ifdef OVERLOADED_STRINGS
import Data.String (IsString(..))
#endif

import Control.Arrow ((***), first)
import Data.List (foldl', intersperse)

import Data.List.Split (chunksOf)

-- | The basic data type.  A box has a specified size and some sort of
--   contents.
data Box = Box { Box -> Int
rows    :: Int
               , Box -> Int
cols    :: Int
               , Box -> Content
content :: Content
               }
  deriving (Int -> Box -> ShowS
[Box] -> ShowS
Box -> String
(Int -> Box -> ShowS)
-> (Box -> String) -> ([Box] -> ShowS) -> Show Box
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Box] -> ShowS
$cshowList :: [Box] -> ShowS
show :: Box -> String
$cshow :: Box -> String
showsPrec :: Int -> Box -> ShowS
$cshowsPrec :: Int -> Box -> ShowS
Show)

#ifdef OVERLOADED_STRINGS
-- | Convenient ability to use bare string literals as boxes.
instance IsString Box where
  fromString :: String -> Box
fromString = String -> Box
text
#endif

-- | Data type for specifying the alignment of boxes.
data Alignment = AlignFirst    -- ^ Align at the top/left.
               | AlignCenter1  -- ^ Centered, biased to the top/left.
               | AlignCenter2  -- ^ Centered, biased to the bottom/right.
               | AlignLast     -- ^ Align at the bottom/right.
  deriving (Alignment -> Alignment -> Bool
(Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool) -> Eq Alignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Alignment -> Alignment -> Bool
$c/= :: Alignment -> Alignment -> Bool
== :: Alignment -> Alignment -> Bool
$c== :: Alignment -> Alignment -> Bool
Eq, ReadPrec [Alignment]
ReadPrec Alignment
Int -> ReadS Alignment
ReadS [Alignment]
(Int -> ReadS Alignment)
-> ReadS [Alignment]
-> ReadPrec Alignment
-> ReadPrec [Alignment]
-> Read Alignment
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Alignment]
$creadListPrec :: ReadPrec [Alignment]
readPrec :: ReadPrec Alignment
$creadPrec :: ReadPrec Alignment
readList :: ReadS [Alignment]
$creadList :: ReadS [Alignment]
readsPrec :: Int -> ReadS Alignment
$creadsPrec :: Int -> ReadS Alignment
Read, Int -> Alignment -> ShowS
[Alignment] -> ShowS
Alignment -> String
(Int -> Alignment -> ShowS)
-> (Alignment -> String)
-> ([Alignment] -> ShowS)
-> Show Alignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Alignment] -> ShowS
$cshowList :: [Alignment] -> ShowS
show :: Alignment -> String
$cshow :: Alignment -> String
showsPrec :: Int -> Alignment -> ShowS
$cshowsPrec :: Int -> Alignment -> ShowS
Show)

-- | Align boxes along their tops.
top :: Alignment
top :: Alignment
top        = Alignment
AlignFirst

-- | Align boxes along their bottoms.
bottom :: Alignment
bottom :: Alignment
bottom     = Alignment
AlignLast

-- | Align boxes to the left.
left :: Alignment
left :: Alignment
left       = Alignment
AlignFirst

-- | Align boxes to the right.
right :: Alignment
right :: Alignment
right      = Alignment
AlignLast

-- | Align boxes centered, but biased to the left/top in case of
--   unequal parities.
center1 :: Alignment
center1 :: Alignment
center1    = Alignment
AlignCenter1

-- | Align boxes centered, but biased to the right/bottom in case of
--   unequal parities.
center2 :: Alignment
center2 :: Alignment
center2    = Alignment
AlignCenter2

-- | Contents of a box.
data Content = Blank        -- ^ No content.
             | Text String  -- ^ A raw string.
             | Row [Box]    -- ^ A row of sub-boxes.
             | Col [Box]    -- ^ A column of sub-boxes.
             | SubBox Alignment Alignment Box
                            -- ^ A sub-box with a specified alignment.
  deriving (Int -> Content -> ShowS
[Content] -> ShowS
Content -> String
(Int -> Content -> ShowS)
-> (Content -> String) -> ([Content] -> ShowS) -> Show Content
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Content] -> ShowS
$cshowList :: [Content] -> ShowS
show :: Content -> String
$cshow :: Content -> String
showsPrec :: Int -> Content -> ShowS
$cshowsPrec :: Int -> Content -> ShowS
Show)

-- | The null box, which has no content and no size.  It is quite
--   useless.
nullBox :: Box
nullBox :: Box
nullBox = Int -> Int -> Box
emptyBox Int
0 Int
0

-- | @emptyBox r c@ is an empty box with @r@ rows and @c@ columns.
--   Useful for effecting more fine-grained positioning of other
--   boxes, by inserting empty boxes of the desired size in between
--   them.
emptyBox :: Int -> Int -> Box
emptyBox :: Int -> Int -> Box
emptyBox Int
r Int
c = Int -> Int -> Content -> Box
Box Int
r Int
c Content
Blank

-- | A @1x1@ box containing a single character.
char :: Char -> Box
char :: Char -> Box
char Char
c = Int -> Int -> Content -> Box
Box Int
1 Int
1 (String -> Content
Text [Char
c])

-- | A (@1 x len@) box containing a string of length @len@.
text :: String -> Box
text :: String -> Box
text String
t = Int -> Int -> Content -> Box
Box Int
1 (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
t) (String -> Content
Text String
t)

-- | Paste two boxes together horizontally, using a default (top)
--   alignment.
(<>) :: Box -> Box -> Box
Box
l <> :: Box -> Box -> Box
<> Box
r = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
hcat Alignment
top [Box
l,Box
r]

-- | Paste two boxes together horizontally with a single intervening
--   column of space, using a default (top) alignment.
(<+>) :: Box -> Box -> Box
Box
l <+> :: Box -> Box -> Box
<+> Box
r = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
hcat Alignment
top [Box
l, Int -> Int -> Box
emptyBox Int
0 Int
1, Box
r]

-- | Paste two boxes together vertically, using a default (left)
--   alignment.
(//) :: Box -> Box -> Box
Box
t // :: Box -> Box -> Box
// Box
b = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
vcat Alignment
left [Box
t,Box
b]

-- | Paste two boxes together vertically with a single intervening row
--   of space, using a default (left) alignment.
(/+/) :: Box -> Box -> Box
Box
t /+/ :: Box -> Box -> Box
/+/ Box
b = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
vcat Alignment
left [Box
t, Int -> Int -> Box
emptyBox Int
1 Int
0, Box
b]

-- | Glue a list of boxes together horizontally, with the given alignment.
hcat :: Foldable f => Alignment -> f Box -> Box
hcat :: Alignment -> f Box -> Box
hcat Alignment
a f Box
bs = Int -> Int -> Content -> Box
Box Int
h Int
w ([Box] -> Content
Row ([Box] -> Content) -> [Box] -> Content
forall a b. (a -> b) -> a -> b
$ (Box -> Box) -> [Box] -> [Box]
forall a b. (a -> b) -> [a] -> [b]
map (Alignment -> Int -> Box -> Box
alignVert Alignment
a Int
h) [Box]
bsl)
  where
    (Int
w, Int
h) = (Box -> Int) -> Int -> (Box -> Int) -> [Box] -> (Int, Int)
forall n b (f :: * -> *) a.
(Num n, Ord b, Foldable f) =>
(a -> n) -> b -> (a -> b) -> f a -> (n, b)
sumMax Box -> Int
cols Int
0 Box -> Int
rows [Box]
bsl
    bsl :: [Box]
bsl = f Box -> [Box]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f Box
bs

-- | @hsep sep a bs@ lays out @bs@ horizontally with alignment @a@,
--   with @sep@ amount of space in between each.
hsep :: Foldable f => Int -> Alignment -> f Box -> Box
hsep :: Int -> Alignment -> f Box -> Box
hsep Int
sep Alignment
a f Box
bs = Alignment -> Box -> f Box -> Box
forall (f :: * -> *).
Foldable f =>
Alignment -> Box -> f Box -> Box
punctuateH Alignment
a (Int -> Int -> Box
emptyBox Int
0 Int
sep) f Box
bs

-- | Glue a list of boxes together vertically, with the given alignment.
vcat :: Foldable f => Alignment -> f Box -> Box
vcat :: Alignment -> f Box -> Box
vcat Alignment
a f Box
bs = Int -> Int -> Content -> Box
Box Int
h Int
w ([Box] -> Content
Col ([Box] -> Content) -> [Box] -> Content
forall a b. (a -> b) -> a -> b
$ (Box -> Box) -> [Box] -> [Box]
forall a b. (a -> b) -> [a] -> [b]
map (Alignment -> Int -> Box -> Box
alignHoriz Alignment
a Int
w) [Box]
bsl)
  where
    (Int
h, Int
w) = (Box -> Int) -> Int -> (Box -> Int) -> [Box] -> (Int, Int)
forall n b (f :: * -> *) a.
(Num n, Ord b, Foldable f) =>
(a -> n) -> b -> (a -> b) -> f a -> (n, b)
sumMax Box -> Int
rows Int
0 Box -> Int
cols [Box]
bsl
    bsl :: [Box]
bsl = f Box -> [Box]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f Box
bs

-- Calculate a sum and a maximum over a list in one pass. If the list is
-- empty, the maximum is reported as the given default. This would
-- normally be done using the foldl library, but we don't want that
-- dependency.
sumMax :: (Num n, Ord b, Foldable f) => (a -> n) -> b -> (a -> b) -> f a -> (n, b)
sumMax :: (a -> n) -> b -> (a -> b) -> f a -> (n, b)
sumMax a -> n
f b
defaultMax a -> b
g f a
as = (a -> (n -> b -> (n, b)) -> n -> b -> (n, b))
-> (n -> b -> (n, b)) -> f a -> n -> b -> (n, b)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> (n -> b -> (n, b)) -> n -> b -> (n, b)
forall b. a -> (n -> b -> b) -> n -> b -> b
go (,) f a
as n
0 b
defaultMax
  where
    go :: a -> (n -> b -> b) -> n -> b -> b
go a
a n -> b -> b
r n
n b
b = (n -> b -> b
r (n -> b -> b) -> n -> b -> b
forall a b. (a -> b) -> a -> b
$! a -> n
f a
a n -> n -> n
forall a. Num a => a -> a -> a
+ n
n) (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! a -> b
g a
a b -> b -> b
forall a. Ord a => a -> a -> a
`max` b
b

-- | @vsep sep a bs@ lays out @bs@ vertically with alignment @a@,
--   with @sep@ amount of space in between each.
vsep :: Foldable f => Int -> Alignment -> f Box -> Box
vsep :: Int -> Alignment -> f Box -> Box
vsep Int
sep Alignment
a f Box
bs = Alignment -> Box -> [Box] -> Box
forall (f :: * -> *).
Foldable f =>
Alignment -> Box -> f Box -> Box
punctuateV Alignment
a (Int -> Int -> Box
emptyBox Int
sep Int
0) (f Box -> [Box]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f Box
bs)

-- | @punctuateH a p bs@ horizontally lays out the boxes @bs@ with a
--   copy of @p@ interspersed between each.
punctuateH :: Foldable f => Alignment -> Box -> f Box -> Box
punctuateH :: Alignment -> Box -> f Box -> Box
punctuateH Alignment
a Box
p f Box
bs = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
hcat Alignment
a (Box -> [Box] -> [Box]
forall a. a -> [a] -> [a]
intersperse Box
p (f Box -> [Box]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f Box
bs))

-- | A vertical version of 'punctuateH'.
punctuateV :: Foldable f => Alignment -> Box -> f Box -> Box
punctuateV :: Alignment -> Box -> f Box -> Box
punctuateV Alignment
a Box
p f Box
bs = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
vcat Alignment
a (Box -> [Box] -> [Box]
forall a. a -> [a] -> [a]
intersperse Box
p (f Box -> [Box]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f Box
bs))

--------------------------------------------------------------------------------
--  Paragraph flowing  ---------------------------------------------------------
--------------------------------------------------------------------------------

-- | @para algn w t@ is a box of width @w@, containing text @t@,
--   aligned according to @algn@, flowed to fit within the given
--   width.
para :: Alignment -> Int -> String -> Box
para :: Alignment -> Int -> String -> Box
para Alignment
a Int
n String
t = (\[String]
ss -> Alignment -> Int -> [String] -> Box
mkParaBox Alignment
a ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ss) [String]
ss) ([String] -> Box) -> [String] -> Box
forall a b. (a -> b) -> a -> b
$ Int -> String -> [String]
flow Int
n String
t

-- | @columns w h t@ is a list of boxes, each of width @w@ and height
--   at most @h@, containing text @t@ flowed into as many columns as
--   necessary.
columns :: Alignment -> Int -> Int -> String -> [Box]
columns :: Alignment -> Int -> Int -> String -> [Box]
columns Alignment
a Int
w Int
h String
t = ([String] -> Box) -> [[String]] -> [Box]
forall a b. (a -> b) -> [a] -> [b]
map (Alignment -> Int -> [String] -> Box
mkParaBox Alignment
a Int
h) ([[String]] -> [Box])
-> ([String] -> [[String]]) -> [String] -> [Box]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [[String]]
forall e. Int -> [e] -> [[e]]
chunksOf Int
h ([String] -> [Box]) -> [String] -> [Box]
forall a b. (a -> b) -> a -> b
$ Int -> String -> [String]
flow Int
w String
t

-- | @mkParaBox a n s@ makes a box of height @n@ with the text @s@
--   aligned according to @a@.
mkParaBox :: Alignment -> Int -> [String] -> Box
mkParaBox :: Alignment -> Int -> [String] -> Box
mkParaBox Alignment
a Int
n = Alignment -> Int -> Box -> Box
alignVert Alignment
top Int
n (Box -> Box) -> ([String] -> Box) -> [String] -> Box
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
vcat Alignment
a ([Box] -> Box) -> ([String] -> [Box]) -> [String] -> Box
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Box) -> [String] -> [Box]
forall a b. (a -> b) -> [a] -> [b]
map String -> Box
text

-- | Flow the given text into the given width.
flow :: Int -> String -> [String]
flow :: Int -> String -> [String]
flow Int
n String
t = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
n)
         ([String] -> [String]) -> (Para -> [String]) -> Para -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Para -> [String]
getLines
         (Para -> [String]) -> Para -> [String]
forall a b. (a -> b) -> a -> b
$ (Para -> Word -> Para) -> Para -> [Word] -> Para
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Para -> Word -> Para
addWordP (Int -> Para
emptyPara Int
n) ((String -> Word) -> [String] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
map String -> Word
mkWord ([String] -> [Word]) -> (String -> [String]) -> String -> [Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> [Word]) -> String -> [Word]
forall a b. (a -> b) -> a -> b
$ String
t)

data Para = Para { Para -> Int
paraWidth   :: Int
                 , Para -> ParaContent
paraContent :: ParaContent
                 }
data ParaContent = Block { ParaContent -> [Line]
fullLines :: [Line]
                         , ParaContent -> Line
lastLine  :: Line
                         }

emptyPara :: Int -> Para
emptyPara :: Int -> Para
emptyPara Int
pw = Int -> ParaContent -> Para
Para Int
pw ([Line] -> Line -> ParaContent
Block [] (Int -> [Word] -> Line
Line Int
0 []))

getLines :: Para -> [String]
getLines :: Para -> [String]
getLines (Para Int
_ (Block [Line]
ls Line
l))
  | Line -> Int
lLen Line
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [Line] -> [String]
process [Line]
ls
  | Bool
otherwise   = [Line] -> [String]
process (Line
lLine -> [Line] -> [Line]
forall a. a -> [a] -> [a]
:[Line]
ls)
  where process :: [Line] -> [String]
process = (Line -> String) -> [Line] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> String
unwords ([String] -> String) -> (Line -> [String]) -> Line -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> (Line -> [String]) -> Line -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> String) -> [Word] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Word -> String
getWord ([Word] -> [String]) -> (Line -> [Word]) -> Line -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> [Word]
getWords) ([Line] -> [String]) -> ([Line] -> [Line]) -> [Line] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Line] -> [Line]
forall a. [a] -> [a]
reverse

data Line = Line { Line -> Int
lLen :: Int, Line -> [Word]
getWords :: [Word] }

mkLine :: [Word] -> Line
mkLine :: [Word] -> Line
mkLine [Word]
ws = Int -> [Word] -> Line
Line ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Word -> Int) -> [Word] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Int) -> (Word -> Int) -> Word -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
wLen) [Word]
ws) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Word]
ws

startLine :: Word -> Line
startLine :: Word -> Line
startLine = [Word] -> Line
mkLine ([Word] -> Line) -> (Word -> [Word]) -> Word -> Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
:[])

data Word = Word { Word -> Int
wLen :: Int, Word -> String
getWord  :: String }

mkWord :: String -> Word
mkWord :: String -> Word
mkWord String
w = Int -> String -> Word
Word (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
w) String
w

addWordP :: Para -> Word -> Para
addWordP :: Para -> Word -> Para
addWordP (Para Int
pw (Block [Line]
fl Line
l)) Word
w
  | Int -> Word -> Line -> Bool
wordFits Int
pw Word
w Line
l = Int -> ParaContent -> Para
Para Int
pw ([Line] -> Line -> ParaContent
Block [Line]
fl (Word -> Line -> Line
addWordL Word
w Line
l))
  | Bool
otherwise       = Int -> ParaContent -> Para
Para Int
pw ([Line] -> Line -> ParaContent
Block (Line
lLine -> [Line] -> [Line]
forall a. a -> [a] -> [a]
:[Line]
fl) (Word -> Line
startLine Word
w))

addWordL :: Word -> Line -> Line
addWordL :: Word -> Line -> Line
addWordL Word
w (Line Int
len [Word]
ws) = Int -> [Word] -> Line
Line (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
wLen Word
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Word
wWord -> [Word] -> [Word]
forall a. a -> [a] -> [a]
:[Word]
ws)

wordFits :: Int -> Word -> Line -> Bool
wordFits :: Int -> Word -> Line -> Bool
wordFits Int
pw Word
w Line
l = Line -> Int
lLen Line
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Line -> Int
lLen Line
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
wLen Word
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
pw

--------------------------------------------------------------------------------
--  Alignment  -----------------------------------------------------------------
--------------------------------------------------------------------------------

-- | @alignHoriz algn n bx@ creates a box of width @n@, with the
--   contents and height of @bx@, horizontally aligned according to
--   @algn@.
alignHoriz :: Alignment -> Int -> Box -> Box
alignHoriz :: Alignment -> Int -> Box -> Box
alignHoriz Alignment
a Int
c Box
b = Alignment -> Alignment -> Int -> Int -> Box -> Box
align Alignment
a Alignment
AlignFirst (Box -> Int
rows Box
b) Int
c Box
b

-- | @alignVert algn n bx@ creates a box of height @n@, with the
--   contents and width of @bx@, vertically aligned according to
--   @algn@.
alignVert :: Alignment -> Int -> Box -> Box
alignVert :: Alignment -> Int -> Box -> Box
alignVert Alignment
a Int
r Box
b = Alignment -> Alignment -> Int -> Int -> Box -> Box
align Alignment
AlignFirst Alignment
a Int
r (Box -> Int
cols Box
b) Box
b

-- | @align ah av r c bx@ creates an @r@ x @c@ box with the contents
--   of @bx@, aligned horizontally according to @ah@ and vertically
--   according to @av@.
align :: Alignment -> Alignment -> Int -> Int -> Box -> Box
align :: Alignment -> Alignment -> Int -> Int -> Box -> Box
align Alignment
ah Alignment
av Int
r Int
c = Int -> Int -> Content -> Box
Box Int
r Int
c (Content -> Box) -> (Box -> Content) -> Box -> Box
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> Alignment -> Box -> Content
SubBox Alignment
ah Alignment
av

-- | Move a box \"up\" by putting it in a larger box with extra rows,
--   aligned to the top.  See the disclaimer for 'moveLeft'.
moveUp :: Int -> Box -> Box
moveUp :: Int -> Box -> Box
moveUp Int
n Box
b = Alignment -> Int -> Box -> Box
alignVert Alignment
top (Box -> Int
rows Box
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) Box
b

-- | Move a box down by putting it in a larger box with extra rows,
--   aligned to the bottom.  See the disclaimer for 'moveLeft'.
moveDown :: Int -> Box -> Box
moveDown :: Int -> Box -> Box
moveDown Int
n Box
b = Alignment -> Int -> Box -> Box
alignVert Alignment
bottom (Box -> Int
rows Box
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) Box
b

-- | Move a box left by putting it in a larger box with extra columns,
--   aligned left.  Note that the name of this function is
--   something of a white lie, as this will only result in the box
--   being moved left by the specified amount if it is already in a
--   larger right-aligned context.
moveLeft :: Int -> Box -> Box
moveLeft :: Int -> Box -> Box
moveLeft Int
n Box
b = Alignment -> Int -> Box -> Box
alignHoriz Alignment
left (Box -> Int
cols Box
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) Box
b

-- | Move a box right by putting it in a larger box with extra
--   columns, aligned right.  See the disclaimer for 'moveLeft'.
moveRight :: Int -> Box -> Box
moveRight :: Int -> Box -> Box
moveRight Int
n Box
b = Alignment -> Int -> Box -> Box
alignHoriz Alignment
right (Box -> Int
cols Box
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) Box
b

--------------------------------------------------------------------------------
--  Implementation  ------------------------------------------------------------
--------------------------------------------------------------------------------

-- | Render a 'Box' as a String, suitable for writing to the screen or
--   a file.
render :: Box -> String
render :: Box -> String
render = [String] -> String
unlines ([String] -> String) -> (Box -> [String]) -> Box -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Box -> [String]
renderBox

-- XXX make QC properties for takeP

-- | \"Padded take\": @takeP a n xs@ is the same as @take n xs@, if @n
--   <= length xs@; otherwise it is @xs@ followed by enough copies of
--   @a@ to make the length equal to @n@.
takeP :: a -> Int -> [a] -> [a]
takeP :: a -> Int -> [a] -> [a]
takeP a
_ Int
n [a]
_      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = []
takeP a
b Int
n []              = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
n a
b
takeP a
b Int
n (a
x:[a]
xs)          = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> Int -> [a] -> [a]
forall a. a -> Int -> [a] -> [a]
takeP a
b (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [a]
xs

-- | @takePA @ is like 'takeP', but with alignment.  That is, we
--   imagine a copy of @xs@ extended infinitely on both sides with
--   copies of @a@, and a window of size @n@ placed so that @xs@ has
--   the specified alignment within the window; @takePA algn a n xs@
--   returns the contents of this window.
takePA :: Alignment -> a -> Int -> [a] -> [a]
takePA :: Alignment -> a -> Int -> [a] -> [a]
takePA Alignment
c a
b Int
n = ([a], [a]) -> [a]
forall a. ([a], [a]) -> [a]
glue (([a], [a]) -> [a]) -> ([a] -> ([a], [a])) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Int -> [a] -> [a]
forall a. a -> Int -> [a] -> [a]
takeP a
b (Alignment -> Int -> Int
forall a. Integral a => Alignment -> a -> a
numRev Alignment
c Int
n) ([a] -> [a]) -> ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** a -> Int -> [a] -> [a]
forall a. a -> Int -> [a] -> [a]
takeP a
b (Alignment -> Int -> Int
forall a. Integral a => Alignment -> a -> a
numFwd Alignment
c Int
n)) (([a], [a]) -> ([a], [a]))
-> ([a] -> ([a], [a])) -> [a] -> ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ([a], [a])
forall a. [a] -> ([a], [a])
split
  where split :: [a] -> ([a], [a])
split [a]
t = ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first [a] -> [a]
forall a. [a] -> [a]
reverse (([a], [a]) -> ([a], [a]))
-> ([a] -> ([a], [a])) -> [a] -> ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt (Alignment -> Int -> Int
forall a. Integral a => Alignment -> a -> a
numRev Alignment
c ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
t)) ([a] -> ([a], [a])) -> [a] -> ([a], [a])
forall a b. (a -> b) -> a -> b
$ [a]
t
        glue :: ([a], [a]) -> [a]
glue    = ([a] -> [a] -> [a]) -> ([a], [a]) -> [a]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) (([a], [a]) -> [a])
-> (([a], [a]) -> ([a], [a])) -> ([a], [a]) -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first [a] -> [a]
forall a. [a] -> [a]
reverse
        numFwd :: Alignment -> a -> a
numFwd Alignment
AlignFirst    a
n = a
n
        numFwd Alignment
AlignLast     a
_ = a
0
        numFwd Alignment
AlignCenter1  a
n = a
n a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2
        numFwd Alignment
AlignCenter2  a
n = (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1) a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2
        numRev :: Alignment -> a -> a
numRev Alignment
AlignFirst    a
_ = a
0
        numRev Alignment
AlignLast     a
n = a
n
        numRev Alignment
AlignCenter1  a
n = (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1) a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2
        numRev Alignment
AlignCenter2  a
n = a
n a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2

-- | Generate a string of spaces.
blanks :: Int -> String
blanks :: Int -> String
blanks = (Int -> Char -> String) -> Char -> Int -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Char -> String
forall a. Int -> a -> [a]
replicate Char
' '

-- | Render a box as a list of lines.
renderBox :: Box -> [String]

renderBox :: Box -> [String]
renderBox (Box Int
r Int
c Content
Blank)            = Int -> Int -> [String] -> [String]
resizeBox Int
r Int
c [String
""]
renderBox (Box Int
r Int
c (Text String
t))         = Int -> Int -> [String] -> [String]
resizeBox Int
r Int
c [String
t]
renderBox (Box Int
r Int
c (Row [Box]
bs))         = Int -> Int -> [String] -> [String]
resizeBox Int
r Int
c
                                       ([String] -> [String]) -> ([Box] -> [String]) -> [Box] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [String]
forall a. [[[a]]] -> [[a]]
merge
                                       ([[String]] -> [String])
-> ([Box] -> [[String]]) -> [Box] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Box -> [String]) -> [Box] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Box -> [String]
renderBoxWithRows Int
r)
                                       ([Box] -> [String]) -> [Box] -> [String]
forall a b. (a -> b) -> a -> b
$ [Box]
bs
                           where merge :: [[[a]]] -> [[a]]
merge = ([[a]] -> [[a]] -> [[a]]) -> [[a]] -> [[[a]]] -> [[a]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (([a] -> [a] -> [a]) -> [[a]] -> [[a]] -> [[a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)) ([a] -> [[a]]
forall a. a -> [a]
repeat [])

renderBox (Box Int
r Int
c (Col [Box]
bs))         = Int -> Int -> [String] -> [String]
resizeBox Int
r Int
c
                                       ([String] -> [String]) -> ([Box] -> [String]) -> [Box] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Box -> [String]) -> [Box] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Box -> [String]
renderBoxWithCols Int
c)
                                       ([Box] -> [String]) -> [Box] -> [String]
forall a b. (a -> b) -> a -> b
$ [Box]
bs

renderBox (Box Int
r Int
c (SubBox Alignment
ha Alignment
va Box
b)) = Int -> Int -> Alignment -> Alignment -> [String] -> [String]
resizeBoxAligned Int
r Int
c Alignment
ha Alignment
va
                                       ([String] -> [String]) -> (Box -> [String]) -> Box -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Box -> [String]
renderBox
                                       (Box -> [String]) -> Box -> [String]
forall a b. (a -> b) -> a -> b
$ Box
b

-- | Render a box as a list of lines, using a given number of rows.
renderBoxWithRows :: Int -> Box -> [String]
renderBoxWithRows :: Int -> Box -> [String]
renderBoxWithRows Int
r Box
b = Box -> [String]
renderBox (Box
b{rows :: Int
rows = Int
r})

-- | Render a box as a list of lines, using a given number of columns.
renderBoxWithCols :: Int -> Box -> [String]
renderBoxWithCols :: Int -> Box -> [String]
renderBoxWithCols Int
c Box
b = Box -> [String]
renderBox (Box
b{cols :: Int
cols = Int
c})

-- | Resize a rendered list of lines.
resizeBox :: Int -> Int -> [String] -> [String]
resizeBox :: Int -> Int -> [String] -> [String]
resizeBox Int
r Int
c = String -> Int -> [String] -> [String]
forall a. a -> Int -> [a] -> [a]
takeP (Int -> String
blanks Int
c) Int
r ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> Int -> ShowS
forall a. a -> Int -> [a] -> [a]
takeP Char
' ' Int
c)

-- | Resize a rendered list of lines, using given alignments.
resizeBoxAligned :: Int -> Int -> Alignment -> Alignment -> [String] -> [String]
resizeBoxAligned :: Int -> Int -> Alignment -> Alignment -> [String] -> [String]
resizeBoxAligned Int
r Int
c Alignment
ha Alignment
va = Alignment -> String -> Int -> [String] -> [String]
forall a. Alignment -> a -> Int -> [a] -> [a]
takePA Alignment
va (Int -> String
blanks Int
c) Int
r ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Alignment -> Char -> Int -> ShowS
forall a. Alignment -> a -> Int -> [a] -> [a]
takePA Alignment
ha Char
' ' Int
c)

-- | A convenience function for rendering a box to stdout.
printBox :: Box -> IO ()
printBox :: Box -> IO ()
printBox = String -> IO ()
putStr (String -> IO ()) -> (Box -> String) -> Box -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Box -> String
render