{- |
 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 Literate.Box where

import Control.Arrow (first, (***))
import Data.Foldable (Foldable (foldr), toList)
import Data.List (foldl', intersperse)
import Data.String (IsString (..), unwords, words)
import Prelude hiding (Word, (<>))

-- Use the build from GHC.Exts because GHC has some rules that make it faster.
import GHC.Exts (build)

{- | @'chunksOf' n@ splits a list into length-n pieces.  The last
   piece will be shorter if @n@ does not evenly divide the length of
   the list.  If @n <= 0@, @'chunksOf' n l@ returns an infinite list
   of empty lists.  For example:

   Note that @'chunksOf' n []@ is @[]@, not @[[]]@.  This is
   intentional, and is consistent with a recursive definition of
   'chunksOf'; it satisfies the property that

   @chunksOf n xs ++ chunksOf n ys == chunksOf n (xs ++ ys)@

   whenever @n@ evenly divides the length of @xs@.
-}
chunksOf :: Int -> [e] -> [[e]]
chunksOf i ls = map (take i) (build (splitter ls))
 where
  splitter :: [e] -> ([e] -> a -> a) -> a -> a
  splitter [] _ n = n
  splitter l c n = l `c` splitter (drop i l) c n

{- | The basic data type.  A box has a specified size and some sort of
   contents.
-}
data Box = Box
  { rows :: Int
  , cols :: Int
  , content :: Content
  }
  deriving (Show)

-- | Contents of a box.
data Content
  = -- | No content.
    Blank
  | -- | A raw string.
    Text String
  | -- | A row of sub-boxes.
    Row [Box]
  | -- | A column of sub-boxes.
    Col [Box]
  | -- | A sub-box with a specified alignment.
    SubBox Alignment Alignment Box
  deriving (Show)

-- | Convenient ability to use bare string literals as boxes.
instance IsString Box where
  fromString = text

-- | Data type for specifying the alignment of boxes.
data Alignment
  = -- | Align at the top/left.
    AlignTopLeft
  | -- | Centered, biased to the top/left.
    AlignCenter1
  | -- | Centered, biased to the bottom/right.
    AlignCenter2
  | -- | Align at the bottom/right.
    AlignLast
  deriving (Eq, Read, Show)

{- | The null box, which has no content and no size.  It is quite
   useless.
-}
nullBox :: Box
nullBox = emptyBox 0 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 r c = Box r c Blank

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

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

{- | Paste two boxes together horizontally, using a default (top)
   alignment.
-}
(<>) :: Box -> Box -> Box
l <> r = hcat AlignTopLeft [l, r]

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

{- | Paste two boxes together vertically, using a default (left)
   alignment.
-}
(//) :: Box -> Box -> Box
t // b = vcat AlignTopLeft [t, b]

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

-- | Glue a list of boxes together horizontally, with the given alignment.
hcat :: Foldable f => Alignment -> f Box -> Box
hcat a bs = Box h w (Row $ map (alignVert a h) bsl)
 where
  (w, h) = sumMax cols 0 rows bsl
  bsl = toList 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 sep a bs = punctuateH a (emptyBox 0 sep) bs

-- | Glue a list of boxes together vertically, with the given alignment.
vcat :: Foldable f => Alignment -> f Box -> Box
vcat a bs = Box h w (Col $ map (alignHoriz a w) bsl)
 where
  (h, w) = sumMax rows 0 cols bsl
  bsl = toList 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 f defaultMax g as = foldr go (,) as 0 defaultMax
 where
  go a r n b = (r $! f a + n) $! g a `max` 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 sep a bs = punctuateV a (emptyBox sep 0) (toList 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 a p bs = hcat a (intersperse p (toList bs))

-- | A vertical version of 'punctuateH'.
punctuateV :: Foldable f => Alignment -> Box -> f Box -> Box
punctuateV a p bs = vcat a (intersperse p (toList 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 a n t = (\ss -> mkParaBox a (length ss) ss) $ flow n 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 a w h t = map (mkParaBox a h) . chunksOf h $ flow w 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 a n = alignVert AlignTopLeft n . vcat a . map text

-- | Flow the given text into the given width.
flow :: Int -> String -> [String]
flow n t =
  map (take n)
    . getLines
    $ foldl' addWordP (emptyPara n) (map mkWord . words $ t)

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

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

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

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

mkLine :: [Word] -> Line
mkLine ws = Line (sum (map ((+ 1) . wLen) ws) - 1) ws

startLine :: Word -> Line
startLine = mkLine . (: [])

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

mkWord :: String -> Word
mkWord w = Word (length w) w

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))

addWordL :: Word -> Line -> Line
addWordL w (Line len ws) = Line (len + wLen w + 1) (w : ws)

wordFits :: Int -> Word -> Line -> Bool
wordFits pw w l = lLen l == 0 || lLen l + wLen w + 1 <= 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 a c b = align a AlignTopLeft (rows b) c 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 a r b = align AlignTopLeft a r (cols b) 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 ah av r c = Box r c . SubBox ah 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 n b = alignVert AlignTopLeft (rows b + n) 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 n b = alignVert AlignLast (rows b + n) 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 n b = alignHoriz AlignTopLeft (cols b + n) 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 n b = alignHoriz AlignLast (cols b + n) b

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

{- | Render a 'Box' as a String, suitable for writing to the screen or
   a file.
-}
render :: Box -> String
render = unlines . 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 _ n _ | n <= 0 = []
takeP b n [] = replicate n b
takeP b n (x : xs) = x : takeP b (n -1) 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 c b n = glue . (takeP b (numRev c n) *** takeP b (numFwd c n)) . split
 where
  split t = first reverse . splitAt (numRev c (length t)) $ t
  glue = uncurry (++) . first reverse
  numFwd AlignTopLeft n = n
  numFwd AlignLast _ = 0
  numFwd AlignCenter1 n = n `div` 2
  numFwd AlignCenter2 n = (n + 1) `div` 2
  numRev AlignTopLeft _ = 0
  numRev AlignLast n = n
  numRev AlignCenter1 n = (n + 1) `div` 2
  numRev AlignCenter2 n = n `div` 2

-- | Generate 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, using a given number of rows.
renderBoxWithRows :: Int -> Box -> [String]
renderBoxWithRows r b = renderBox (b{rows = r})

-- | Render a box as a list of lines, using 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 given alignments.
resizeBoxAligned :: Int -> Int -> Alignment -> Alignment -> [String] -> [String]
resizeBoxAligned r c ha va = takePA va (blanks c) r . map (takePA ha ' ' c)

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

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

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

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

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

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

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