{- |
Rich data type to describe data in a table.
This is the basis for ODS and HTML export.
-}
module Hledger.Write.Spreadsheet (
    Type(..),
    Style(..),
    Emphasis(..),
    Cell(..),
    Class(Class), textFromClass,
    Span(..),
    Border(..),
    Lines(..),
    NumLines(..),
    noBorder,
    defaultCell,
    headerCell,
    emptyCell,
    transposeCell,
    transpose,
    horizontalSpan,
    addHeaderBorders,
    addRowSpanHeader,
    rawTableContent,
    cellFromMixedAmount,
    cellsFromMixedAmount,
    cellFromAmount,
    integerCell,
    ) where

import qualified Hledger.Data.Amount as Amt
import Hledger.Data.Types (Amount, MixedAmount, acommodity)
import Hledger.Data.Amount (AmountFormat)

import qualified Data.List as List
import qualified Data.Text as Text
import Data.Text (Text)
import Text.WideString (WideBuilder)

import Prelude hiding (span)


data Type =
      TypeString
    | TypeInteger
    | TypeAmount !Amount
    | TypeMixedAmount
    | TypeDate
    deriving (Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
/= :: Type -> Type -> Bool
Eq, Eq Type
Eq Type =>
(Type -> Type -> Ordering)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Type)
-> (Type -> Type -> Type)
-> Ord Type
Type -> Type -> Bool
Type -> Type -> Ordering
Type -> Type -> Type
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Type -> Type -> Ordering
compare :: Type -> Type -> Ordering
$c< :: Type -> Type -> Bool
< :: Type -> Type -> Bool
$c<= :: Type -> Type -> Bool
<= :: Type -> Type -> Bool
$c> :: Type -> Type -> Bool
> :: Type -> Type -> Bool
$c>= :: Type -> Type -> Bool
>= :: Type -> Type -> Bool
$cmax :: Type -> Type -> Type
max :: Type -> Type -> Type
$cmin :: Type -> Type -> Type
min :: Type -> Type -> Type
Ord, Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Type -> ShowS
showsPrec :: Int -> Type -> ShowS
$cshow :: Type -> String
show :: Type -> String
$cshowList :: [Type] -> ShowS
showList :: [Type] -> ShowS
Show)

data Style = Body Emphasis | Head
    deriving (Style -> Style -> Bool
(Style -> Style -> Bool) -> (Style -> Style -> Bool) -> Eq Style
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Style -> Style -> Bool
== :: Style -> Style -> Bool
$c/= :: Style -> Style -> Bool
/= :: Style -> Style -> Bool
Eq, Eq Style
Eq Style =>
(Style -> Style -> Ordering)
-> (Style -> Style -> Bool)
-> (Style -> Style -> Bool)
-> (Style -> Style -> Bool)
-> (Style -> Style -> Bool)
-> (Style -> Style -> Style)
-> (Style -> Style -> Style)
-> Ord Style
Style -> Style -> Bool
Style -> Style -> Ordering
Style -> Style -> Style
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Style -> Style -> Ordering
compare :: Style -> Style -> Ordering
$c< :: Style -> Style -> Bool
< :: Style -> Style -> Bool
$c<= :: Style -> Style -> Bool
<= :: Style -> Style -> Bool
$c> :: Style -> Style -> Bool
> :: Style -> Style -> Bool
$c>= :: Style -> Style -> Bool
>= :: Style -> Style -> Bool
$cmax :: Style -> Style -> Style
max :: Style -> Style -> Style
$cmin :: Style -> Style -> Style
min :: Style -> Style -> Style
Ord, Int -> Style -> ShowS
[Style] -> ShowS
Style -> String
(Int -> Style -> ShowS)
-> (Style -> String) -> ([Style] -> ShowS) -> Show Style
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Style -> ShowS
showsPrec :: Int -> Style -> ShowS
$cshow :: Style -> String
show :: Style -> String
$cshowList :: [Style] -> ShowS
showList :: [Style] -> ShowS
Show)

data Emphasis = Item | Total
    deriving (Emphasis -> Emphasis -> Bool
(Emphasis -> Emphasis -> Bool)
-> (Emphasis -> Emphasis -> Bool) -> Eq Emphasis
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Emphasis -> Emphasis -> Bool
== :: Emphasis -> Emphasis -> Bool
$c/= :: Emphasis -> Emphasis -> Bool
/= :: Emphasis -> Emphasis -> Bool
Eq, Eq Emphasis
Eq Emphasis =>
(Emphasis -> Emphasis -> Ordering)
-> (Emphasis -> Emphasis -> Bool)
-> (Emphasis -> Emphasis -> Bool)
-> (Emphasis -> Emphasis -> Bool)
-> (Emphasis -> Emphasis -> Bool)
-> (Emphasis -> Emphasis -> Emphasis)
-> (Emphasis -> Emphasis -> Emphasis)
-> Ord Emphasis
Emphasis -> Emphasis -> Bool
Emphasis -> Emphasis -> Ordering
Emphasis -> Emphasis -> Emphasis
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Emphasis -> Emphasis -> Ordering
compare :: Emphasis -> Emphasis -> Ordering
$c< :: Emphasis -> Emphasis -> Bool
< :: Emphasis -> Emphasis -> Bool
$c<= :: Emphasis -> Emphasis -> Bool
<= :: Emphasis -> Emphasis -> Bool
$c> :: Emphasis -> Emphasis -> Bool
> :: Emphasis -> Emphasis -> Bool
$c>= :: Emphasis -> Emphasis -> Bool
>= :: Emphasis -> Emphasis -> Bool
$cmax :: Emphasis -> Emphasis -> Emphasis
max :: Emphasis -> Emphasis -> Emphasis
$cmin :: Emphasis -> Emphasis -> Emphasis
min :: Emphasis -> Emphasis -> Emphasis
Ord, Int -> Emphasis -> ShowS
[Emphasis] -> ShowS
Emphasis -> String
(Int -> Emphasis -> ShowS)
-> (Emphasis -> String) -> ([Emphasis] -> ShowS) -> Show Emphasis
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Emphasis -> ShowS
showsPrec :: Int -> Emphasis -> ShowS
$cshow :: Emphasis -> String
show :: Emphasis -> String
$cshowList :: [Emphasis] -> ShowS
showList :: [Emphasis] -> ShowS
Show)


class Lines border where noLine :: border
instance Lines () where noLine :: ()
noLine = ()
instance Lines NumLines where noLine :: NumLines
noLine = NumLines
NoLine

{- |
The same as Tab.Properties, but has 'Eq' and 'Ord' instances.
We need those for storing 'NumLines' in 'Set's.
-}
data NumLines = NoLine | SingleLine | DoubleLine
    deriving (NumLines -> NumLines -> Bool
(NumLines -> NumLines -> Bool)
-> (NumLines -> NumLines -> Bool) -> Eq NumLines
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NumLines -> NumLines -> Bool
== :: NumLines -> NumLines -> Bool
$c/= :: NumLines -> NumLines -> Bool
/= :: NumLines -> NumLines -> Bool
Eq, Eq NumLines
Eq NumLines =>
(NumLines -> NumLines -> Ordering)
-> (NumLines -> NumLines -> Bool)
-> (NumLines -> NumLines -> Bool)
-> (NumLines -> NumLines -> Bool)
-> (NumLines -> NumLines -> Bool)
-> (NumLines -> NumLines -> NumLines)
-> (NumLines -> NumLines -> NumLines)
-> Ord NumLines
NumLines -> NumLines -> Bool
NumLines -> NumLines -> Ordering
NumLines -> NumLines -> NumLines
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NumLines -> NumLines -> Ordering
compare :: NumLines -> NumLines -> Ordering
$c< :: NumLines -> NumLines -> Bool
< :: NumLines -> NumLines -> Bool
$c<= :: NumLines -> NumLines -> Bool
<= :: NumLines -> NumLines -> Bool
$c> :: NumLines -> NumLines -> Bool
> :: NumLines -> NumLines -> Bool
$c>= :: NumLines -> NumLines -> Bool
>= :: NumLines -> NumLines -> Bool
$cmax :: NumLines -> NumLines -> NumLines
max :: NumLines -> NumLines -> NumLines
$cmin :: NumLines -> NumLines -> NumLines
min :: NumLines -> NumLines -> NumLines
Ord, Int -> NumLines -> ShowS
[NumLines] -> ShowS
NumLines -> String
(Int -> NumLines -> ShowS)
-> (NumLines -> String) -> ([NumLines] -> ShowS) -> Show NumLines
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NumLines -> ShowS
showsPrec :: Int -> NumLines -> ShowS
$cshow :: NumLines -> String
show :: NumLines -> String
$cshowList :: [NumLines] -> ShowS
showList :: [NumLines] -> ShowS
Show)

data Border lines =
    Border {
        forall lines. Border lines -> lines
borderLeft, forall lines. Border lines -> lines
borderRight,
        forall lines. Border lines -> lines
borderTop, forall lines. Border lines -> lines
borderBottom :: lines
    }
    deriving (Border lines -> Border lines -> Bool
(Border lines -> Border lines -> Bool)
-> (Border lines -> Border lines -> Bool) -> Eq (Border lines)
forall lines. Eq lines => Border lines -> Border lines -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall lines. Eq lines => Border lines -> Border lines -> Bool
== :: Border lines -> Border lines -> Bool
$c/= :: forall lines. Eq lines => Border lines -> Border lines -> Bool
/= :: Border lines -> Border lines -> Bool
Eq, Eq (Border lines)
Eq (Border lines) =>
(Border lines -> Border lines -> Ordering)
-> (Border lines -> Border lines -> Bool)
-> (Border lines -> Border lines -> Bool)
-> (Border lines -> Border lines -> Bool)
-> (Border lines -> Border lines -> Bool)
-> (Border lines -> Border lines -> Border lines)
-> (Border lines -> Border lines -> Border lines)
-> Ord (Border lines)
Border lines -> Border lines -> Bool
Border lines -> Border lines -> Ordering
Border lines -> Border lines -> Border lines
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall lines. Ord lines => Eq (Border lines)
forall lines. Ord lines => Border lines -> Border lines -> Bool
forall lines. Ord lines => Border lines -> Border lines -> Ordering
forall lines.
Ord lines =>
Border lines -> Border lines -> Border lines
$ccompare :: forall lines. Ord lines => Border lines -> Border lines -> Ordering
compare :: Border lines -> Border lines -> Ordering
$c< :: forall lines. Ord lines => Border lines -> Border lines -> Bool
< :: Border lines -> Border lines -> Bool
$c<= :: forall lines. Ord lines => Border lines -> Border lines -> Bool
<= :: Border lines -> Border lines -> Bool
$c> :: forall lines. Ord lines => Border lines -> Border lines -> Bool
> :: Border lines -> Border lines -> Bool
$c>= :: forall lines. Ord lines => Border lines -> Border lines -> Bool
>= :: Border lines -> Border lines -> Bool
$cmax :: forall lines.
Ord lines =>
Border lines -> Border lines -> Border lines
max :: Border lines -> Border lines -> Border lines
$cmin :: forall lines.
Ord lines =>
Border lines -> Border lines -> Border lines
min :: Border lines -> Border lines -> Border lines
Ord, Int -> Border lines -> ShowS
[Border lines] -> ShowS
Border lines -> String
(Int -> Border lines -> ShowS)
-> (Border lines -> String)
-> ([Border lines] -> ShowS)
-> Show (Border lines)
forall lines. Show lines => Int -> Border lines -> ShowS
forall lines. Show lines => [Border lines] -> ShowS
forall lines. Show lines => Border lines -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall lines. Show lines => Int -> Border lines -> ShowS
showsPrec :: Int -> Border lines -> ShowS
$cshow :: forall lines. Show lines => Border lines -> String
show :: Border lines -> String
$cshowList :: forall lines. Show lines => [Border lines] -> ShowS
showList :: [Border lines] -> ShowS
Show)

instance Functor Border where
    fmap :: forall a b. (a -> b) -> Border a -> Border b
fmap a -> b
f (Border a
left a
right a
top a
bottom) =
        b -> b -> b -> b -> Border b
forall lines. lines -> lines -> lines -> lines -> Border lines
Border (a -> b
f a
left) (a -> b
f a
right) (a -> b
f a
top) (a -> b
f a
bottom)

instance Applicative Border where
    pure :: forall a. a -> Border a
pure a
a = a -> a -> a -> a -> Border a
forall lines. lines -> lines -> lines -> lines -> Border lines
Border a
a a
a a
a a
a
    Border a -> b
fLeft a -> b
fRight a -> b
fTop a -> b
fBottom <*> :: forall a b. Border (a -> b) -> Border a -> Border b
<*> Border a
left a
right a
top a
bottom =
        b -> b -> b -> b -> Border b
forall lines. lines -> lines -> lines -> lines -> Border lines
Border (a -> b
fLeft a
left) (a -> b
fRight a
right) (a -> b
fTop a
top) (a -> b
fBottom a
bottom)

instance Foldable Border where
    foldMap :: forall m a. Monoid m => (a -> m) -> Border a -> m
foldMap a -> m
f (Border a
left a
right a
top a
bottom) =
        a -> m
f a
left m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
right m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
top m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
bottom

noBorder :: (Lines border) => Border border
noBorder :: forall border. Lines border => Border border
noBorder = border -> Border border
forall a. a -> Border a
forall (f :: * -> *) a. Applicative f => a -> f a
pure border
forall border. Lines border => border
noLine

transposeBorder :: Border lines -> Border lines
transposeBorder :: forall lines. Border lines -> Border lines
transposeBorder (Border lines
left lines
right lines
top lines
bottom) =
    lines -> lines -> lines -> lines -> Border lines
forall lines. lines -> lines -> lines -> lines -> Border lines
Border lines
top lines
bottom lines
left lines
right


newtype Class = Class Text

textFromClass :: Class -> Text
textFromClass :: Class -> Text
textFromClass (Class Text
cls) = Text
cls


{- |
* 'NoSpan' means a single unmerged cell.

* 'Covered' is a cell if it is part of a horizontally or vertically merged cell.
  We maintain these cells although they are ignored in HTML output.
  In contrast to that, FODS can store covered cells
  and allows to access the hidden cell content via formulas.
  CSV does not support merged cells
  and thus simply writes the content of covered cells.
  Maintaining 'Covered' cells also simplifies transposing.

* @'SpanHorizontal' n@ denotes the first cell in a row
  that is part of a merged cell.
  The merged cell contains @n@ atomic cells, including the first one.
  That is @SpanHorizontal 1@ is actually like @NoSpan@.
  The content of this cell is shown as content of the merged cell.

* @'SpanVertical' n@ starts a vertically merged cell.

The writer functions expect consistent data,
that is, 'Covered' cells must actually be part of a merged cell
and merged cells must only cover 'Covered' cells.
-}
data Span =
      NoSpan
    | Covered
    | SpanHorizontal Int
    | SpanVertical Int
    deriving (Span -> Span -> Bool
(Span -> Span -> Bool) -> (Span -> Span -> Bool) -> Eq Span
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Span -> Span -> Bool
== :: Span -> Span -> Bool
$c/= :: Span -> Span -> Bool
/= :: Span -> Span -> Bool
Eq)

transposeSpan :: Span -> Span
transposeSpan :: Span -> Span
transposeSpan Span
span =
    case Span
span of
        Span
NoSpan -> Span
NoSpan
        Span
Covered -> Span
Covered
        SpanHorizontal Int
n -> Int -> Span
SpanVertical Int
n
        SpanVertical Int
n -> Int -> Span
SpanHorizontal Int
n

data Cell border text =
    Cell {
        forall border text. Cell border text -> Type
cellType :: Type,
        forall border text. Cell border text -> Border border
cellBorder :: Border border,
        forall border text. Cell border text -> Style
cellStyle :: Style,
        forall border text. Cell border text -> Span
cellSpan :: Span,
        forall border text. Cell border text -> Text
cellAnchor :: Text,
        forall border text. Cell border text -> Class
cellClass :: Class,
        forall border text. Cell border text -> text
cellContent :: text
    }

instance Functor (Cell border) where
    fmap :: forall a b. (a -> b) -> Cell border a -> Cell border b
fmap a -> b
f (Cell Type
typ Border border
border Style
style Span
span Text
anchor Class
class_ a
content) =
        Type
-> Border border
-> Style
-> Span
-> Text
-> Class
-> b
-> Cell border b
forall border text.
Type
-> Border border
-> Style
-> Span
-> Text
-> Class
-> text
-> Cell border text
Cell Type
typ Border border
border Style
style Span
span Text
anchor Class
class_ (b -> Cell border b) -> b -> Cell border b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
content

defaultCell :: (Lines border) => text -> Cell border text
defaultCell :: forall border text. Lines border => text -> Cell border text
defaultCell text
text =
    Cell {
        cellType :: Type
cellType = Type
TypeString,
        cellBorder :: Border border
cellBorder = Border border
forall border. Lines border => Border border
noBorder,
        cellStyle :: Style
cellStyle = Emphasis -> Style
Body Emphasis
Item,
        cellSpan :: Span
cellSpan = Span
NoSpan,
        cellAnchor :: Text
cellAnchor = Text
forall a. Monoid a => a
mempty,
        cellClass :: Class
cellClass = Text -> Class
Class Text
forall a. Monoid a => a
mempty,
        cellContent :: text
cellContent = text
text
    }

headerCell :: (Lines borders) => Text -> Cell borders Text
headerCell :: forall borders. Lines borders => Text -> Cell borders Text
headerCell Text
text = (Text -> Cell borders Text
forall border text. Lines border => text -> Cell border text
defaultCell Text
text) {cellStyle = Head}

emptyCell :: (Lines border, Monoid text) => Cell border text
emptyCell :: forall border text. (Lines border, Monoid text) => Cell border text
emptyCell = text -> Cell border text
forall border text. Lines border => text -> Cell border text
defaultCell text
forall a. Monoid a => a
mempty

transposeCell :: Cell border text -> Cell border text
transposeCell :: forall border text. Cell border text -> Cell border text
transposeCell Cell border text
cell =
    Cell border text
cell {
        cellBorder = transposeBorder $ cellBorder cell,
        cellSpan = transposeSpan $ cellSpan cell
    }

transpose :: [[Cell border text]] -> [[Cell border text]]
transpose :: forall border text. [[Cell border text]] -> [[Cell border text]]
transpose = [[Cell border text]] -> [[Cell border text]]
forall a. [[a]] -> [[a]]
List.transpose ([[Cell border text]] -> [[Cell border text]])
-> ([[Cell border text]] -> [[Cell border text]])
-> [[Cell border text]]
-> [[Cell border text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Cell border text] -> [Cell border text])
-> [[Cell border text]] -> [[Cell border text]]
forall a b. (a -> b) -> [a] -> [b]
map ((Cell border text -> Cell border text)
-> [Cell border text] -> [Cell border text]
forall a b. (a -> b) -> [a] -> [b]
map Cell border text -> Cell border text
forall border text. Cell border text -> Cell border text
transposeCell)


addHeaderBorders :: [Cell () text] -> [Cell NumLines text]
addHeaderBorders :: forall text. [Cell () text] -> [Cell NumLines text]
addHeaderBorders =
    (Cell () text -> Cell NumLines text)
-> [Cell () text] -> [Cell NumLines text]
forall a b. (a -> b) -> [a] -> [b]
map (\Cell () text
c -> Cell () text
c {cellBorder = noBorder {borderBottom = DoubleLine}})

horizontalSpan ::
    (Lines border, Monoid text) =>
    [a] -> Cell border text -> [Cell border text]
horizontalSpan :: forall border text a.
(Lines border, Monoid text) =>
[a] -> Cell border text -> [Cell border text]
horizontalSpan [a]
subCells Cell border text
cell =
    (Cell border text -> a -> Cell border text)
-> [Cell border text] -> [a] -> [Cell border text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Cell border text -> a -> Cell border text
forall a b. a -> b -> a
const
        (Cell border text
cell{cellSpan = SpanHorizontal $ length subCells}
            Cell border text -> [Cell border text] -> [Cell border text]
forall a. a -> [a] -> [a]
: Cell border text -> [Cell border text]
forall a. a -> [a]
repeat (Cell border text
forall border text. (Lines border, Monoid text) => Cell border text
emptyCell {cellSpan = Covered}))
        [a]
subCells

addRowSpanHeader ::
    Cell border text ->
    [[Cell border text]] -> [[Cell border text]]
addRowSpanHeader :: forall border text.
Cell border text -> [[Cell border text]] -> [[Cell border text]]
addRowSpanHeader Cell border text
header [[Cell border text]]
rows =
    case [[Cell border text]]
rows of
        [] -> []
        [[Cell border text]
row] -> [Cell border text
headerCell border text -> [Cell border text] -> [Cell border text]
forall a. a -> [a] -> [a]
:[Cell border text]
row]
        [[Cell border text]]
_ ->
            (Cell border text -> [Cell border text] -> [Cell border text])
-> [Cell border text]
-> [[Cell border text]]
-> [[Cell border text]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (:)
                (Cell border text
header{cellSpan = SpanVertical (length rows)} Cell border text -> [Cell border text] -> [Cell border text]
forall a. a -> [a] -> [a]
:
                 Cell border text -> [Cell border text]
forall a. a -> [a]
repeat Cell border text
header{cellSpan = Covered})
                [[Cell border text]]
rows

rawTableContent :: [[Cell border text]] -> [[text]]
rawTableContent :: forall border text. [[Cell border text]] -> [[text]]
rawTableContent = ([Cell border text] -> [text]) -> [[Cell border text]] -> [[text]]
forall a b. (a -> b) -> [a] -> [b]
map ((Cell border text -> text) -> [Cell border text] -> [text]
forall a b. (a -> b) -> [a] -> [b]
map Cell border text -> text
forall border text. Cell border text -> text
cellContent)



cellFromMixedAmount ::
    (Lines border) =>
    AmountFormat -> (Class, MixedAmount) -> Cell border WideBuilder
cellFromMixedAmount :: forall border.
Lines border =>
AmountFormat -> (Class, MixedAmount) -> Cell border WideBuilder
cellFromMixedAmount AmountFormat
bopts (Class
cls, MixedAmount
mixedAmt) =
    (WideBuilder -> Cell border WideBuilder
forall border text. Lines border => text -> Cell border text
defaultCell (WideBuilder -> Cell border WideBuilder)
-> WideBuilder -> Cell border WideBuilder
forall a b. (a -> b) -> a -> b
$ AmountFormat -> MixedAmount -> WideBuilder
Amt.showMixedAmountB AmountFormat
bopts MixedAmount
mixedAmt) {
        cellClass = cls,
        cellType =
          case Amt.unifyMixedAmount mixedAmt of
            Just Amount
amt -> AmountFormat -> Amount -> Type
amountType AmountFormat
bopts Amount
amt
            Maybe Amount
Nothing -> Type
TypeMixedAmount
    }

cellsFromMixedAmount ::
    (Lines border) =>
    AmountFormat -> (Class, MixedAmount) -> [Cell border WideBuilder]
cellsFromMixedAmount :: forall border.
Lines border =>
AmountFormat -> (Class, MixedAmount) -> [Cell border WideBuilder]
cellsFromMixedAmount AmountFormat
bopts (Class
cls, MixedAmount
mixedAmt) =
    ((WideBuilder, Amount) -> Cell border WideBuilder)
-> [(WideBuilder, Amount)] -> [Cell border WideBuilder]
forall a b. (a -> b) -> [a] -> [b]
map
        (\(WideBuilder
str,Amount
amt) ->
            (WideBuilder -> Cell border WideBuilder
forall border text. Lines border => text -> Cell border text
defaultCell WideBuilder
str) {
                cellClass = cls,
                cellType = amountType bopts amt
            })
        (AmountFormat -> MixedAmount -> [(WideBuilder, Amount)]
Amt.showMixedAmountLinesPartsB AmountFormat
bopts MixedAmount
mixedAmt)

cellFromAmount ::
    (Lines border) =>
    AmountFormat -> (Class, (wb, Amount)) -> Cell border wb
cellFromAmount :: forall border wb.
Lines border =>
AmountFormat -> (Class, (wb, Amount)) -> Cell border wb
cellFromAmount AmountFormat
bopts (Class
cls, (wb
str,Amount
amt)) =
    (wb -> Cell border wb
forall border text. Lines border => text -> Cell border text
defaultCell wb
str) {
        cellClass = cls,
        cellType = amountType bopts amt
    }

amountType :: AmountFormat -> Amount -> Type
amountType :: AmountFormat -> Amount -> Type
amountType AmountFormat
bopts Amount
amt =
    Amount -> Type
TypeAmount (Amount -> Type) -> Amount -> Type
forall a b. (a -> b) -> a -> b
$
    if AmountFormat -> Bool
Amt.displayCommodity AmountFormat
bopts
      then Amount
amt
      else Amount
amt {acommodity = Text.empty}


integerCell :: (Lines border) => Integer -> Cell border Text
integerCell :: forall border. Lines border => Integer -> Cell border Text
integerCell Integer
k = (Text -> Cell border Text
forall border text. Lines border => text -> Cell border text
defaultCell (Text -> Cell border Text) -> Text -> Cell border Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
k) {cellType = TypeInteger}