cli: Write.Ods: write single amounts as numbers with units
This way you can do computations with the numbers in LibreOffice Calc.
This commit is contained in:
parent
7b136600fa
commit
ba0db5feec
@ -9,19 +9,28 @@ This is derived from <https://hackage.haskell.org/package/classify-frog-0.2.4.3/
|
||||
-}
|
||||
module Hledger.Write.Ods where
|
||||
|
||||
import Hledger.Data.Types (CommoditySymbol, Amount, AmountPrecision(..))
|
||||
import Hledger.Data.Types (acommodity, aquantity, astyle, asprecision)
|
||||
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import qualified Data.Text as T
|
||||
import Data.Text (Text)
|
||||
|
||||
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 (mapMaybe)
|
||||
|
||||
import qualified System.IO as IO
|
||||
import Text.Printf (printf)
|
||||
|
||||
|
||||
data Type = TypeString | TypeAmount
|
||||
data Type =
|
||||
TypeString
|
||||
| TypeAmount !Amount
|
||||
| TypeMixedAmount
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
data Style = Ordinary | Head | Foot
|
||||
@ -46,7 +55,7 @@ defaultCell =
|
||||
printFods ::
|
||||
IO.TextEncoding -> Map Text ((Maybe Int, Maybe Int), [[Cell]]) -> TL.Text
|
||||
printFods encoding tables =
|
||||
let fileOpen =
|
||||
let fileOpen customStyles =
|
||||
map (map (\c -> case c of '\'' -> '"'; _ -> c)) $
|
||||
printf "<?xml version='1.0' encoding='%s'?>" (show encoding) :
|
||||
"<office:document" :
|
||||
@ -82,6 +91,7 @@ printFods encoding tables =
|
||||
" <style:paragraph-properties fo:text-align='end'/>" :
|
||||
" <style:text-properties fo:font-weight='bold'/>" :
|
||||
" </style:style>" :
|
||||
customStyles ++
|
||||
"</office:styles>" :
|
||||
[]
|
||||
|
||||
@ -130,7 +140,9 @@ printFods encoding tables =
|
||||
[]
|
||||
|
||||
in TL.unlines $ map (TL.fromStrict . T.pack) $
|
||||
fileOpen ++
|
||||
fileOpen
|
||||
(numberConfig
|
||||
=<< Set.toList (numberStyles (foldMap (concat.snd) tables))) ++
|
||||
tableConfig (fmap fst tables) ++
|
||||
(Map.toAscList tables >>= \(name,(_,table)) ->
|
||||
tableOpen name ++
|
||||
@ -142,18 +154,65 @@ printFods encoding tables =
|
||||
tableClose) ++
|
||||
fileClose
|
||||
|
||||
|
||||
numberStyles :: [Cell] -> Set (CommoditySymbol, AmountPrecision)
|
||||
numberStyles =
|
||||
Set.fromList .
|
||||
mapMaybe (\cell ->
|
||||
case cellType cell of
|
||||
TypeAmount amt -> Just (acommodity amt, asprecision $ astyle amt)
|
||||
_ -> Nothing)
|
||||
|
||||
numberStyleName :: (CommoditySymbol, AmountPrecision) -> String
|
||||
numberStyleName (comm, prec) =
|
||||
printf "%s-%s" comm $
|
||||
case prec of
|
||||
NaturalPrecision -> "natural"
|
||||
Precision k -> show k
|
||||
|
||||
numberConfig :: (CommoditySymbol, AmountPrecision) -> [String]
|
||||
numberConfig (comm, prec) =
|
||||
let precStr =
|
||||
case prec of
|
||||
NaturalPrecision -> ""
|
||||
Precision k -> printf " number:decimal-places='%d'" k
|
||||
name = numberStyleName (comm, prec)
|
||||
in
|
||||
printf " <number:number-style style:name='number-%s'>" name :
|
||||
printf " <number:number number:min-integer-digits='1'%s/>" precStr :
|
||||
printf " <number:text>%s%s</number:text>"
|
||||
(if T.null comm then "" else " ") comm :
|
||||
" </number:number-style>" :
|
||||
" <style:style style:family='table-cell'" :
|
||||
printf " style:name='%s' style:data-style-name='number-%s'/>" name name :
|
||||
[]
|
||||
|
||||
|
||||
formatCell :: Cell -> [String]
|
||||
formatCell cell =
|
||||
let style :: String
|
||||
let style, valueType :: String
|
||||
style =
|
||||
case (cellStyle cell, cellType cell) of
|
||||
(Ordinary, TypeString) -> ""
|
||||
(Ordinary, TypeAmount) -> " table:style-name='amount'"
|
||||
(Ordinary, TypeMixedAmount) -> " table:style-name='amount'"
|
||||
(Ordinary, TypeAmount amt) -> numberStyle amt
|
||||
(Foot, TypeString) -> " table:style-name='foot'"
|
||||
(Foot, TypeAmount) -> " table:style-name='total-amount'"
|
||||
(Foot, _) -> " table:style-name='total-amount'"
|
||||
(Head, _) -> " table:style-name='head'"
|
||||
|
||||
numberStyle amt =
|
||||
printf " table:style-name='%s'"
|
||||
(numberStyleName (acommodity amt, asprecision $ astyle amt))
|
||||
valueType =
|
||||
case cellType cell of
|
||||
TypeAmount amt ->
|
||||
printf
|
||||
"office:value-type='float' office:value='%s'"
|
||||
(show $ aquantity amt)
|
||||
_ -> "office:value-type='string'"
|
||||
|
||||
in
|
||||
printf "<table:table-cell%s office:value-type='string'>" style :
|
||||
printf "<table:table-cell%s %s>" style valueType :
|
||||
printf "<text:p>%s</text:p>" (cellContent cell) :
|
||||
"</table:table-cell>" :
|
||||
[]
|
||||
|
||||
@ -585,14 +585,21 @@ balanceReportAsFods opts (items, total) =
|
||||
_ -> [[showName name, renderAmount ma]]
|
||||
|
||||
showName = cell . accountNameDrop (drop_ opts)
|
||||
renderAmount amt =
|
||||
(cell $ wbToText $ showMixedAmountB bopts amt) {
|
||||
Ods.cellType = Ods.TypeAmount
|
||||
renderAmount mixedAmt =
|
||||
(cell $ wbToText $ showMixedAmountB bopts mixedAmt) {
|
||||
Ods.cellType =
|
||||
case unifyMixedAmount mixedAmt of
|
||||
Just amt ->
|
||||
Ods.TypeAmount $
|
||||
if showcomm
|
||||
then amt
|
||||
else amt {acommodity = T.empty}
|
||||
Nothing -> Ods.TypeMixedAmount
|
||||
}
|
||||
where
|
||||
bopts = machineFmt{displayCommodity=showcomm, displayCommodityOrder = commorder}
|
||||
(showcomm, commorder)
|
||||
| layout_ opts == LayoutBare = (False, Just $ S.toList $ maCommodities amt)
|
||||
| layout_ opts == LayoutBare = (False, Just $ S.toList $ maCommodities mixedAmt)
|
||||
| otherwise = (True, Nothing)
|
||||
|
||||
-- Multi-column balance reports
|
||||
|
||||
Loading…
Reference in New Issue
Block a user