{-|
Module      : FWTabulation
Description : Presentation of tables in a two-dimensional fixed-width font form.
Copyright   : © Thor Michael Støre, 2015
License     : GPL v2 without "any later version" clause
Maintainer  : thormichael át gmail døt com
Stability   : experimental

Presentation of tables in a two-dimensional fixed-width font form.
-}
module Database.HaskRel.FWTabulation (
  -- * Presentation functions
  present1LineValue, presentNLineValue,
  -- * Utility functions
  maxLen, padTranspose ) where

import Data.List ( intercalate )

-- | Given two lists of orderables, produces a list of equal length where each element is that which is the maximum of those elements that are in the same position in the two input lists.
maxLen :: Ord b => [b] -> [b] -> [b]
maxLen = zipWith max


buildOneColumn :: Int -> String -> String -> String
buildOneColumn hPad a str = str ++ a ++ concat ( replicate ( hPad - length a ) " " )

buildColumns :: [Int] -> [String] -> String
buildColumns [] [] = ""
buildColumns [p] [t] = buildOneColumn p t ""
buildColumns (p:ps) (t:ts) = buildColumns' (p:ps) (t:ts) ""

buildColumns [] [t] = buildOneColumn 0 t ""
buildColumns [] (t:ts) = buildColumns' [] (t:ts) ""

buildColumns [p] [] = buildOneColumn p "" "Internal Error: "
buildColumns (p:ps) [] = buildColumns' (p:ps) [] ""

buildColumns' :: [Int] -> [String] -> String -> String
buildColumns' [] [] str = str
buildColumns' [p] [t] str = buildOneColumn p t str
buildColumns' (p:ps) (t:ts) str = buildColumns' ps ts $ buildOneColumn p t str ++ " │ "

-- These error messages stem from before HList was used and a less disciplined form was used instead, they should be impossible to trigger today barring the introduction of bugs.
-- These are pure presentation functions, so it's okay to just inform of the error rather than programmatically signaling it
buildColumns' [] [t] str = str ++ "Internal Error: " ++ t
buildColumns' [] (t:ts) str = str ++ "Internal Error: " ++ intercalate " │ " (t:ts)

buildColumns' [p] [] str = str ++ "Internal Error: " ++ show p
buildColumns' (p:ps) [] str = str ++ "Internal Error: " ++ intercalate " │ " ( map show $ p:ps )


-- | Gets the maximum length of each column of a value consisting of a header and a single line
colWidths ::
  (Foldable t, Foldable t1) =>
  [[t1 a1]] -> [t a] -> [Int]
colWidths l hdr = foldl1 maxLen [ map length hdr, allColWidths l ]

-- | Gets the width of the columns of a value in when presented in a columnar format.
allColWidths :: Foldable t => [[t a]] -> [Int]
allColWidths = map $ maximum . map length

-- | Gets the maximum length of each column of a value consisting of a header and zero or more lines
nColWidths :: (Foldable t, Foldable t1) => [[[t1 a1]]] -> [t a] -> [Int]
nColWidths ll hdr = foldl1 maxLen $ map length hdr : mapListLen ll

mapListLen :: Foldable t => [[[t a]]] -> [[Int]]
mapListLen = map allColWidths

-- See also: http://en.wikipedia.org/wiki/Box-drawing_character
-- | Builds a one-line representation of a value, plus header
present1LineValue :: [[String]] -> [String] -> [String]
present1LineValue strRep header =
  let hPad = colWidths strRep header
   in
  [ "┌─" ++ hPadTable hPad "─" "─┬─" ++ "─┐",
    "│ " ++ buildColumns hPad header ++ " │",
    "├─" ++ hPadTable hPad "─" "─┼─" ++ "─┤"]
 ++ buildRow hPad strRep ++
  [ "└─" ++ hPadTable hPad "─" "─┴─" ++ "─┘"]

-- | Builds a multi-line representation of a value, plus header
presentNLineValue :: [[[String]]] -> [String] -> [String]
presentNLineValue strRepList' hdr =
  let
    hPad = nColWidths strRepList' hdr
  in
    [ "┌─" ++ hPadTable hPad "─" "─┬─" ++ "─┐",
      "│ " ++ buildColumns hPad hdr ++ " │",
-- Classic double-line for candidate key, doesn't always display correctly:
      "╞═" ++ hPadTable hPad "═" "═╪═" ++ "═╡" ]
-- Strong line for candidate key, also doesn't always display correctly:
--      "┝━" ++ hPadTable hPad "━" "━┿━" ++ "━┥" ]
-- No indication of candidate key, seems to work in more cases:
--      "├─" ++ hPadTable hPad "─" "─┼─" ++ "─┤"]
   ++ foldr (\a b -> buildRow hPad a ++ b ) [] strRepList' ++ 
    [ "└─" ++ hPadTable hPad "─" "─┴─" ++ "─┘" ]

buildRow :: [Int] -> [[String]] -> [String]
buildRow hPad strRep = buildRow' hPad $ padTranspose strRep

buildRow' :: [Int] -> [[String]] -> [String]
buildRow' _ [] = ["│  │"]
buildRow' hPad [strRep] = ["│ " ++ buildColumns hPad strRep ++ " │"]
buildRow' hPad (strRep:strRepX) = ( "│ " ++ buildColumns hPad strRep ++ " │" ) : buildRow' hPad strRepX


-- | Transposes a list of lists of lists, padding the lists of the second dimension with empty lists if they are shorter than the other rows.
padTranspose :: [[[t]]] -> [[[t]]]
padTranspose x = padTranspose' x ( maximum ( map length x ) - 1 )

padTranspose' :: [[[t]]] -> Int -> [[[t]]]
padTranspose' [] _ = []
padTranspose' ([] : xss) l = padTranspose' xss ( l - 1 )
padTranspose' ((x:xs) : xss) l = (x : map next xss) : padTranspose' (rPad l xs : map rest xss) ( l - 1 )

--next :: (Monoid a) => [a] -> a
-- | Gives the head of the argument, or the empty list if the argument is empty.
next :: [[t]] -> [t]
next [] = []
next xs = head xs

--rest :: (Monoid a) => [a] -> [a]
-- | Gives the tail of the argument, or the empty list if the argument is empty.
rest :: [t] -> [t]
rest [] = []
rest xs = tail xs

rPad :: Int -> [[t]] -> [[t]]
rPad m xs = xs ++ replicate ( m - length xs ) []

hPadColumn :: Int -> [a] -> [a]
hPadColumn x fillChar = concat ( replicate x fillChar )

hPadTable :: [Int] -> String -> String -> String
hPadTable [] _ _ = ""
hPadTable [x] fillChar _ = hPadColumn x fillChar
hPadTable (x:xs) fillChar divChar = hPadColumn x fillChar ++ divChar ++ hPadTable xs fillChar divChar