{- |
Export table data as OpenDocument Spreadsheet
<https://docs.oasis-open.org/office/OpenDocument/v1.3/>.
This format supports character encodings, fixed header rows and columns,
number formatting, text styles, merged cells, formulas, hyperlinks.
Currently we support Flat ODS, a plain uncompressed XML format.

This is derived from <https://hackage.haskell.org/package/classify-frog-0.2.4.3/src/src/Spreadsheet/Format.hs>

-}
module Hledger.Write.Ods (
    printFods,
    ) where

import Prelude hiding (Applicative(..))
import Control.Monad (guard)
import Control.Applicative (Applicative(..))

import qualified Data.Text.Lazy as TL
import qualified Data.Text as T
import Data.Text (Text)

import qualified Data.Foldable as Fold
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Foldable (fold)
import Data.Map (Map)
import Data.Set (Set)
import Data.Maybe (catMaybes)

import qualified System.IO as IO
import Text.Printf (printf)

import qualified Hledger.Write.Spreadsheet as Spr
import Hledger.Write.Spreadsheet (Type(..), Style(..), Emphasis(..), Cell(..))
import Hledger.Data.Types (CommoditySymbol, AmountPrecision(..))
import Hledger.Data.Types (acommodity, aquantity, astyle, asprecision)

printFods ::
    IO.TextEncoding ->
    Map Text ((Int, Int), [[Cell Spr.NumLines Text]]) -> TL.Text
printFods :: TextEncoding
-> Map
     CommoditySymbol ((Int, Int), [[Cell NumLines CommoditySymbol]])
-> Text
printFods TextEncoding
encoding Map CommoditySymbol ((Int, Int), [[Cell NumLines CommoditySymbol]])
tables =
    let fileOpen :: [String] -> [String]
fileOpen [String]
customStyles =
          (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> case Char
c of Char
'\'' -> Char
'"'; Char
_ -> Char
c)) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
          String -> String -> String
forall r. PrintfType r => String -> r
printf String
"<?xml version='1.0' encoding='%s'?>" (TextEncoding -> String
forall a. Show a => a -> String
show TextEncoding
encoding) String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"<office:document" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"  office:mimetype='application/vnd.oasis.opendocument.spreadsheet'" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"  office:version='1.3'" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"  xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance'" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"  xmlns:xsd='http://www.w3.org/2001/XMLSchema'" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"  xmlns:text='urn:oasis:names:tc:opendocument:xmlns:text:1.0'" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"  xmlns:style='urn:oasis:names:tc:opendocument:xmlns:style:1.0'" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"  xmlns:meta='urn:oasis:names:tc:opendocument:xmlns:meta:1.0'" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"  xmlns:config='urn:oasis:names:tc:opendocument:xmlns:config:1.0'" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"  xmlns:xlink='http://www.w3.org/1999/xlink'" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"  xmlns:fo='urn:oasis:names:tc:opendocument:xmlns:xsl-fo-compatible:1.0'" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"  xmlns:ooo='http://openoffice.org/2004/office'" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"  xmlns:office='urn:oasis:names:tc:opendocument:xmlns:office:1.0'" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"  xmlns:table='urn:oasis:names:tc:opendocument:xmlns:table:1.0'" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"  xmlns:number='urn:oasis:names:tc:opendocument:xmlns:datastyle:1.0'" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"  xmlns:of='urn:oasis:names:tc:opendocument:xmlns:of:1.2'" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"  xmlns:field='urn:openoffice:names:experimental:ooo-ms-interop:xmlns:field:1.0'" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"  xmlns:form='urn:oasis:names:tc:opendocument:xmlns:form:1.0'>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"<office:styles>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"  <number:date-style style:name='iso-date'>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"    <number:year number:style='long'/>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"    <number:text>-</number:text>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"    <number:month number:style='long'/>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"    <number:text>-</number:text>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"    <number:day number:style='long'/>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"  </number:date-style>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"  <number:number-style style:name='integer'>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"    <number:number number:min-integer-digits='1'/>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"  </number:number-style>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          [String]
customStyles [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
          String
"</office:styles>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          []

        fileClose :: [String]
fileClose =
          String
"</office:document>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          []

        tableConfig :: Map t (t, t) -> [String]
tableConfig Map t (t, t)
tableNames =
          String
" <office:settings>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"  <config:config-item-set config:name='ooo:view-settings'>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"   <config:config-item-map-indexed config:name='Views'>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"    <config:config-item-map-entry>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"     <config:config-item-map-named config:name='Tables'>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          (Map t [String] -> [String]
forall m. Monoid m => Map t m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Map t [String] -> [String]) -> Map t [String] -> [String]
forall a b. (a -> b) -> a -> b
$
           ((t -> (t, t) -> [String]) -> Map t (t, t) -> Map t [String])
-> Map t (t, t) -> (t -> (t, t) -> [String]) -> Map t [String]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (t -> (t, t) -> [String]) -> Map t (t, t) -> Map t [String]
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey Map t (t, t)
tableNames ((t -> (t, t) -> [String]) -> Map t [String])
-> (t -> (t, t) -> [String]) -> Map t [String]
forall a b. (a -> b) -> a -> b
$ \t
tableName (t
topRow,t
leftColumn) ->
             String -> t -> String
forall r. PrintfType r => String -> r
printf String
"      <config:config-item-map-entry config:name='%s'>" t
tableName String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
             ((Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (t
leftColumnt -> t -> Bool
forall a. Ord a => a -> a -> Bool
>t
0) [()] -> [String] -> [String]
forall a b. [a] -> [b] -> [b]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
                String
"       <config:config-item config:name='HorizontalSplitMode' config:type='short'>2</config:config-item>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
                String -> t -> String
forall r. PrintfType r => String -> r
printf String
"       <config:config-item config:name='HorizontalSplitPosition' config:type='int'>%d</config:config-item>" t
leftColumn String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
                String -> t -> String
forall r. PrintfType r => String -> r
printf String
"       <config:config-item config:name='PositionRight' config:type='int'>%d</config:config-item>" t
leftColumn String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
                []) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
             ((Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (t
topRowt -> t -> Bool
forall a. Ord a => a -> a -> Bool
>t
0) [()] -> [String] -> [String]
forall a b. [a] -> [b] -> [b]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
                String
"       <config:config-item config:name='VerticalSplitMode' config:type='short'>2</config:config-item>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
                String -> t -> String
forall r. PrintfType r => String -> r
printf String
"       <config:config-item config:name='VerticalSplitPosition' config:type='int'>%d</config:config-item>" t
topRow String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
                String -> t -> String
forall r. PrintfType r => String -> r
printf String
"       <config:config-item config:name='PositionBottom' config:type='int'>%d</config:config-item>" t
topRow String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
                []) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
             String
"      </config:config-item-map-entry>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
             []) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
          String
"     </config:config-item-map-named>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"    </config:config-item-map-entry>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"   </config:config-item-map-indexed>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"  </config:config-item-set>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
" </office:settings>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          []

        tableOpen :: t -> [String]
tableOpen t
name =
          String
"<office:body>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"<office:spreadsheet>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String -> t -> String
forall r. PrintfType r => String -> r
printf String
"<table:table table:name='%s'>" t
name String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          []

        tableClose :: [String]
tableClose =
          String
"</table:table>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"</office:spreadsheet>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          String
"</office:body>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          []

    in  [Text] -> Text
TL.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (CommoditySymbol -> Text
TL.fromStrict (CommoditySymbol -> Text)
-> (String -> CommoditySymbol) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CommoditySymbol
T.pack) ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$
        [String] -> [String]
fileOpen
          (let styles :: Set ((Border NumLines, Style), DataStyle)
styles = [Cell NumLines CommoditySymbol]
-> Set ((Border NumLines, Style), DataStyle)
forall border.
Ord border =>
[Cell border CommoditySymbol]
-> Set ((Border border, Style), DataStyle)
cellStyles ((((Int, Int), [[Cell NumLines CommoditySymbol]])
 -> [Cell NumLines CommoditySymbol])
-> Map
     CommoditySymbol ((Int, Int), [[Cell NumLines CommoditySymbol]])
-> [Cell NumLines CommoditySymbol]
forall m a. Monoid m => (a -> m) -> Map CommoditySymbol a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ([[Cell NumLines CommoditySymbol]]
-> [Cell NumLines CommoditySymbol]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat([[Cell NumLines CommoditySymbol]]
 -> [Cell NumLines CommoditySymbol])
-> (((Int, Int), [[Cell NumLines CommoditySymbol]])
    -> [[Cell NumLines CommoditySymbol]])
-> ((Int, Int), [[Cell NumLines CommoditySymbol]])
-> [Cell NumLines CommoditySymbol]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Int, Int), [[Cell NumLines CommoditySymbol]])
-> [[Cell NumLines CommoditySymbol]]
forall a b. (a, b) -> b
snd) Map CommoditySymbol ((Int, Int), [[Cell NumLines CommoditySymbol]])
tables) in
           ((CommoditySymbol, AmountPrecision) -> [String]
numberConfig ((CommoditySymbol, AmountPrecision) -> [String])
-> [(CommoditySymbol, AmountPrecision)] -> [String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Set (CommoditySymbol, AmountPrecision)
-> [(CommoditySymbol, AmountPrecision)]
forall a. Set a -> [a]
Set.toList ((((Border NumLines, Style), DataStyle)
 -> Set (CommoditySymbol, AmountPrecision))
-> Set ((Border NumLines, Style), DataStyle)
-> Set (CommoditySymbol, AmountPrecision)
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (DataStyle -> Set (CommoditySymbol, AmountPrecision)
numberParams(DataStyle -> Set (CommoditySymbol, AmountPrecision))
-> (((Border NumLines, Style), DataStyle) -> DataStyle)
-> ((Border NumLines, Style), DataStyle)
-> Set (CommoditySymbol, AmountPrecision)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Border NumLines, Style), DataStyle) -> DataStyle
forall a b. (a, b) -> b
snd) Set ((Border NumLines, Style), DataStyle)
styles))
           [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
           (((Border NumLines, Style), DataStyle) -> [String]
cellConfig (((Border NumLines, Style), DataStyle) -> [String])
-> [((Border NumLines, Style), DataStyle)] -> [String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Set ((Border NumLines, Style), DataStyle)
-> [((Border NumLines, Style), DataStyle)]
forall a. Set a -> [a]
Set.toList Set ((Border NumLines, Style), DataStyle)
styles)) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
        Map CommoditySymbol (Int, Int) -> [String]
forall {t} {t} {t}.
(Ord t, Ord t, Num t, Num t, PrintfArg t, PrintfArg t,
 PrintfArg t) =>
Map t (t, t) -> [String]
tableConfig ((((Int, Int), [[Cell NumLines CommoditySymbol]]) -> (Int, Int))
-> Map
     CommoditySymbol ((Int, Int), [[Cell NumLines CommoditySymbol]])
-> Map CommoditySymbol (Int, Int)
forall a b.
(a -> b) -> Map CommoditySymbol a -> Map CommoditySymbol b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int, Int), [[Cell NumLines CommoditySymbol]]) -> (Int, Int)
forall a b. (a, b) -> a
fst Map CommoditySymbol ((Int, Int), [[Cell NumLines CommoditySymbol]])
tables) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
        (Map CommoditySymbol ((Int, Int), [[Cell NumLines CommoditySymbol]])
-> [(CommoditySymbol,
     ((Int, Int), [[Cell NumLines CommoditySymbol]]))]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map CommoditySymbol ((Int, Int), [[Cell NumLines CommoditySymbol]])
tables [(CommoditySymbol,
  ((Int, Int), [[Cell NumLines CommoditySymbol]]))]
-> ((CommoditySymbol,
     ((Int, Int), [[Cell NumLines CommoditySymbol]]))
    -> [String])
-> [String]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(CommoditySymbol
name,((Int, Int)
_,[[Cell NumLines CommoditySymbol]]
table)) ->
            CommoditySymbol -> [String]
forall {t}. PrintfArg t => t -> [String]
tableOpen CommoditySymbol
name [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
            ([[Cell NumLines CommoditySymbol]]
table [[Cell NumLines CommoditySymbol]]
-> ([Cell NumLines CommoditySymbol] -> [String]) -> [String]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Cell NumLines CommoditySymbol]
row ->
                String
"<table:table-row>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
                ([Cell NumLines CommoditySymbol]
row [Cell NumLines CommoditySymbol]
-> (Cell NumLines CommoditySymbol -> [String]) -> [String]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Cell NumLines CommoditySymbol -> [String]
formatCell) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                String
"</table:table-row>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
                []) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
            [String]
tableClose) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
        [String]
fileClose


dataStyleFromType :: Type -> DataStyle
dataStyleFromType :: Type -> DataStyle
dataStyleFromType Type
typ =
    case Type
typ of
        Type
TypeString -> DataStyle
DataString
        Type
TypeInteger -> DataStyle
DataInteger
        Type
TypeDate -> DataStyle
DataDate
        TypeAmount Amount
amt -> CommoditySymbol -> AmountPrecision -> DataStyle
DataAmount (Amount -> CommoditySymbol
acommodity Amount
amt) (AmountStyle -> AmountPrecision
asprecision (AmountStyle -> AmountPrecision) -> AmountStyle -> AmountPrecision
forall a b. (a -> b) -> a -> b
$ Amount -> AmountStyle
astyle Amount
amt)
        Type
TypeMixedAmount -> DataStyle
DataMixedAmount

cellStyles ::
    (Ord border) =>
    [Cell border Text] ->
    Set ((Spr.Border border, Style), DataStyle)
cellStyles :: forall border.
Ord border =>
[Cell border CommoditySymbol]
-> Set ((Border border, Style), DataStyle)
cellStyles =
    [((Border border, Style), DataStyle)]
-> Set ((Border border, Style), DataStyle)
forall a. Ord a => [a] -> Set a
Set.fromList ([((Border border, Style), DataStyle)]
 -> Set ((Border border, Style), DataStyle))
-> ([Cell border CommoditySymbol]
    -> [((Border border, Style), DataStyle)])
-> [Cell border CommoditySymbol]
-> Set ((Border border, Style), DataStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (Cell border CommoditySymbol
 -> ((Border border, Style), DataStyle))
-> [Cell border CommoditySymbol]
-> [((Border border, Style), DataStyle)]
forall a b. (a -> b) -> [a] -> [b]
map (\Cell border CommoditySymbol
cell ->
            ((Cell border CommoditySymbol -> Border border
forall border text. Cell border text -> Border border
cellBorder Cell border CommoditySymbol
cell, Cell border CommoditySymbol -> Style
forall border text. Cell border text -> Style
cellStyle Cell border CommoditySymbol
cell),
             Type -> DataStyle
dataStyleFromType (Type -> DataStyle) -> Type -> DataStyle
forall a b. (a -> b) -> a -> b
$ Cell border CommoditySymbol -> Type
forall border text. Cell border text -> Type
cellType Cell border CommoditySymbol
cell))

numberStyleName :: (CommoditySymbol, AmountPrecision) -> String
numberStyleName :: (CommoditySymbol, AmountPrecision) -> String
numberStyleName (CommoditySymbol
comm, AmountPrecision
prec) =
    String -> CommoditySymbol -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s-%s" CommoditySymbol
comm (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
    case AmountPrecision
prec of
        AmountPrecision
NaturalPrecision -> String
"natural"
        Precision Word8
k -> Word8 -> String
forall a. Show a => a -> String
show Word8
k

numberParams :: DataStyle -> Set (CommoditySymbol, AmountPrecision)
numberParams :: DataStyle -> Set (CommoditySymbol, AmountPrecision)
numberParams (DataAmount CommoditySymbol
comm AmountPrecision
prec) = (CommoditySymbol, AmountPrecision)
-> Set (CommoditySymbol, AmountPrecision)
forall a. a -> Set a
Set.singleton (CommoditySymbol
comm, AmountPrecision
prec)
numberParams DataStyle
_ = Set (CommoditySymbol, AmountPrecision)
forall a. Set a
Set.empty

numberConfig :: (CommoditySymbol, AmountPrecision) -> [String]
numberConfig :: (CommoditySymbol, AmountPrecision) -> [String]
numberConfig (CommoditySymbol
comm, AmountPrecision
prec) =
    let precStr :: String
precStr =
            case AmountPrecision
prec of
                AmountPrecision
NaturalPrecision -> String
""
                Precision Word8
k -> String -> Word8 -> String
forall r. PrintfType r => String -> r
printf String
" number:decimal-places='%d'" Word8
k
        name :: String
name = (CommoditySymbol, AmountPrecision) -> String
numberStyleName (CommoditySymbol
comm, AmountPrecision
prec)
    in
    String -> String -> String
forall r. PrintfType r => String -> r
printf String
"  <number:number-style style:name='number-%s'>" String
name String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
    String -> String -> String
forall r. PrintfType r => String -> r
printf String
"    <number:number number:min-integer-digits='1'%s/>" String
precStr String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
    String -> String -> CommoditySymbol -> String
forall r. PrintfType r => String -> r
printf String
"    <number:text>%s%s</number:text>"
      (if CommoditySymbol -> Bool
T.null CommoditySymbol
comm then String
"" else String
" ") CommoditySymbol
comm String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
    String
"  </number:number-style>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
    []

emphasisName :: Emphasis -> String
emphasisName :: Emphasis -> String
emphasisName Emphasis
emph =
    case Emphasis
emph of
        Emphasis
Item -> String
"item"
        Emphasis
Total -> String
"total"

cellStyleName :: Style -> String
cellStyleName :: Style -> String
cellStyleName Style
style =
    case Style
style of
        Style
Head -> String
"head"
        Body Emphasis
emph -> Emphasis -> String
emphasisName Emphasis
emph

linesName :: Spr.NumLines -> Maybe String
linesName :: NumLines -> Maybe String
linesName NumLines
prop =
    case NumLines
prop of
        NumLines
Spr.NoLine -> Maybe String
forall a. Maybe a
Nothing
        NumLines
Spr.SingleLine -> String -> Maybe String
forall a. a -> Maybe a
Just String
"single"
        NumLines
Spr.DoubleLine -> String -> Maybe String
forall a. a -> Maybe a
Just String
"double"

linesStyle :: Spr.NumLines -> String
linesStyle :: NumLines -> String
linesStyle NumLines
prop =
    case NumLines
prop of
        NumLines
Spr.NoLine -> String
"none"
        NumLines
Spr.SingleLine -> String
"1.5pt solid #000000"
        NumLines
Spr.DoubleLine -> String
"1.5pt double-thin #000000"

borderLabels :: Spr.Border String
borderLabels :: Border String
borderLabels = String -> String -> String -> String -> Border String
forall lines. lines -> lines -> lines -> lines -> Border lines
Spr.Border String
"left" String
"right" String
"top" String
"bottom"

borderName :: Spr.Border Spr.NumLines -> String
borderName :: Border NumLines -> String
borderName Border NumLines
border =
    (\[(String, String)]
bs ->
        case [(String, String)]
bs of
            [] -> String
"noborder"
            [(String, String)]
_ ->
                (String
"border="String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"," ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
                ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
name,String
num) -> String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
':' Char -> String -> String
forall a. a -> [a] -> [a]
: String
num) [(String, String)]
bs) ([(String, String)] -> String) -> [(String, String)] -> String
forall a b. (a -> b) -> a -> b
$
    [Maybe (String, String)] -> [(String, String)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (String, String)] -> [(String, String)])
-> [Maybe (String, String)] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ Border (Maybe (String, String)) -> [Maybe (String, String)]
forall a. Border a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList (Border (Maybe (String, String)) -> [Maybe (String, String)])
-> Border (Maybe (String, String)) -> [Maybe (String, String)]
forall a b. (a -> b) -> a -> b
$
    (String -> NumLines -> Maybe (String, String))
-> Border String
-> Border NumLines
-> Border (Maybe (String, String))
forall a b c. (a -> b -> c) -> Border a -> Border b -> Border c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
        (\String
name NumLines
numLines -> (,) String
name (String -> (String, String))
-> Maybe String -> Maybe (String, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NumLines -> Maybe String
linesName NumLines
numLines)
        Border String
borderLabels
        Border NumLines
border

borderStyle :: Spr.Border Spr.NumLines -> [String]
borderStyle :: Border NumLines -> [String]
borderStyle Border NumLines
border =
    if Border NumLines
border Border NumLines -> Border NumLines -> Bool
forall a. Eq a => a -> a -> Bool
== Border NumLines
forall border. Lines border => Border border
Spr.noBorder
        then []
        else (String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[]) (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$
            String -> String -> String
forall r. PrintfType r => String -> r
printf String
"    <style:table-cell-properties%s/>" (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
            (String -> String
forall a. a -> a
id :: String -> String) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Border String -> String
forall m. Monoid m => Border m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Border String -> String) -> Border String -> String
forall a b. (a -> b) -> a -> b
$
            (String -> String -> String)
-> Border String -> Border String -> Border String
forall a b c. (a -> b -> c) -> Border a -> Border b -> Border c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
" fo:border-%s='%s'") Border String
borderLabels (Border String -> Border String) -> Border String -> Border String
forall a b. (a -> b) -> a -> b
$
            (NumLines -> String) -> Border NumLines -> Border String
forall a b. (a -> b) -> Border a -> Border b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NumLines -> String
linesStyle Border NumLines
border

data DataStyle =
      DataString
    | DataInteger
    | DataDate
    | DataAmount CommoditySymbol AmountPrecision
    | DataMixedAmount
    deriving (DataStyle -> DataStyle -> Bool
(DataStyle -> DataStyle -> Bool)
-> (DataStyle -> DataStyle -> Bool) -> Eq DataStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DataStyle -> DataStyle -> Bool
== :: DataStyle -> DataStyle -> Bool
$c/= :: DataStyle -> DataStyle -> Bool
/= :: DataStyle -> DataStyle -> Bool
Eq, Eq DataStyle
Eq DataStyle =>
(DataStyle -> DataStyle -> Ordering)
-> (DataStyle -> DataStyle -> Bool)
-> (DataStyle -> DataStyle -> Bool)
-> (DataStyle -> DataStyle -> Bool)
-> (DataStyle -> DataStyle -> Bool)
-> (DataStyle -> DataStyle -> DataStyle)
-> (DataStyle -> DataStyle -> DataStyle)
-> Ord DataStyle
DataStyle -> DataStyle -> Bool
DataStyle -> DataStyle -> Ordering
DataStyle -> DataStyle -> DataStyle
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 :: DataStyle -> DataStyle -> Ordering
compare :: DataStyle -> DataStyle -> Ordering
$c< :: DataStyle -> DataStyle -> Bool
< :: DataStyle -> DataStyle -> Bool
$c<= :: DataStyle -> DataStyle -> Bool
<= :: DataStyle -> DataStyle -> Bool
$c> :: DataStyle -> DataStyle -> Bool
> :: DataStyle -> DataStyle -> Bool
$c>= :: DataStyle -> DataStyle -> Bool
>= :: DataStyle -> DataStyle -> Bool
$cmax :: DataStyle -> DataStyle -> DataStyle
max :: DataStyle -> DataStyle -> DataStyle
$cmin :: DataStyle -> DataStyle -> DataStyle
min :: DataStyle -> DataStyle -> DataStyle
Ord, Int -> DataStyle -> String -> String
[DataStyle] -> String -> String
DataStyle -> String
(Int -> DataStyle -> String -> String)
-> (DataStyle -> String)
-> ([DataStyle] -> String -> String)
-> Show DataStyle
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> DataStyle -> String -> String
showsPrec :: Int -> DataStyle -> String -> String
$cshow :: DataStyle -> String
show :: DataStyle -> String
$cshowList :: [DataStyle] -> String -> String
showList :: [DataStyle] -> String -> String
Show)

cellConfig :: ((Spr.Border Spr.NumLines, Style), DataStyle) -> [String]
cellConfig :: ((Border NumLines, Style), DataStyle) -> [String]
cellConfig ((Border NumLines
border, Style
cstyle), DataStyle
dataStyle) =
    let boldStyle :: String
boldStyle = String
"    <style:text-properties fo:font-weight='bold'/>"
        alignTop :: String
alignTop =
            String
"    <style:table-cell-properties style:vertical-align='top'/>"
        alignParagraph :: String -> String
alignParagraph =
            String -> String -> String
forall r. PrintfType r => String -> r
printf String
"    <style:paragraph-properties fo:text-align='%s'/>"
        moreStyles :: [String]
moreStyles =
            Border NumLines -> [String]
borderStyle Border NumLines
border
            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
            (
            case Style
cstyle of
                Body Emphasis
Item ->
                    String
alignTop String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
                    []
                Body Emphasis
Total ->
                    String
alignTop String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
                    String
boldStyle String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
                    []
                Style
Head ->
                    String -> String
alignParagraph String
"center" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
                    String
boldStyle String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
                    []
            )
            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
            (
            case DataStyle
dataStyle of
                DataStyle
DataMixedAmount -> [String -> String
alignParagraph String
"end"]
                DataStyle
_ -> []
            )
        style :: String
        style :: String
style =
            let (String
styleName,Maybe String
dataStyleName) = Style -> Border NumLines -> DataStyle -> (String, Maybe String)
styleNames Style
cstyle Border NumLines
border DataStyle
dataStyle
            in  String -> String -> String
forall r. PrintfType r => String -> r
printf String
"style:name='%s'" String
styleName
                String -> String -> String
forall a. [a] -> [a] -> [a]
++
                (String -> String) -> Maybe String -> String
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (String -> String -> String
forall r. PrintfType r => String -> r
printf String
" style:data-style-name='%s'") Maybe String
dataStyleName
    in
    case [String]
moreStyles of
        [] ->
            String -> String -> String
forall r. PrintfType r => String -> r
printf String
"  <style:style style:family='table-cell' %s/>" String
style String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
            []
        [String]
_ ->
            String -> String -> String
forall r. PrintfType r => String -> r
printf String
"  <style:style style:family='table-cell' %s>" String
style String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
            [String]
moreStyles [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
            String
"  </style:style>" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
            []


formatCell :: Cell Spr.NumLines Text -> [String]
formatCell :: Cell NumLines CommoditySymbol -> [String]
formatCell Cell NumLines CommoditySymbol
cell =
    let style, valueType :: String
        style :: String
style =
            String -> String -> String
forall r. PrintfType r => String -> r
printf String
" table:style-name='%s'" (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (String, Maybe String) -> String
forall a b. (a, b) -> a
fst ((String, Maybe String) -> String)
-> (String, Maybe String) -> String
forall a b. (a -> b) -> a -> b
$
            Style -> Border NumLines -> DataStyle -> (String, Maybe String)
styleNames
                (Cell NumLines CommoditySymbol -> Style
forall border text. Cell border text -> Style
cellStyle Cell NumLines CommoditySymbol
cell)
                (Cell NumLines CommoditySymbol -> Border NumLines
forall border text. Cell border text -> Border border
cellBorder Cell NumLines CommoditySymbol
cell)
                (Type -> DataStyle
dataStyleFromType (Type -> DataStyle) -> Type -> DataStyle
forall a b. (a -> b) -> a -> b
$ Cell NumLines CommoditySymbol -> Type
forall border text. Cell border text -> Type
cellType Cell NumLines CommoditySymbol
cell)

        valueType :: String
valueType =
            case Cell NumLines CommoditySymbol -> Type
forall border text. Cell border text -> Type
cellType Cell NumLines CommoditySymbol
cell of
                Type
TypeInteger ->
                    String -> CommoditySymbol -> String
forall r. PrintfType r => String -> r
printf
                        String
"office:value-type='float' office:value='%s'"
                        (Cell NumLines CommoditySymbol -> CommoditySymbol
forall border text. Cell border text -> text
cellContent Cell NumLines CommoditySymbol
cell)
                TypeAmount Amount
amt ->
                    String -> String -> String
forall r. PrintfType r => String -> r
printf
                        String
"office:value-type='float' office:value='%s'"
                        (Quantity -> String
forall a. Show a => a -> String
show (Quantity -> String) -> Quantity -> String
forall a b. (a -> b) -> a -> b
$ Amount -> Quantity
aquantity Amount
amt)
                Type
TypeDate ->
                    String -> CommoditySymbol -> String
forall r. PrintfType r => String -> r
printf
                        String
"office:value-type='date' office:date-value='%s'"
                        (Cell NumLines CommoditySymbol -> CommoditySymbol
forall border text. Cell border text -> text
cellContent Cell NumLines CommoditySymbol
cell)
                Type
_ -> String
"office:value-type='string'"

        covered :: String
covered =
            case Cell NumLines CommoditySymbol -> Span
forall border text. Cell border text -> Span
cellSpan Cell NumLines CommoditySymbol
cell of
                Span
Spr.Covered -> String
"covered-"
                Span
_ -> String
""

        span_ :: String
span_ =
            case Cell NumLines CommoditySymbol -> Span
forall border text. Cell border text -> Span
cellSpan Cell NumLines CommoditySymbol
cell of
                Spr.SpanHorizontal Int
n | Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
1 ->
                    String -> Int -> String
forall r. PrintfType r => String -> r
printf String
" table:number-columns-spanned='%d'" Int
n
                Spr.SpanVertical Int
n | Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
1 ->
                    String -> Int -> String
forall r. PrintfType r => String -> r
printf String
" table:number-rows-spanned='%d'" Int
n
                Span
_ -> String
""

        anchor :: t -> t
anchor t
text =
            if CommoditySymbol -> Bool
T.null (CommoditySymbol -> Bool) -> CommoditySymbol -> Bool
forall a b. (a -> b) -> a -> b
$ Cell NumLines CommoditySymbol -> CommoditySymbol
forall border text. Cell border text -> CommoditySymbol
Spr.cellAnchor Cell NumLines CommoditySymbol
cell
                then t
text
                else String -> String -> t -> t
forall r. PrintfType r => String -> r
printf String
"<text:a xlink:href='%s'>%s</text:a>"
                        (String -> String
escape (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ CommoditySymbol -> String
T.unpack (CommoditySymbol -> String) -> CommoditySymbol -> String
forall a b. (a -> b) -> a -> b
$ Cell NumLines CommoditySymbol -> CommoditySymbol
forall border text. Cell border text -> CommoditySymbol
Spr.cellAnchor Cell NumLines CommoditySymbol
cell) t
text

    in
    String -> String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"<table:%stable-cell%s%s %s>" String
covered String
style String
span_ String
valueType String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
    String -> String -> String
forall r. PrintfType r => String -> r
printf String
"<text:p>%s</text:p>"
        (String -> String
forall {t}. (PrintfArg t, PrintfType t) => t -> t
anchor (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
escape (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ CommoditySymbol -> String
T.unpack (CommoditySymbol -> String) -> CommoditySymbol -> String
forall a b. (a -> b) -> a -> b
$ Cell NumLines CommoditySymbol -> CommoditySymbol
forall border text. Cell border text -> text
cellContent Cell NumLines CommoditySymbol
cell) String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
    String -> String -> String
forall r. PrintfType r => String -> r
printf String
"</table:%stable-cell>" String
covered String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
    []

styleNames ::
    Style -> Spr.Border Spr.NumLines -> DataStyle -> (String, Maybe String)
styleNames :: Style -> Border NumLines -> DataStyle -> (String, Maybe String)
styleNames Style
cstyle Border NumLines
border DataStyle
dataStyle =
    let cstyleName :: String
cstyleName = Style -> String
cellStyleName Style
cstyle in
    let bordName :: String
bordName = Border NumLines -> String
borderName Border NumLines
border in
    case DataStyle
dataStyle of
        DataStyle
DataDate ->
            (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s-%s-date" String
cstyleName String
bordName, String -> Maybe String
forall a. a -> Maybe a
Just String
"iso-date")
        DataStyle
DataInteger ->
            (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s-%s-integer" String
cstyleName String
bordName, String -> Maybe String
forall a. a -> Maybe a
Just String
"integer")
        DataAmount CommoditySymbol
comm AmountPrecision
prec ->
            let name :: String
name = (CommoditySymbol, AmountPrecision) -> String
numberStyleName (CommoditySymbol
comm, AmountPrecision
prec) in
            (String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s-%s-%s" String
cstyleName String
bordName String
name,
                String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"number-%s" String
name)
        DataStyle
DataMixedAmount ->
            (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s-%s-mixedamount" String
cstyleName String
bordName, Maybe String
forall a. Maybe a
Nothing)
        DataStyle
DataString -> (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s-%s" String
cstyleName String
bordName, Maybe String
forall a. Maybe a
Nothing)

escape :: String -> String
escape :: String -> String
escape =
    (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Char -> String) -> String -> String)
-> (Char -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ \Char
c ->
        case Char
c of
            Char
'\n' -> String
"&#10;"
            Char
'&' -> String
"&amp;"
            Char
'<' -> String
"&lt;"
            Char
'>' -> String
"&gt;"
            Char
'"' -> String
"&quot;"
            Char
'\'' -> String
"&apos;"
            Char
_ -> [Char
c]