    {-
    Copyright (C) 2007 John MacFarlane <jgm@berkeley.edu>

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
    -}

    {- |
       Module      : Text.Pandoc.Blocks
       Copyright   : Copyright (C) 2007 John MacFarlane
       License     : GNU GPL, version 2 or above

       Maintainer  : John MacFarlane <jgm@berkeley.edu>
       Stability   : alpha
       Portability : portable

    Functions for the manipulation of fixed-width blocks of text.
    These are used in the construction of plain-text tables.
    -}

    module Text.Pandoc.Blocks
                   (
                    TextBlock (..),
                    docToBlock,
                    blockToDoc,
                    widthOfBlock,
                    heightOfBlock,
                    hcatBlocks,
                    hsepBlocks,
                    centerAlignBlock,
                    leftAlignBlock,
                    rightAlignBlock
                   )
    where
    import Text.PrettyPrint
    import Data.List ( intersperse )

    -- | A fixed-width block of text.  Parameters are width of block,
    -- height of block, and list of lines.
    data TextBlock = TextBlock Int Int [String]
    instance Show TextBlock where
      show x = show $ blockToDoc x

    -- | Break lines in a list of lines so that none are greater than
    -- a given width.
    breakLines :: Int      -- ^ Maximum length of lines.
               -> [String] -- ^ List of lines.
               -> [String]
    breakLines _ [] = []
    breakLines width (l:ls) =
      if length l > width
         then (take width l):(breakLines width ((drop width l):ls))
         else l:(breakLines width ls)

    -- | Convert a @Doc@ element into a @TextBlock@ with a specified width.
    docToBlock :: Int  -- ^ Width of text block.
               -> Doc  -- ^ @Doc@ to convert.
               -> TextBlock
    docToBlock width doc =
      let rendered    = renderStyle (style {lineLength = width,
                                            ribbonsPerLine = 1}) doc
          lns         = breakLines width $ lines rendered
      in  TextBlock width (length lns) lns

    -- | Convert a @TextBlock@ to a @Doc@ element.
    blockToDoc :: TextBlock -> Doc
    blockToDoc (TextBlock _ _ lns) =
      if null lns
         then empty
         else vcat $ map text lns

    -- | Returns width of a @TextBlock@ (number of columns).
    widthOfBlock :: TextBlock -> Int
    widthOfBlock (TextBlock width _ _) = width

    -- | Returns height of a @TextBlock@ (number of rows).
    heightOfBlock :: TextBlock -> Int
    heightOfBlock (TextBlock _ height _) = height

    -- | Pads a string out to a given width using spaces.
    hPad :: Int     -- ^ Desired width.
         -> String  -- ^ String to pad.
         -> String
    hPad width line =
      let linelen = length line
      in  if linelen <= width
             then line ++ replicate (width - linelen) ' '
             else take width line

    -- | Concatenates a list of @TextBlock@s into a new @TextBlock@ in
    -- which they appear side by side.
    hcatBlocks :: [TextBlock] -> TextBlock
    hcatBlocks [] = TextBlock 0 0 []
    hcatBlocks [x] = x -- This is not redundant!  We don't want last item hPad'd.
    hcatBlocks ((TextBlock width1 height1 lns1):xs) =
      let (TextBlock width2 height2 lns2) = hcatBlocks xs
          height = max height1 height2
          width  = width1 + width2
          lns1'  = map (hPad width1) $ lns1 ++ replicate (height - height1) ""
          lns2'  = lns2 ++ replicate (height - height2) ""
          lns    = zipWith (++) lns1' lns2'
       in TextBlock width height lns

    -- | Like @hcatBlocks@, but inserts space between the @TextBlock@s.
    hsepBlocks :: [TextBlock] -> TextBlock
    hsepBlocks = hcatBlocks . (intersperse (TextBlock 1 1 [" "]))

    isWhitespace :: Char -> Bool
    isWhitespace x = x `elem` " \t"

    -- | Left-aligns the contents of a @TextBlock@ within the block.
    leftAlignBlock :: TextBlock -> TextBlock
    leftAlignBlock (TextBlock width height lns) =
      TextBlock width height $ map (dropWhile isWhitespace) lns

    -- | Right-aligns the contents of a @TextBlock@ within the block.
    rightAlignBlock :: TextBlock -> TextBlock
    rightAlignBlock (TextBlock width height lns) =
      let rightAlignLine ln =
            let (spaces, rest) = span isWhitespace $ reverse $ hPad width ln
            in  reverse (rest ++ spaces)
      in  TextBlock width height $ map rightAlignLine lns

    -- | Centers the contents of a @TextBlock@ within the block.
    centerAlignBlock :: TextBlock -> TextBlock
    centerAlignBlock (TextBlock width height lns) =
      let centerAlignLine ln =
            let ln' = hPad width ln
                (startSpaces, rest) = span isWhitespace ln'
                endSpaces = takeWhile isWhitespace (reverse ln')
                numSpaces = length (startSpaces ++ endSpaces)
                startSpaces' = replicate (quot numSpaces 2) ' '
            in  startSpaces' ++ rest
      in  TextBlock width height $ map centerAlignLine lns