diff --git a/hledger-lib/Hledger/Write/Html.hs b/hledger-lib/Hledger/Write/Html.hs
index 282caa468..037d3dc8a 100644
--- a/hledger-lib/Hledger/Write/Html.hs
+++ b/hledger-lib/Hledger/Write/Html.hs
@@ -15,15 +15,15 @@ import qualified Lucid
import Data.Foldable (for_)
-printHtml :: [[Cell]] -> Lucid.Html ()
+printHtml :: [[Cell (Lucid.Html ())]] -> Lucid.Html ()
printHtml table =
Lucid.table_ $ for_ table $ \row ->
Lucid.tr_ $ for_ row $ \cell ->
formatCell cell
-formatCell :: Cell -> Lucid.Html ()
+formatCell :: Cell (Lucid.Html ()) -> Lucid.Html ()
formatCell cell =
- let str = Lucid.toHtml $ cellContent cell in
+ let str = cellContent cell in
case cellStyle cell of
Head -> Lucid.th_ str
Body emph ->
diff --git a/hledger-lib/Hledger/Write/Ods.hs b/hledger-lib/Hledger/Write/Ods.hs
index 82bade471..b87b9fbe5 100644
--- a/hledger-lib/Hledger/Write/Ods.hs
+++ b/hledger-lib/Hledger/Write/Ods.hs
@@ -32,7 +32,8 @@ import Text.Printf (printf)
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 =
let fileOpen customStyles =
map (map (\c -> case c of '\'' -> '"'; _ -> c)) $
@@ -136,7 +137,7 @@ printFods encoding tables =
fileClose
-cellStyles :: [Cell] -> Set (Emphasis, (CommoditySymbol, AmountPrecision))
+cellStyles :: [Cell Text] -> Set (Emphasis, (CommoditySymbol, AmountPrecision))
cellStyles =
Set.fromList .
mapMaybe (\cell ->
@@ -195,7 +196,7 @@ cellConfig (emph, numParam) =
[]
-formatCell :: Cell -> [String]
+formatCell :: Cell Text -> [String]
formatCell cell =
let style, valueType :: String
style =
diff --git a/hledger-lib/Hledger/Write/Spreadsheet.hs b/hledger-lib/Hledger/Write/Spreadsheet.hs
index ae3d4a26d..3724c61f0 100644
--- a/hledger-lib/Hledger/Write/Spreadsheet.hs
+++ b/hledger-lib/Hledger/Write/Spreadsheet.hs
@@ -8,13 +8,11 @@ module Hledger.Write.Spreadsheet (
Emphasis(..),
Cell(..),
defaultCell,
+ emptyCell,
) where
import Hledger.Data.Types (Amount)
-import qualified Data.Text as T
-import Data.Text (Text)
-
data Type =
TypeString
@@ -28,17 +26,23 @@ data Style = Body Emphasis | Head
data Emphasis = Item | Total
deriving (Eq, Ord, Show)
-data Cell =
+data Cell text =
Cell {
cellType :: Type,
cellStyle :: Style,
- cellContent :: Text
+ cellContent :: text
}
-defaultCell :: Cell
-defaultCell =
+instance Functor Cell where
+ fmap f (Cell typ style content) = Cell typ style $ f content
+
+defaultCell :: text -> Cell text
+defaultCell text =
Cell {
cellType = TypeString,
cellStyle = Body Item,
- cellContent = T.empty
+ cellContent = text
}
+
+emptyCell :: (Monoid text) => Cell text
+emptyCell = defaultCell mempty
diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs
index 77936e4bd..5c32ff065 100644
--- a/hledger/Hledger/Cli/Commands/Balance.hs
+++ b/hledger/Hledger/Cli/Commands/Balance.hs
@@ -404,7 +404,7 @@ balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ of
"csv" -> \ropts1 -> printCSV . balanceReportAsCsv ropts1
"tsv" -> \ropts1 -> printTSV . balanceReportAsCsv ropts1
"html" -> \ropts1 -> (<>"\n") . L.renderText .
- printHtml . balanceReportAsSpreadsheet ropts1
+ printHtml . map (map (fmap L.toHtml)) . balanceReportAsSpreadsheet ropts1
"json" -> const $ (<>"\n") . toJsonText
"fods" -> \ropts1 -> printFods IO.localeEncoding . Map.singleton "Hledger" . (,) (Just 1, Nothing) . balanceReportAsSpreadsheet ropts1
_ -> 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.
-balanceReportAsSpreadsheet :: ReportOpts -> BalanceReport -> [[Ods.Cell]]
+balanceReportAsSpreadsheet :: ReportOpts -> BalanceReport -> [[Ods.Cell Text]]
balanceReportAsSpreadsheet opts (items, total) =
headers :
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})) $
rows totalRowHeadingCsv total
where
- cell content = Ods.defaultCell { Ods.cellContent = content }
+ cell = Ods.defaultCell
headers =
map (\content -> (cell content) {Ods.cellStyle = Ods.Head}) $
"account" : case layout_ opts of
LayoutBare -> ["commodity", "balance"]
_ -> ["balance"]
- rows :: AccountName -> MixedAmount -> [[Ods.Cell]]
+ rows :: AccountName -> MixedAmount -> [[Ods.Cell Text]]
rows name ma = case layout_ opts of
LayoutBare ->
map (\a ->