{-|
Pretty-print a table in a configurable way.

Using the default configuration, this program:

@
import Hable

main :: IO ()
main = putStr (hable defaultConfig exampleTable)

exampleTable =
    [ [ "one", "two", "three", "Hable" ]
    , [ "hello\nworld", "lorem\nipsum\ndolor\nsit amet", "verryyyyyy llooong", "is"]
    , [ "super", "awesome", "freaking", "amazing" ]
    ]
@

will result in:

@
╔═══════╤══════════╤════════════════════╤═════════╗
║ one   │ two      │ three              │ Hable   ║
╟───────┼──────────┼────────────────────┼─────────╢
║ hello │ lorem    │ verryyyyyy llooong │ is      ║
║ world │ ipsum    │                    │         ║
║       │ dolor    │                    │         ║
║       │ sit amet │                    │         ║
╟───────┼──────────┼────────────────────┼─────────╢
║ super │ awesome  │ freaking           │ amazing ║
╚═══════╧══════════╧════════════════════╧═════════╝
@

See 'Hable.Config' for configuration.

-}


--------------------------------------------------------------------------------

module
    Hable
        ( hable
        , Hable.Config.defaultConfig
        )
  where


--------------------------------------------------------------------------------

import Hable.BoxChar
import Hable.Config

import Data.List
import Data.Traversable


--------------------------------------------------------------------------------

-- | Pretty-prints a row-wise given table using a given Hable Configuration.

hable
    :: Config style -- ^ Hable Configuration
    -> [[String]]   -- ^ Row-wise table to be pretty-printed
    -> String       -- ^ Pretty-printed table

hable config rows =
    concatMap
        (either
            -- insert a horizontal line
            (insertHLine config widths maxHLine maxVLine)
            -- insert a row
            (uncurry (insertRow config widths maxHLine maxVLine)))
        (intersperseIndex rows)
  where
    -- total number of (possible) horizontal lines
    maxHLine = succ (genericLength rows)
    -- total number of (possible) vertical lines
    maxVLine = succ (genericLength (head rows)) -- XXX: handle bad input
    -- list of horizontal widths of actual content of columns
    widths = map
        (maximum . map (maximum . map genericLength . lines))
        (transpose rows)


--------------------------------------------------------------------------------

-- | Respecting the configuration, either inserts a horizontal line or an empty
-- string.

insertHLine
    :: Config style -- Hable Configuration
    -> [Integer]    -- List of widths of each column
    -> Integer      -- Maximal index of horizontal line, i.e. number of rows + 1
    -> Integer      -- Maximal index of vertical   line, i.e. number of rows + 1
    -> Integer      -- Index of current horizontal line which is being written
    -> String       -- Pretty-printed horizontal line

insertHLine config widths maxHLine maxVLine nowHLine =
    -- decide whether horizontal line is desired in config
    maybe
        -- case of no horizontal line
        ""
        -- case of horizontal line
        (\nowHStyle -> concatMap
            (either
                -- case of cross, edge or corner
                (\nowVLine ->
                    -- decide whether vertical line is desired in config
                    maybe
                        -- case of no vertical line
                        ""
                        -- case of vertical line
                        (\nowVStyle -> charset config (Angled
                            (if nowVLine == 1
                                then HRight
                                else if nowVLine < maxVLine
                                    then HCenter
                                    else HLeft)
                            nowVStyle
                            (if nowHLine == 1
                                then VBottom
                                else if nowHLine < maxHLine
                                    then VCenter
                                    else VTop)
                            nowHStyle
                        ))
                        -- determine desired horizontal style
                        (vLineStyle config maxVLine nowVLine))
                -- case of inner horizontal line
                (\(nowVLine, _) ->
                    concat (genericReplicate
                        -- length of horizontal line
                        (hPadding config * 2 + genericIndex widths (nowVLine-1))
                        -- horizontal character shape
                        (charset config (Dash nowHStyle)))))
            (intersperseIndex [1..maxVLine-1]) ++ "\n")
        -- determine desired horizontal style
        (hLineStyle config maxHLine nowHLine)


--------------------------------------------------------------------------------

-- | Respecting the configuration, inserts the content of a row.

insertRow
    :: Config style -- Hable Configuration
    -> [Integer]    -- List of widths of each colum
    -> Integer      -- Maximal index of horizontal line, i.e. number of rows + 1
    -> Integer      -- Maximal index of vertical   line, i.e. number of rows + 1
    -> Integer      -- Index of current horizontal line which is being written
    -> [String]     -- Content of current row
    -> String       -- Pretty-printed row

insertRow config widths maxHLine maxVLine nowHLine row =
    unlines ((map concat . transpose) (map
        (either
            -- insert vertical line
            (\nowVLine ->
                    -- decide whether vertical line is desired in config
                    maybe
                        -- case of no vertical line
                        [""]
                        -- case of vertical line
                        (\nowVStyle -> genericReplicate height
                            (charset config (Bar nowVStyle)))
                        -- determine desired vertical style
                        (vLineStyle config maxVLine nowVLine))
            -- insert cell content
            (\(nowVLine, cell) ->
                let
                    -- calculate number of missing blank lines for vertical
                    -- alignment
                    (top, bottom) = align
                        (vAlign config nowVLine)
                        height
                        (genericLength (lines cell))
                    -- such a blank line
                    blankLine = genericReplicate
                        -- inner width
                        (2 * hPadding config + genericIndex widths (nowVLine-1))
                        ' '
                in
                    concat
                        -- insert bottom filling area
                        [ genericReplicate top blankLine
                        -- insert content
                        , map
                            (\line -> concat
                                -- insert left padding
                                [ genericReplicate (hPadding config) ' '
                                , let
                                    -- calculate number of missing spaces for
                                    -- horizontal alignment
                                    (left, right) = align
                                        (hAlign config nowHLine)
                                        (genericIndex widths (nowVLine-1))
                                        (genericLength line)
                                in
                                    concat
                                        -- insert missing spaces on the left
                                        [ genericReplicate left  ' '
                                        -- insert line of content
                                        , line
                                        -- insert missing spaces on the right
                                        , genericReplicate right ' '
                                        ]
                                -- insert right padding
                                , genericReplicate (hPadding config) ' '
                                ])
                            (lines cell)
                        -- insert top filling area
                        , genericReplicate bottom blankLine
                        ]))
        (intersperseIndex row)))
  where
    -- height of the contents of this row
    height = maximum (map (genericLength . lines) row)



--------------------------------------------------------------------------------

-- | An example:
--
-- >>> intersperseIndex "abc"
-- [Left 1,Right (1,'a'),Left 2,Right (2,'b'),Left 3,Right (3,'c'),Left 4]
--
-- I.e. it adds the index to each element of the given list using pairs and
-- adds the index of an element right before it and notably also at the and of
-- the list, if you know what I mean.

intersperseIndex
    :: [b]
    -> [Either Integer (Integer, b)]

intersperseIndex = helper 1
  where
    helper i []     = [Left i]
    helper i (b:bs) = Left i : Right (i, b) : helper (succ i) bs


--------------------------------------------------------------------------------

-- | The first argument has to be either of type 'HAxis' or 'VAxis'.
--
-- In case of 'HAxis', calculates the missing spaces on the left and right to
-- horizontally align a content with the given aimed width and the actual width.
--
-- In case of 'VAxis', calculates the missing blank lines at the top and
-- bottom to vertically align a content with the given aimed width and the
-- actual width.

align
    :: Enum t => t
    -> Integer
    -> Integer
    -> (Integer, Integer)

align a aimedSize actualSize
    | e == 0 -- top / left
    = (0, aimedSize-actualSize)
    | e == 1 -- center
    = (dv, dv+md)
    | otherwise -- e == 2 -- bottom / left
    = (aimedSize-actualSize, 0)
  where
    e = fromEnum a
    (dv, md) = (aimedSize - actualSize) `divMod` 2