module Boxes where

-- Adapted from the Haskell boxes library by Brent Yorgey

import List (intersperse, transpose)

--- A box has a defined size (rows x cols) and some content.
data Box = Box
  { rows :: Int
  , cols :: Int
  , content :: Content }

--- Box alignment.
---
--- @cons AlignFirst - align at top/left
--- @cons AlignCenter1 - centered, but biased to top/left
--- @cons AlignCenter2 - centered, but biased to bottom/right
--- @cons AlignLast - align at bottom/right
data Alignment = AlignFirst
               | AlignCenter1
               | AlignCenter2
               | AlignLast

--- Top alignment.
top :: Alignment
top = AlignFirst

--- Botton alignment.
bottom :: Alignment
bottom = AlignLast

--- Left alignment.
left :: Alignment
left = AlignFirst

--- Right alignment.
right :: Alignment
right = AlignLast

--- Center-top/left alignment.
center1 :: Alignment
center1 = AlignCenter1

--- Center-bottom/right alignment.
center2 :: Alignment
center2 = AlignCenter2

--- Content of a box.
---
--- @cons Blank - no content
--- @cons Text - a string
--- @cons Row - a row of boxes
--- @cons Col - a column of boxes
--- @cons SubBox - an aligned subbox
data Content = Blank
             | Text String
             | Row [Box]
             | Col [Box]
             | SubBox Alignment Alignment Box

--- Creates an empty 0x0 box.
nullBox :: Box
nullBox = emptyBox 0 0

--- Creates an empty box with the given size.
---
--- @param r number of rows
--- @param c number of columns
emptyBox :: Int -> Int -> Box
emptyBox r c = Box r c Blank

--- Creates a 1x1 box from a character.
char :: Char -> Box
char c = Box 1 1 (Text [c])

--- Creates a Nx1 box from a string of length N.
text :: String -> Box
text t = Box 1 (length t) (Text t)

--- Combine two boxes horizontally with top alignment.
(<>) :: Box -> Box -> Box
l <> r = hcat top [l, r]

--- Combine two boxes horizontally with top alignment and leave one column
--- between the boxes.
(<+>) :: Box -> Box -> Box
l <+> r = hcat top [l, emptyBox 0 1, r]

--- Combine two boxes vertically with left alignment.
(//) :: Box -> Box -> Box
t // b = vcat left [t, b]

--- Combine two boxes vertically with left alignment and leave one row between
--- the boxes.
(/+/) :: Box -> Box -> Box
t /+/ b = vcat left [t, emptyBox 1 0, b]

--- Combines a list of boxes horizontally with the given alignment.
hcat :: Alignment -> [Box] -> Box
hcat a bs = Box h w (Row $ map (alignVert a h) bs)
 where
  (w, h) = sumMax cols 0 rows bs

--- Combines a list of boxes horizontally with the given alignment and space 
--- between all boxes.
hsep :: Int -> Alignment -> [Box] -> Box
hsep sep a bs = punctuateH a (emptyBox 0 sep) bs

--- Combines a list of boxes vertically with the given alignment.
vcat :: Alignment -> [Box] -> Box
vcat a bs = Box h w (Col $ map (alignHoriz a w) bs)
 where
  (h, w) = sumMax rows 0 cols bs

--- Calculate sum and maximum of a list.
sumMax :: (a -> Int) -> b -> (a -> b) -> [a] -> (Int, b)
sumMax f defaultMax g as = foldr go (,) as 0 defaultMax
 where
  go a r n b = (r $! f a + n) $! g a `max` b

--- Combines a list of boxes vertically with the given alignment and space
--- between all boxes.
vsep :: Int -> Alignment -> [Box] -> Box
vsep sep a bs = punctuateV a (emptyBox sep 0) bs

--- Combine a list of boxes horizontally with the given alignment and a copy of 
--- the given box between each two boxes.
punctuateH :: Alignment -> Box -> [Box] -> Box
punctuateH a p bs = hcat a (intersperse p bs)

--- Combine a list of boxes vertically with the given alignment and a copy of
--- the given box between each two boxes.
punctuateV :: Alignment -> Box -> [Box] -> Box
punctuateV a p bs = vcat a (intersperse p bs)

paraFill :: Alignment -> Int -> String -> Box
paraFill a n t = (\ss -> mkParaBoxFill a (length ss) n ss) $ flow n t

mkParaBoxFill :: Alignment -> Int -> Int -> [String] -> Box
mkParaBoxFill a h w = align AlignFirst a h w . vcat a . map text

--- Create a box of the given width, containing a specific text. The text is
--- flowed to fit the width according to the alignment.
---
--- @param a the alignment of the text
--- @param w the box's width
--- @param c the box's contents
para :: Alignment -> Int -> String -> Box
para a n t = (\ss -> mkParaBox a (length ss) ss) $ flow n t

--- Creates a list of boxes, each of a specific width and height. The given 
--- text is flowed into as many columns as necessary according to the given
--- alignment.
columns :: Alignment -> Int -> Int -> String -> [Box]
columns a w h t = map (mkParaBox a h) . chunksOf h $ flow w t

--- Creates a box of a specific height that contains a list of texts.
mkParaBox :: Alignment -> Int -> [String] -> Box
mkParaBox a n = alignVert top n . vcat a . map text

--- Flows a given text into a given width, creating many different strings.
flow :: Int -> String -> [String]
flow n t = map (take n)
         . getLines
         $ foldl addWordP (emptyPara n) (map mkWord . words $ t)

--- A paragraph has a width and some content.
data Para = Para
  { paraWidth :: Int
  , paraContent :: ParaContent }

--- A paragraph's content is a block consisting of many full lines and a single
--- last line.
data ParaContent = Block
  { fullLines :: [Line]
  , lastLine :: Line }

--- Creates an empty paragraph of the given width.
emptyPara :: Int -> Para
emptyPara pw = Para pw (Block [] (Line 0 []))

--- Returns all lines of a paragraph.
getLines :: Para -> [String]
getLines (Para _ (Block ls l))
  | lLen l == 0 = process ls
  | otherwise   = process (l:ls)
  where process = map (unwords . reverse . map getWord . getWords) . reverse

--- A line has a length and a list of words.
data Line = Line
  { lLen :: Int
  , getWords :: [Word] }

--- Creates a line from a list of words.
mkLine :: [Word] -> Line
mkLine ws = Line (sum (map ((+1) . wLen) ws) - 1) ws

--- Creates a line from a single word.
startLine :: Word -> Line
startLine = mkLine . (:[])

--- A word has a length and its contents.
data Word = Word
  { wLen :: Int
  , getWord :: String }

--- Creates a word from a string.
mkWord :: String -> Word
mkWord w = Word (length w) w

--- Adds a word to a paragraph.
addWordP :: Para -> Word -> Para
addWordP (Para pw (Block fl l)) w
  | wordFits pw w l = Para pw (Block fl (addWordL w l))
  | otherwise       = Para pw (Block (l:fl) (startLine w))

--- Adds a word to a line.
addWordL :: Word -> Line -> Line
addWordL w (Line len ws) = Line (len + wLen w + 1) (w:ws)

--- Checks whether a word fits into a line.
wordFits :: Int -> Word -> Line -> Bool
wordFits pw w l = lLen l == 0 || lLen l + wLen w + 1 <= pw

--- Creates a box of a specific width containing another box's content aligned
--- according to the given alignment.
alignHoriz :: Alignment -> Int -> Box -> Box
alignHoriz a c b = align a AlignFirst (rows b) c b

--- Creates a box of a specific height containing another box's content aligned
--- according to the given alignment.
alignVert :: Alignment -> Int -> Box -> Box
alignVert a r b = align AlignFirst a r (cols b) b

--- Creates a box of a specific width and height containing another box's 
--- content aligned according to the given alignment.
align :: Alignment -> Alignment -> Int -> Int -> Box -> Box
align ah av r c = Box r c . SubBox ah av

--- Move a box up by putting it into a larger box with extra rows, aligned to
--- the top. See remarks for moveLeft.
moveUp :: Int -> Box -> Box
moveUp n b = alignVert top (rows b + n) b

--- Move a box down by putting it into a larger box with extra rows, aligned to
--- the bottom. See remarks for moveLeft.
moveDown :: Int -> Box -> Box
moveDown n b = alignVert bottom (rows b + n) b

--- Move a box left by putting it into a larger box with extra columns, aligned
--- to the left. Note that this will only move the box by the specified amount 
--- if it is already in a larger right-aligned box.
moveLeft :: Int -> Box -> Box
moveLeft n b = alignHoriz left (cols b + n) b

--- Move a box right by putting it into a larger box with extra columns, aligned
--- to the right. See remarks for moveRight.
moveRight :: Int -> Box -> Box
moveRight n b = alignHoriz right (cols b + n) b

--- Create a table from a list of rows. A fixed width for each column must be
--- specified.
table :: [[String]] -> [Int] -> Box
table rows widths = vcat left $ map (hcat left . map (uncurry $ paraFill left)) withLengths
 where
  withLengths = map (zip widths) rows

--- Render a box to a string.
render :: Box -> String
render = unlines . renderBox

--- Takes a number of elements from a list. If the list is shorter than that 
--- number, fill the rest with a filler.
takeP :: a -> Int -> [a] -> [a]
takeP b n xs
  | n <= 0 = []
  | otherwise = case xs of
    []     -> replicate n b
    (y:ys) -> y : takeP b (n - 1) ys

fReverse :: ([a], b) -> ([a], b)
fReverse (xs, y) = (reverse xs, y)

(***) :: (a -> b) -> (c -> d) -> ((a, c) -> (b, d))
f1 *** f2 = \(x, y) -> (f1 x, f2 y)

takePA :: Alignment -> a -> Int -> [a] -> [a]
takePA c b x = glue . (takeP b (numRev c x) *** takeP b (numFwd c x)) . split
 where
  split t = fReverse . splitAt (numRev c (length t)) $ t
  glue = uncurry (++) . fReverse
  numFwd AlignFirst n = n
  numFwd AlignLast  _ = 0
  numFwd AlignCenter1 n = n `div` 2
  numFwd AlignCenter2 n = (n + 1) `div` 2
  numRev AlignFirst _ = 0
  numRev AlignLast  n = n
  numRev AlignCenter1 n = (n + 1) `div` 2
  numRev AlignCenter2 n = n `div` 2

--- Generates a string of spaces.
blanks :: Int -> String
blanks = flip replicate ' '

--- Render a box as a list of lines.
renderBox :: Box -> [String]
renderBox (Box r c Blank) = resizeBox r c [""]
renderBox (Box r c (Text t)) = resizeBox r c [t]
renderBox (Box r c (Row bs)) = resizeBox r c
                             . merge
                             . map (renderBoxWithRows r)
                             $ bs
  where merge = foldr (zipWith (++)) (repeat [])
renderBox (Box r c (Col bs)) = resizeBox r c
                             . concatMap (renderBoxWithCols c)
                             $ bs
renderBox (Box r c (SubBox ha va b)) = resizeBoxAligned r c ha va
                                     . renderBox
                                     $ b

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

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

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

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

--- Print a box to stdout.
printBox :: Box -> IO ()
printBox = putStr . render

-- From Haskell's Data.List.Split

chunksOf :: Int -> [a] -> [[a]]
chunksOf n xs = map (take n) (xs:(partials xs))
 where
  partials []       = []
  partials ys@(_:_) = let ys' = drop n ys in case ys' of
    []    -> []
    (_:_) -> (ys':(partials ys'))

sum :: [Int] -> Int
sum = foldl (+) 0