{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Data.KVITable.Render.Internal where

import qualified Data.List as L
import           Data.Name ( ConvertName, UTF8 )
import           Data.String ( fromString )
import           Numeric.Natural

import           Data.KVITable
import           Data.KVITable.Internal.Helpers
import           Data.KVITable.Render


-- TODO: to allow for hideBlankCols, the KVITable should keep track of what the
-- pre-declared vals for each key are v.s. what additional vals may be set by
-- setting a value in that region.  Then there is enough information here
-- (without re-scanning the table) to properly compute the keyvals that should be
-- displayed (which would also mean that the hideCols/hideRows determinations in
-- the rendering functions below are no longer needed.

data TblHdr = V (KeyVal) | AndMore Natural

type TblHdrs = [ (Key, [TblHdr]) ]

-- | Returns the rows and columns KeyVals, with appropriate application of
-- RenderConfig specifications: colStackAt, maxCells, maxCols.  Does not collapse
-- empty rows or columns.

renderingKeyVals :: RenderConfig
                 -> KeyVals
                 -> (TblHdrs, TblHdrs)
renderingKeyVals :: RenderConfig -> KeyVals -> (TblHdrs, TblHdrs)
renderingKeyVals RenderConfig
cfg KeyVals
inpKvs =
  let maxNumKeys :: Natural
maxNumKeys = RenderConfig -> Natural
maxCells RenderConfig
cfg
      origNumKeys :: Natural
origNumKeys = Int -> Natural
forall a. Enum a => Int -> a
toEnum (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ KeyVals -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length KeyVals
inpKvs
      maxNumCols :: Natural
maxNumCols = Natural -> Natural -> Natural
forall a. Ord a => a -> a -> a
min (RenderConfig -> Natural
maxCells RenderConfig
cfg) (RenderConfig -> Natural
maxCols RenderConfig
cfg)

  in case RenderConfig -> Maybe Key
colStackAt RenderConfig
cfg of
       Maybe Key
Nothing ->
         -- width is just keys, height is combination of keys and values
         let okKvs :: TblHdrs
okKvs = if Natural
origNumKeys Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
maxNumKeys
                     then TblHdrs -> (Key, [TblHdr]) -> TblHdrs
forall a. [a] -> a -> [a]
snoc (Int -> TblHdrs -> TblHdrs
forall a. Int -> [a] -> [a]
take (Natural -> Int
forall a. Enum a => a -> Int
fromEnum Natural
maxNumKeys) ((TblHdrs, TblHdrs) -> TblHdrs
forall a b. (a, b) -> a
fst (TblHdrs, TblHdrs)
kvs))
                          (String -> Key
forall a. IsString a => String -> a
fromString
                           (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ String
"{+ " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Natural -> String
forall a. Show a => a -> String
show (Natural
origNumKeys Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
maxNumKeys) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" MORE}"
                          , [TblHdr]
forall a. Monoid a => a
mempty
                          )
                     else ((TblHdrs, TblHdrs) -> TblHdrs
forall a b. (a, b) -> a
fst (TblHdrs, TblHdrs)
kvs)
             -- n.b. maxCols is not really useful here, since all but the last
             -- column are headers and values are only shown in that last column.
         in (((Natural, Natural), TblHdrs) -> TblHdrs
forall a b. (a, b) -> b
snd (((Natural, Natural), TblHdrs) -> TblHdrs)
-> ((Natural, Natural), TblHdrs) -> TblHdrs
forall a b. (a -> b) -> a -> b
$ Bool
-> Natural -> Natural -> TblHdrs -> ((Natural, Natural), TblHdrs)
forall {p} {a}.
p
-> Natural
-> Natural
-> [(a, [TblHdr])]
-> ((Natural, Natural), [(a, [TblHdr])])
trimStacked Bool
True Natural
1 Natural
maxNumKeys TblHdrs
okKvs, [])
       Just Key
_c ->
         let (TblHdrs
kvsRows, TblHdrs
kvsCols) = (TblHdrs, TblHdrs)
kvs
             numRegularColKvs :: Natural
numRegularColKvs = let v :: Int
v = KeyVals -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length KeyVals
inpKvs Int -> Int -> Int
forall a. Num a => a -> a -> a
- TblHdrs -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length TblHdrs
kvsCols
                                in if Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then String -> Natural
forall a. HasCallStack => String -> a
error String
"BAD1" else Int -> Natural
forall a. Enum a => Int -> a
toEnum Int
v
             numStackedCols :: Natural
numStackedCols = TblHdrs -> Natural
forall {a} {a}. [(a, [a])] -> Natural
countStacked TblHdrs
kvsCols
             origNumCols :: Natural
origNumCols = Natural
numRegularColKvs Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
numStackedCols
             allowedNumCols :: Natural
allowedNumCols = Natural -> Natural -> Natural -> Natural
forall {p}. (Ord p, Num p) => p -> p -> p -> p
subOrDef Natural
1 Natural
maxNumCols Natural
numRegularColKvs
             okKvsCols :: TblHdrs
okKvsCols = if Natural
origNumCols Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
maxNumCols
                      then if Natural
numStackedCols Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
maxNumCols
                           then TblHdrs
kvsCols
                           else ((Natural, Natural), TblHdrs) -> TblHdrs
forall a b. (a, b) -> b
snd (((Natural, Natural), TblHdrs) -> TblHdrs)
-> ((Natural, Natural), TblHdrs) -> TblHdrs
forall a b. (a -> b) -> a -> b
$ Bool
-> Natural -> Natural -> TblHdrs -> ((Natural, Natural), TblHdrs)
forall {p} {a}.
p
-> Natural
-> Natural
-> [(a, [TblHdr])]
-> ((Natural, Natural), [(a, [TblHdr])])
trimStacked Bool
False Natural
1 Natural
allowedNumCols TblHdrs
kvsCols
                      else TblHdrs
kvsCols
             allowedNumRows :: Natural
allowedNumRows = Natural -> Natural -> Natural -> Natural
forall {p}. (Ord p, Num p) => p -> p -> p -> p
subOrDef Natural
1 (RenderConfig -> Natural
maxCells RenderConfig
cfg)
                           (if Natural
origNumCols Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
maxNumCols
                             then if Natural
numStackedCols Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
maxNumCols
                                  then Natural
numStackedCols
                                  else Natural
allowedNumCols
                             else Natural
numStackedCols
                           )
             eachRowCols :: Natural
eachRowCols = Natural -> Natural -> Natural
forall a. Ord a => a -> a -> a
min Natural
maxNumCols Natural
numStackedCols
             okKvsRows :: TblHdrs
okKvsRows = ((Natural, Natural), TblHdrs) -> TblHdrs
forall a b. (a, b) -> b
snd (((Natural, Natural), TblHdrs) -> TblHdrs)
-> ((Natural, Natural), TblHdrs) -> TblHdrs
forall a b. (a -> b) -> a -> b
$ Bool
-> Natural -> Natural -> TblHdrs -> ((Natural, Natural), TblHdrs)
forall {p} {a}.
p
-> Natural
-> Natural
-> [(a, [TblHdr])]
-> ((Natural, Natural), [(a, [TblHdr])])
trimStacked Bool
False Natural
eachRowCols Natural
allowedNumRows TblHdrs
kvsRows
         in (TblHdrs
okKvsRows, TblHdrs
okKvsCols)

  where

    -- subtracting Naturals must be done carefully to not allow the result to be
    -- < 0; a post-subtraction max is not enough to protect against the initial
    -- value.
    subOrDef :: p -> p -> p -> p
subOrDef p
d p
a p
b = if p
a p -> p -> Bool
forall a. Ord a => a -> a -> Bool
< p
b then p
d else p
a p -> p -> p
forall a. Num a => a -> a -> a
- p
b

    kvs :: (TblHdrs, TblHdrs)
kvs = let kvs' :: (KeyVals, KeyVals)
kvs' = case RenderConfig -> Maybe Key
colStackAt RenderConfig
cfg of
                       Maybe Key
Nothing -> (KeyVals
inpKvs, KeyVals
forall a. Monoid a => a
mempty)
                       Just Key
c -> ((Key, [KeyVal]) -> Bool) -> KeyVals -> (KeyVals, KeyVals)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
/= Key
c) (Key -> Bool)
-> ((Key, [KeyVal]) -> Key) -> (Key, [KeyVal]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key, [KeyVal]) -> Key
forall a b. (a, b) -> a
fst) KeyVals
inpKvs
              ksrt :: (KeyVals, KeyVals)
ksrt = case RenderConfig -> Maybe ((KeyVals, KeyVals) -> (KeyVals, KeyVals))
sortKeyVals RenderConfig
cfg of
                       Maybe ((KeyVals, KeyVals) -> (KeyVals, KeyVals))
Nothing -> (KeyVals, KeyVals)
kvs'
                       Just (KeyVals, KeyVals) -> (KeyVals, KeyVals)
fn -> (KeyVals, KeyVals) -> (KeyVals, KeyVals)
fn (KeyVals, KeyVals)
kvs'
          in ( ([KeyVal] -> [TblHdr]) -> (Key, [KeyVal]) -> (Key, [TblHdr])
forall a b. (a -> b) -> (Key, a) -> (Key, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((KeyVal -> TblHdr) -> [KeyVal] -> [TblHdr]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KeyVal -> TblHdr
V) ((Key, [KeyVal]) -> (Key, [TblHdr])) -> KeyVals -> TblHdrs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KeyVals, KeyVals) -> KeyVals
forall a b. (a, b) -> a
fst (KeyVals, KeyVals)
ksrt
             , ([KeyVal] -> [TblHdr]) -> (Key, [KeyVal]) -> (Key, [TblHdr])
forall a b. (a -> b) -> (Key, a) -> (Key, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((KeyVal -> TblHdr) -> [KeyVal] -> [TblHdr]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KeyVal -> TblHdr
V) ((Key, [KeyVal]) -> (Key, [TblHdr])) -> KeyVals -> TblHdrs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KeyVals, KeyVals) -> KeyVals
forall a b. (a, b) -> b
snd (KeyVals, KeyVals)
ksrt
             )

    countStacked :: [(a, [a])] -> Natural
countStacked = \case -- does not allow for hiddenCols
      [] -> Natural
1
      ((a
_,[a]
vs):[(a, [a])]
r) -> Int -> Natural
forall a. Enum a => Int -> a
toEnum ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [a]
vs) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* [(a, [a])] -> Natural
countStacked [(a, [a])]
r
    trimStacked :: p
-> Natural
-> Natural
-> [(a, [TblHdr])]
-> ((Natural, Natural), [(a, [TblHdr])])
trimStacked p
_ Natural
each Natural
n [] = ((Natural
n,Natural
each), [])
    trimStacked p
_mulSubs Natural
each Natural
n ((a
k,[TblHdr]
vs):[]) =
      let lvs :: Natural
lvs = Int -> Natural
forall a. Enum a => Int -> a
toEnum (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ [TblHdr] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TblHdr]
vs
          mvs :: Natural
mvs = (Natural -> Natural -> Natural) -> Natural -> [Natural] -> Natural
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Natural
a Natural
b -> if Natural
b Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
each Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
n then Natural
b else Natural
a) Natural
1 ([Natural] -> Natural) -> [Natural] -> Natural
forall a b. (a -> b) -> a -> b
$ [Natural
0..Natural
lvs]
          tvs :: [TblHdr]
tvs = [TblHdr] -> TblHdr -> [TblHdr]
forall a. [a] -> a -> [a]
snoc (Int -> [TblHdr] -> [TblHdr]
forall a. Int -> [a] -> [a]
take (Natural -> Int
forall a. Enum a => a -> Int
fromEnum Natural
mvs) [TblHdr]
vs) (TblHdr -> [TblHdr]) -> TblHdr -> [TblHdr]
forall a b. (a -> b) -> a -> b
$ Natural -> TblHdr
AndMore (Natural -> TblHdr) -> Natural -> TblHdr
forall a b. (a -> b) -> a -> b
$ Natural
lvs Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
mvs
          rvs :: [TblHdr]
rvs = if Natural
mvs Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
lvs then [TblHdr]
tvs else [TblHdr]
vs
      in ((Natural -> Natural -> Natural -> Natural
forall {p}. (Ord p, Num p) => p -> p -> p -> p
subOrDef Natural
0 Natural
n Natural
mvs, Natural
mvs Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
each), [(a
k,[TblHdr]
rvs)])
    trimStacked p
mulSubs Natural
each Natural
n ((a
k,[TblHdr]
vs):[(a, [TblHdr])]
rkvs) =
      let lvs :: Natural
lvs = Int -> Natural
forall a. Enum a => Int -> a
toEnum (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ [TblHdr] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TblHdr]
vs
          ((Natural
n',Natural
w), [(a, [TblHdr])]
kvs') = p
-> Natural
-> Natural
-> [(a, [TblHdr])]
-> ((Natural, Natural), [(a, [TblHdr])])
trimStacked p
mulSubs Natural
each Natural
n [(a, [TblHdr])]
rkvs
          mvs :: Natural
mvs = (Natural -> Natural -> Natural) -> Natural -> [Natural] -> Natural
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Natural
a Natural
b -> if Natural
b Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
w Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
n then Natural
b else Natural
a) Natural
1 ([Natural] -> Natural) -> [Natural] -> Natural
forall a b. (a -> b) -> a -> b
$ [Natural
0..Natural
lvs]
          tvs :: [TblHdr]
tvs = [TblHdr] -> TblHdr -> [TblHdr]
forall a. [a] -> a -> [a]
snoc (Int -> [TblHdr] -> [TblHdr]
forall a. Int -> [a] -> [a]
take (Natural -> Int
forall a. Enum a => a -> Int
fromEnum Natural
mvs) [TblHdr]
vs) (TblHdr -> [TblHdr]) -> TblHdr -> [TblHdr]
forall a b. (a -> b) -> a -> b
$ Natural -> TblHdr
AndMore (Natural -> TblHdr) -> Natural -> TblHdr
forall a b. (a -> b) -> a -> b
$ Natural -> [(a, [TblHdr])] -> Natural
forall {t} {t :: * -> *} {a} {a}.
(Num t, Enum t, Foldable t) =>
t -> [(a, t a)] -> t
remcnt (Natural
lvs Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
mvs) [(a, [TblHdr])]
rkvs
          rvs :: [TblHdr]
rvs = if Natural
mvs Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
lvs then [TblHdr]
tvs else [TblHdr]
vs
      in ((Natural -> Natural -> Natural -> Natural
forall {p}. (Ord p, Num p) => p -> p -> p -> p
subOrDef Natural
0 Natural
n' Natural
mvs, Natural
mvs Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
w), (a
k,[TblHdr]
rvs)(a, [TblHdr]) -> [(a, [TblHdr])] -> [(a, [TblHdr])]
forall a. a -> [a] -> [a]
:[(a, [TblHdr])]
kvs')

    remcnt :: t -> [(a, t a)] -> t
remcnt t
n [] = t
n
    remcnt t
n ((a, t a)
rkv:[(a, t a)]
rkvs) = t
n t -> t -> t
forall a. Num a => a -> a -> a
* t -> [(a, t a)] -> t
remcnt (Int -> t
forall a. Enum a => Int -> a
toEnum (Int -> t) -> Int -> t
forall a b. (a -> b) -> a -> b
$ t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((a, t a) -> t a
forall a b. (a, b) -> b
snd (a, t a)
rkv)) [(a, t a)]
rkvs


instance ConvertName UTF8 "Key" "column header"
instance ConvertName UTF8 "KeyVal" "column header"


nLength :: Foldable t => t a -> Natural
nLength :: forall (t :: * -> *) a. Foldable t => t a -> Natural
nLength = Int -> Natural
forall a. Enum a => Int -> a
toEnum (Int -> Natural) -> (t a -> Int) -> t a -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length