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 ->