-- | Common definitions (and support functions) for rendering a
-- 'KVITable'.

module Data.KVITable.Render
  (
    RenderConfig(..)
  , defaultRenderConfig
  , sortWithNums
  )
where

import           Data.KVITable
import qualified Data.List as L
import           Data.Text ( Text )
import qualified Data.Text as T

-- | Returns the default rendering configuration, to be used with a
-- format-specific @render@ call.

defaultRenderConfig :: RenderConfig
defaultRenderConfig :: RenderConfig
defaultRenderConfig = RenderConfig
  { hideBlankRows :: Bool
hideBlankRows = Bool
True
  , hideBlankCols :: Bool
hideBlankCols = Bool
True
  , equisizedCols :: Bool
equisizedCols = Bool
True
  , sortKeyVals :: Bool
sortKeyVals   = Bool
False
  , colStackAt :: Maybe KeyVal
colStackAt    = Maybe KeyVal
forall a. Maybe a
Nothing
  , rowRepeat :: Bool
rowRepeat     = Bool
True
  , rowGroup :: [KeyVal]
rowGroup      = []
  , caption :: Maybe KeyVal
caption       = Maybe KeyVal
forall a. Maybe a
Nothing
  }

-- | The 'RenderConfig' specifies the various controls and
-- configurations used when rendering a 'KVITable' in various formats.
-- The 'RenderConfig' is global t oall formats, although some of the
-- fields in the 'RenderConfig' will be ignored as not-applicable by
-- some formats.

data RenderConfig = RenderConfig
  {
    RenderConfig -> Bool
hideBlankRows :: Bool
    -- ^ 'True' (default) removes rows for which there are no values

  , RenderConfig -> Bool
hideBlankCols :: Bool
    -- ^ 'True' (default) removes columns for which there are no values

  , RenderConfig -> Bool
equisizedCols :: Bool
    -- ^ 'True' (default) to maintain a consistent column width,
    -- otherwise the columns are shunk to the minimum size needed to
    -- display the title and values.  Not applicable for some backends
    -- (e.g. HTML) where the backend provides table rendering
    -- functionality.

  , RenderConfig -> Bool
sortKeyVals :: Bool
    -- ^ 'True' (default is False) to sort the KeyVal entries when
    -- rendering a table.

  , RenderConfig -> Maybe KeyVal
colStackAt :: Maybe Key
    -- ^ Column key to begin stacking keys in columns and sub-columns
    -- rather than creating additional sub-rows.

  , RenderConfig -> Bool
rowRepeat :: Bool
    -- ^ 'True' (default) if an identical 'KeyVal' is to be repeated
    -- in subsequent applicable rows.

  , RenderConfig -> [KeyVal]
rowGroup :: [Key]
    -- ^ List of Key names that should by grouped by inserting
    -- horizontal row lines between KeyVals

  , RenderConfig -> Maybe KeyVal
caption :: Maybe Text
    -- ^ Caption to render for table for backends which support
    -- captions; otherwise ignored.
  }



-- | Sorting for KeyVals.  If the value starts or ends with a digit,
-- then this should do a rough numeric sort on the expectation that
-- the digits represent a version or some other numeric value.  As an
-- approximation of a numeric sort, sort by word size and then string
-- value.  This will result in [ "1", "2", "10", "50", "400" ], but
-- would fail with [ "v1.0", "v2.0", "v3.0", "v2.0.5", "v1.0.0.3" ],
-- but it's a reasonably fast heuristic and probably better than a
-- straight ascii sort.
--
-- This function is used by the 'KVITable' rendering functions.

sortWithNums :: [KeyVal] -> [KeyVal]
sortWithNums :: [KeyVal] -> [KeyVal]
sortWithNums [KeyVal]
kvs =
  let skvs :: [(Int, KeyVal)]
skvs = [Int] -> [KeyVal] -> [(Int, KeyVal)]
forall a b. [a] -> [b] -> [(a, b)]
zip (KeyVal -> Int
rank (KeyVal -> Int) -> [KeyVal] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyVal]
kvs) [KeyVal]
kvs
      rank :: KeyVal -> Int
rank KeyVal
e = if (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ KeyVal -> Bool
T.null KeyVal
e) Bool -> Bool -> Bool
&&
                  [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [ HasCallStack => KeyVal -> Char
KeyVal -> Char
T.head KeyVal
e Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'0'..Char
'9']
                     , HasCallStack => KeyVal -> Char
KeyVal -> Char
T.last KeyVal
e Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'0'..Char
'9']
                     ]
               then KeyVal -> Int
T.length KeyVal
e
               else Int
0
  in (Int, KeyVal) -> KeyVal
forall a b. (a, b) -> b
snd ((Int, KeyVal) -> KeyVal) -> [(Int, KeyVal)] -> [KeyVal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, KeyVal)] -> [(Int, KeyVal)]
forall a. Ord a => [a] -> [a]
L.sort [(Int, KeyVal)]
skvs