lib: Write.Spreadsheet.Cell: add type parameter for the text type

instance Functor Cell
This way you can choose between Text, Lazy.Text, WideBuilder for cell content.
This commit is contained in:
Henning Thielemann 2024-08-11 08:43:44 +02:00
parent f306df6d61
commit 66a047aade
4 changed files with 23 additions and 18 deletions

View File

@ -15,15 +15,15 @@ import qualified Lucid
import Data.Foldable (for_) import Data.Foldable (for_)
printHtml :: [[Cell]] -> Lucid.Html () printHtml :: [[Cell (Lucid.Html ())]] -> Lucid.Html ()
printHtml table = printHtml table =
Lucid.table_ $ for_ table $ \row -> Lucid.table_ $ for_ table $ \row ->
Lucid.tr_ $ for_ row $ \cell -> Lucid.tr_ $ for_ row $ \cell ->
formatCell cell formatCell cell
formatCell :: Cell -> Lucid.Html () formatCell :: Cell (Lucid.Html ()) -> Lucid.Html ()
formatCell cell = formatCell cell =
let str = Lucid.toHtml $ cellContent cell in let str = cellContent cell in
case cellStyle cell of case cellStyle cell of
Head -> Lucid.th_ str Head -> Lucid.th_ str
Body emph -> Body emph ->

View File

@ -32,7 +32,8 @@ import Text.Printf (printf)
printFods :: printFods ::
IO.TextEncoding -> Map Text ((Maybe Int, Maybe Int), [[Cell]]) -> TL.Text IO.TextEncoding ->
Map Text ((Maybe Int, Maybe Int), [[Cell Text]]) -> TL.Text
printFods encoding tables = printFods encoding tables =
let fileOpen customStyles = let fileOpen customStyles =
map (map (\c -> case c of '\'' -> '"'; _ -> c)) $ map (map (\c -> case c of '\'' -> '"'; _ -> c)) $
@ -136,7 +137,7 @@ printFods encoding tables =
fileClose fileClose
cellStyles :: [Cell] -> Set (Emphasis, (CommoditySymbol, AmountPrecision)) cellStyles :: [Cell Text] -> Set (Emphasis, (CommoditySymbol, AmountPrecision))
cellStyles = cellStyles =
Set.fromList . Set.fromList .
mapMaybe (\cell -> mapMaybe (\cell ->
@ -195,7 +196,7 @@ cellConfig (emph, numParam) =
[] []
formatCell :: Cell -> [String] formatCell :: Cell Text -> [String]
formatCell cell = formatCell cell =
let style, valueType :: String let style, valueType :: String
style = style =

View File

@ -8,13 +8,11 @@ module Hledger.Write.Spreadsheet (
Emphasis(..), Emphasis(..),
Cell(..), Cell(..),
defaultCell, defaultCell,
emptyCell,
) where ) where
import Hledger.Data.Types (Amount) import Hledger.Data.Types (Amount)
import qualified Data.Text as T
import Data.Text (Text)
data Type = data Type =
TypeString TypeString
@ -28,17 +26,23 @@ data Style = Body Emphasis | Head
data Emphasis = Item | Total data Emphasis = Item | Total
deriving (Eq, Ord, Show) deriving (Eq, Ord, Show)
data Cell = data Cell text =
Cell { Cell {
cellType :: Type, cellType :: Type,
cellStyle :: Style, cellStyle :: Style,
cellContent :: Text cellContent :: text
} }
defaultCell :: Cell instance Functor Cell where
defaultCell = fmap f (Cell typ style content) = Cell typ style $ f content
defaultCell :: text -> Cell text
defaultCell text =
Cell { Cell {
cellType = TypeString, cellType = TypeString,
cellStyle = Body Item, cellStyle = Body Item,
cellContent = T.empty cellContent = text
} }
emptyCell :: (Monoid text) => Cell text
emptyCell = defaultCell mempty

View File

@ -404,7 +404,7 @@ balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ of
"csv" -> \ropts1 -> printCSV . balanceReportAsCsv ropts1 "csv" -> \ropts1 -> printCSV . balanceReportAsCsv ropts1
"tsv" -> \ropts1 -> printTSV . balanceReportAsCsv ropts1 "tsv" -> \ropts1 -> printTSV . balanceReportAsCsv ropts1
"html" -> \ropts1 -> (<>"\n") . L.renderText . "html" -> \ropts1 -> (<>"\n") . L.renderText .
printHtml . balanceReportAsSpreadsheet ropts1 printHtml . map (map (fmap L.toHtml)) . balanceReportAsSpreadsheet ropts1
"json" -> const $ (<>"\n") . toJsonText "json" -> const $ (<>"\n") . toJsonText
"fods" -> \ropts1 -> printFods IO.localeEncoding . Map.singleton "Hledger" . (,) (Just 1, Nothing) . balanceReportAsSpreadsheet ropts1 "fods" -> \ropts1 -> printFods IO.localeEncoding . Map.singleton "Hledger" . (,) (Just 1, Nothing) . balanceReportAsSpreadsheet ropts1
_ -> error' $ unsupportedOutputFormatError fmt -- PARTIAL: _ -> error' $ unsupportedOutputFormatError fmt -- PARTIAL:
@ -544,7 +544,7 @@ renderComponent topaligned oneline opts (acctname, dep, total) (FormatField ljus
} }
-- | Render a single-column balance report as FODS. -- | Render a single-column balance report as FODS.
balanceReportAsSpreadsheet :: ReportOpts -> BalanceReport -> [[Ods.Cell]] balanceReportAsSpreadsheet :: ReportOpts -> BalanceReport -> [[Ods.Cell Text]]
balanceReportAsSpreadsheet opts (items, total) = balanceReportAsSpreadsheet opts (items, total) =
headers : headers :
concatMap (\(a, _, _, b) -> rows a b) items ++ concatMap (\(a, _, _, b) -> rows a b) items ++
@ -552,13 +552,13 @@ balanceReportAsSpreadsheet opts (items, total) =
else map (map (\c -> c {Ods.cellStyle = Ods.Body Ods.Total})) $ else map (map (\c -> c {Ods.cellStyle = Ods.Body Ods.Total})) $
rows totalRowHeadingCsv total rows totalRowHeadingCsv total
where where
cell content = Ods.defaultCell { Ods.cellContent = content } cell = Ods.defaultCell
headers = headers =
map (\content -> (cell content) {Ods.cellStyle = Ods.Head}) $ map (\content -> (cell content) {Ods.cellStyle = Ods.Head}) $
"account" : case layout_ opts of "account" : case layout_ opts of
LayoutBare -> ["commodity", "balance"] LayoutBare -> ["commodity", "balance"]
_ -> ["balance"] _ -> ["balance"]
rows :: AccountName -> MixedAmount -> [[Ods.Cell]] rows :: AccountName -> MixedAmount -> [[Ods.Cell Text]]
rows name ma = case layout_ opts of rows name ma = case layout_ opts of
LayoutBare -> LayoutBare ->
map (\a -> map (\a ->