{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE PolyKinds #-} -- For QuantFact {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} module Literate.Invoice.HTML where import Data.List qualified as List import Data.Map.Strict qualified as Map import Data.Time qualified as Time import Literate.Accounting.Math import Literate.Accounting.Math qualified as Math import Literate.Document.HTML import Literate.Document.HTML qualified as HTML import Literate.Document.Table qualified as Doc import Literate.Document.Type qualified as Doc import Literate.Invoice.Invoice import Literate.Organization import Literate.Prelude import Paths_literate_invoice qualified as Self import System.FilePath.Posix qualified as File import Text.Printf qualified as Printf import Prelude qualified class HTMLIOable a where htmlIO :: a -> IO Html instance Doc.ToBlock InvoiceType where toBlock = \case InvoiceTypeProForma -> "pro forma" InvoiceTypeSale -> "sale" InvoiceTypeVoucher -> "voucher" instance Doc.ToBlock InvoiceItemType where toBlock = \case InvoiceItemTypeItem -> "item" InvoiceItemTypeService -> "service" instance (ToMarkup (Quantity qf), UnitShowS unit) => ToMarkup (Amount qf unit) where toMarkup Amount{..} = (amountQuantity & HTML.toMarkup) <> (if null unit then "" else "\x202F" <> (unit & toHtml)) where unit = unitShow @unit instance (Doc.ToInline (Quantity qf), UnitShowS unit) => Doc.ToInline (Amount qf unit) where toInline Amount{..} = (amountQuantity & Doc.toInline) <> (if null unit then "" else "\x202F" <> (unit & Doc.toInline)) where unit = unitShow @unit instance (Doc.ToBlock (Quantity qf), QuantFact qf, UnitShowS unit) => Doc.ToBlock (Amount qf unit) where toBlock x = Doc.BlockPara $ x & Doc.toInline instance QuantFact qf => ToMarkup (Quantity qf) where toMarkup qty = do toHtml $ qty & quantityToRatio @qf & (Prelude.toRational >>> Prelude.fromRational :: Ratio Natural -> Double) & ( `Printf.formatArg` Printf.FieldFormat { fmtAdjust = Nothing , fmtAlternate = False , fmtChar = 'f' , fmtModifiers = "" , fmtPrecision = Just $ quantisationFactor @qf & (Prelude.fromIntegral :: _ -> Double) & Prelude.logBase 10 & Prelude.floor , fmtSign = Nothing , fmtWidth = Nothing } ) & ($ "") instance QuantFact qf => Doc.ToInline (Quantity qf) where toInline qty = Doc.toInline do qty & quantityToRatio @qf & (Prelude.toRational >>> Prelude.fromRational :: Ratio Natural -> Double) & ( `Printf.formatArg` Printf.FieldFormat { fmtAdjust = Nothing , fmtAlternate = False , fmtChar = 'f' , fmtModifiers = "" , fmtPrecision = Just $ quantisationFactor @qf & (Prelude.fromIntegral :: _ -> Double) & Prelude.logBase 10 & Prelude.floor , fmtSign = Nothing , fmtWidth = Nothing } ) & ($ "") instance QuantFact qf => Doc.ToBlock (Quantity qf) where toBlock x = Doc.BlockPara $ x & Doc.toInline instance HTMLIOable (InvoiceId, Invoice) where htmlIO (invId, inv) = do -- FixMe(portability): this absolute path is not portable out of my system dataPath <- Self.getDataDir <&> File.normalise -- paperCSS <- dataPath "styles" "Paper.css" & BS.readFile <&> Text.decodeUtf8 -- invoiceCSS <- dataPath "styles" "Invoice.css" & BS.readFile <&> Text.decodeUtf8 let invSummary :: [InvoiceItem _ _] = invoiceSummary (inv & invoiceRates) (inv & invoiceLogs) & foldMap (foldMap pure) let invSummaryQuantityTotal :: Math.Quantity 100 = invSummary <&> invoiceItemQuantity <&> Math.amountQuantity & Math.sumQuantities & fromMaybe 0 let invTitle :: Doc.Inline = Doc.toInline $ List.intersperse " - " $ mconcat [ case inv & invoiceIssuer & orgEntity & entityName of Nothing -> [] Just n -> [Doc.toInline n] , [inv & invoiceEmittedOn & Doc.toInline] , ["Invoice #" <> (invId & Doc.toInline)] , inv & invoiceOrders ] return $ toHtml $ dataPath := Doc.Document { documentTitle = invTitle , documentAttachments = [ "css" := [ "styles/Document.css" , "styles/Invoice.css" , "styles/List.css" , "styles/Paper.css" , "styles/Table.css" ] ] , documentPages = [ [ Doc.page { Doc.pageSection = Just $ invTitle , Doc.pageContent = Doc.flex { Doc.flexDirection = Doc.FlexDirectionColumn , Doc.flexGap = 0.5 & Doc.cm , Doc.flexItems = [ "Invoice" & Doc.classes ["title"] , Doc.section ( [ ["InvoiceIdentifier" := invId & Doc.toInline & Doc.toBlock] , ["InvoiceType" := invId & invoiceIdType & Doc.toBlock] , ["InvoiceOrders" := inv & invoiceOrders <&> (\x -> "-" := Doc.toBlock x) & Doc.List & Doc.toBlock] , ["InvoiceEmittedOn" := inv & invoiceEmittedOn & Doc.toBlock] , ["InvoicePaymentDueBefore" := inv & invoicePaymentDueBefore & Doc.toBlock] ] & mconcat & Doc.Dict & Doc.toBlock ) & (\x -> x{Doc.containerClasses = ["invoice-headers"]}) & Doc.BlockDiv , Doc.section [ organization { orgParts = [ "Seller" := inv & invoiceIssuer , "Buyer" := inv & invoiceRecipient ] } & Doc.toBlock ] & \x -> x{Doc.containerClasses = ["invoice-from-to"]} & Doc.BlockDiv , Doc.section [ "Grand totals" & Doc.classes ["title"] , Doc.table { Doc.tableHeads = Just [ "Time frame" , "Workload" , "To pay (excl. taxes)" ] , Doc.tableRows = [ [ Doc.tableCell { Doc.tableCellJustify = Doc.JustifyCenter , Doc.tableCellContent = invSummary <&> invoiceItemPeriod & List.foldr1 ( \x y -> Period { periodBeginning = min (x & periodBeginning) (y & periodBeginning) , periodEnd = max (x & periodEnd) (y & periodEnd) } ) & \period -> [ period & periodBeginning & Doc.toInline & Doc.BlockPara , period & periodEnd & Doc.toInline & Doc.BlockPara ] } , Doc.tableCell { Doc.tableCellJustify = Doc.JustifyCenter , Doc.tableCellContent = sumAmounts [ itm & invoiceItemQuantity | itm <- invSummary ] & fromMaybe 0 & Doc.toBlock } , Doc.tableCell { Doc.tableCellJustify = Doc.JustifyCenter , Doc.tableCellContent = sumAmounts [ itm & invoiceItemTotal | itm <- invSummary ] & fromMaybe 0 & Doc.toBlock } ] ] } & Doc.toBlock ] & Doc.BlockDiv , Doc.section [ "Mandatory legal notices" & Doc.classes ["title"] , Doc.List [ case mention of InvoiceMentionTVANonApplicable -> -- "TVA non applicable, art. 293 B du code général des impôts." "—" := "VAT not applicable, art. 293 B of the French General Tax Code." InvoiceMentionIndemnitéForfaitaire -> "—" := [ -- "Indemnité forfaitaire pour frais de recouvrement en cas de retard de paiement\x202F: " "Fixed compensation for recovery costs in case of late payment: " , (40 :: Math.Amount 100 (Math.UnitName "€")) & Doc.toInline ] & Doc.BlockPara InvoiceMentionIndemnitéTaux rate -> "—" := [ -- "Taux des pénalités pour retard de paiement exigibles à compter du " "Late payment penalty rate (applicable from " , inv & invoicePaymentDueBefore & Time.addLocalTime Time.nominalDay & Doc.toInline , -- , "\x202F: " "): " , rate & Doc.toInline , -- , " × montant impayé × nombre de jours de retard / 365.25" " × unpaid amount × number of days late / 365.25" ] & Doc.BlockPara | mention <- inv & invoiceMentions ] & Doc.toBlock ] & Doc.BlockDiv ] <&> \blk -> Doc.flexItem{Doc.flexItemContent = blk} } & Doc.toBlock } ] , invSummary & ol1 & chunksOf 15 <&> \invItemsChunk -> Doc.page { Doc.pageSection = Just $ invTitle <> " — Summary" , Doc.pageContent = Doc.flex { Doc.flexDirection = Doc.FlexDirectionColumn , Doc.flexGap = 0.5 & Doc.cm , Doc.flexItems = [ Doc.flexItem { Doc.flexItemContent = [ [ ("Summary" :: Text) & Doc.toBlock & Doc.classes ["title"] | invItemsChunk & headMaybe & maybe False (fst >>> (== 1)) ] & Doc.toBlock , [ Doc.table { Doc.tableTemplate = [ Doc.LengthRelative $ Doc.LengthRelativeMaxContent , Doc.LengthRelative $ Doc.LengthRelativeMaxContent , Doc.LengthRelative $ 1 & Doc.fr , Doc.LengthRelative $ Doc.LengthRelativeMaxContent , Doc.LengthRelative $ Doc.LengthRelativeMaxContent , Doc.LengthRelative $ Doc.LengthRelativeMaxContent , Doc.LengthRelative $ Doc.LengthRelativeMaxContent , Doc.LengthRelative $ Doc.LengthRelativeMaxContent ] , Doc.tableRowsEvenOdd = True , Doc.tableHeads = Just [ "#" , "Type" , "Scope" , "Action" , "Time frame" , Doc.tableCell { Doc.tableCellContent = [ "Rate" & Doc.BlockPara , "(excl.\xA0taxes.)" & Doc.BlockPara ] , Doc.tableCellJustify = Doc.JustifyCenter } , "Quantity" , Doc.tableCell { Doc.tableCellContent = [ "Total" & Doc.BlockPara , "(excl.\xA0taxes.)" & Doc.BlockPara ] , Doc.tableCellJustify = Doc.JustifyCenter } ] , Doc.tableRows = [ [ Doc.tableCell { Doc.tableCellContent = itemCount & Printf.printf "%i" & Doc.toBlock @String , Doc.tableCellJustify = Doc.JustifyEnd } , Doc.tableCell { Doc.tableCellContent = invItem & invoiceItemType & Doc.toBlock , Doc.tableCellJustify = Doc.JustifyCenter } , Doc.tableCell { Doc.tableCellContent = invItem & invoiceItemScope & pathToBlock , Doc.tableCellJustify = Doc.JustifyStart } , Doc.tableCell { Doc.tableCellContent = invItem & invoiceItemAction & pathToBlock , Doc.tableCellJustify = Doc.JustifyStart } , Doc.tableCell { Doc.tableCellContent = [ invItem & invoiceItemPeriod & periodBeginning & Doc.toInline & Doc.BlockPara , invItem & invoiceItemPeriod & periodEnd & Doc.toInline & Doc.BlockPara ] , Doc.tableCellJustify = Doc.JustifyStart } , Doc.tableCell { Doc.tableCellContent = invItem & invoiceItemRate & Doc.toBlock , Doc.tableCellJustify = Doc.JustifyEnd } , Doc.tableCell { Doc.tableCellContent = [ invItem & invoiceItemQuantity & Doc.toBlock , let (qtyPercent, _actualRate) = Math.fraction (invSummaryQuantityTotal & Math.quantityToRatio & (100 Prelude./)) (invItem & invoiceItemQuantity & Math.amountQuantity) in qtyPercent & Math.quantityToRational & (fromRational :: _ -> Double) & (Printf.printf "(%02f%%)" :: _ -> String) & Doc.toBlock ] , Doc.tableCellJustify = Doc.JustifyEnd } , Doc.tableCell { Doc.tableCellContent = invItem & invoiceItemTotal & Doc.toBlock , Doc.tableCellJustify = Doc.JustifyEnd } ] | (itemCount, invItem) <- invItemsChunk ] } & Doc.toBlock ] ] } ] } & Doc.toBlock & Doc.section & ( \x -> x{Doc.containerClasses = ["invoice-summary"]} ) & Doc.toBlock } , inv & invoiceLogs & ol1 & chunksOf 15 <&> \invLogsChunk -> Doc.page { Doc.pageSection = Just $ invTitle <> " — Details" , Doc.pageContent = Doc.flex { Doc.flexDirection = Doc.FlexDirectionColumn , Doc.flexGap = 0.5 & Doc.cm , Doc.flexItems = [ Doc.flexItem { Doc.flexItemContent = [ [ ("Details" :: Text) & Doc.toBlock & Doc.classes ["title"] | invLogsChunk & headMaybe & maybe False (fst >>> (== 1)) ] & Doc.toBlock , Doc.table { Doc.tableTemplate = [ Doc.LengthRelative $ Doc.LengthRelativeMaxContent , Doc.LengthRelative $ Doc.LengthRelativeMaxContent , Doc.LengthRelative $ Doc.LengthRelativeMaxContent , Doc.LengthRelative $ 1 & Doc.fr , Doc.LengthRelative $ 1 & Doc.fr , Doc.LengthAbsolute $ 5 & Doc.cm , Doc.LengthRelative $ 2 & Doc.fr ] , Doc.tableRowsEvenOdd = True , Doc.tableHeads = Just [ "#" , "Date" , "Duration" , "Scope" , "Action" , "References" , "Description" ] , Doc.tableRows = [ [ Doc.tableCell { Doc.tableCellContent = logCount & Printf.printf "%i" & Doc.toBlock @String , Doc.tableCellJustify = Doc.JustifyEnd } , Doc.tableCell { Doc.tableCellContent = invoiceLog & invoiceLogDate & Doc.toBlock , Doc.tableCellJustify = Doc.JustifyCenter } , Doc.tableCell { Doc.tableCellContent = invoiceLog & invoiceLogDuration & Doc.toBlock , Doc.tableCellJustify = Doc.JustifyEnd } , Doc.tableCell { Doc.tableCellContent = invoiceLog & invoiceLogScope & pathToBlock , Doc.tableCellJustify = Doc.JustifyStart } , Doc.tableCell { Doc.tableCellContent = invoiceLog & invoiceLogAction & pathToBlock , Doc.tableCellJustify = Doc.JustifyStart } , Doc.tableCell { Doc.tableCellContent = [ ref & Doc.toInline | ref <- invoiceLog & invoiceLogReferences ] & Doc.toInline & Doc.toBlock , Doc.tableCellJustify = Doc.JustifyStart } , Doc.tableCell { Doc.tableCellContent = invoiceLog & invoiceLogDescription & Doc.toBlock , Doc.tableCellJustify = Doc.JustifyStart } ] | (logCount, invoiceLog) <- invLogsChunk & traceShowId ] } & Doc.toBlock ] } ] } & Doc.toBlock & Doc.section & (\x -> x{Doc.containerClasses = ["invoice-details"]}) & Doc.toBlock } ] & mconcat & ol1 & \l -> l & List.map \(pageIdx, pag) -> pag { Doc.pageOrientation = Doc.PageOrientationPortrait , Doc.pageSize = Doc.PageSizeA4 , Doc.pageNumber = Just pageIdx , Doc.pageNumberTotal = Just $ l & List.length & fromIntegral , Doc.pageSide = Just $ if pageIdx & even then Doc.PageSideLeft else Doc.PageSideRight } } where pathToBlock segs = [ seg & Doc.toInline | seg <- segs ] & List.intersperse " / " & Doc.toInline & Doc.toBlock invoiceSummary :: _ -> _ -> Map [Text] (Map [Text] (InvoiceItem _ _)) invoiceSummary invRates invLogs = Map.unionsWith ( Map.unionWith ( \x y -> InvoiceItem { invoiceItemScope = x & invoiceItemScope , invoiceItemAction = x & invoiceItemAction , invoiceItemPeriod = Period { periodBeginning = min (x & invoiceItemPeriod & periodBeginning) (y & invoiceItemPeriod & periodBeginning) , periodEnd = max (x & invoiceItemPeriod & periodEnd) (y & invoiceItemPeriod & periodEnd) } , invoiceItemQuantity = (x & invoiceItemQuantity) + (y & invoiceItemQuantity) , invoiceItemType = x & invoiceItemType , invoiceItemRate = x & invoiceItemRate } ) ) [ Map.singleton (invLog & invoiceLogScope) $ Map.singleton (invLog & invoiceLogAction) $ InvoiceItem { invoiceItemScope = invLog & invoiceLogScope , invoiceItemAction = invLog & invoiceLogAction , invoiceItemType = InvoiceItemTypeService , invoiceItemQuantity = invLog & invoiceLogDuration , invoiceItemPeriod = Period { periodBeginning = invLog & invoiceLogDate , periodEnd = invLog & invoiceLogDate } , invoiceItemRate = invRates & Map.lookup (invLog & invoiceLogAction) & fromMaybe (errorShow ("missing action" :: Text, invLog & invoiceLogAction)) } | invLog <- invLogs ]