{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE PolyKinds #-} -- For QuantFact {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} module Literate.Invoice.HTML where import Data.Time.Format.ISO8601 qualified as Time import Data.Time.LocalTime qualified as Time import Literate.Accounting.Math import Literate.Document qualified as Doc import Literate.Document.HTML import Literate.Invoice.Invoice import Literate.Prelude import Paths_literate_invoice qualified as Self import System.FilePath.Posix (()) import System.FilePath.Posix qualified as File import Text.Blaze.Html5.Attributes qualified as HA import Text.Printf qualified as Printf import Prelude qualified -- import Text.Blaze.Html5 qualified as H class HTMLIOable a where htmlIO :: a -> IO Html instance Doc.ToBlock Address where toBlock addr = do Doc.classes ["address"] $ Doc.Blocks $ fromList [ t & Doc.toBlock | t <- addr & addressText ] <> [ Doc.classes ["address-bottom"] [ addr & addressZipCode & Doc.toBlock , addr & addressCity & Doc.toBlock , addr & addressCountry & Doc.toBlock ] ] instance Doc.ToBlock Time.LocalTime where toBlock t = t & Time.localDay & Time.iso8601Show & fromString {- instance ToMarkup Address where toMarkup Address{..} = do div ! classes ["address"] $ do forM_ addressText \t -> div $ t & toHtml div ! classes ["address-bottom"] $ do div $ addressZipCode & toHtml div $ addressCity & toHtml div $ addressCountry & toHtml instance ToMarkup (String, Entity) where toMarkup (pos, Entity{..}) = do div ! classes ["entity"] $ do div ! classes ["key-value", "entity-name"] $ do div ! classes ["key"] $ do pos & toHtml ("\x202F:" :: String) & toHtml div ! classes ["value"] $ do entityName & toHtml div ! classes ["entity-address"] $ do entityAddress & toHtml case entitySIREN of Nothing -> return () Just siren -> do div ! classes ["key-value", "entity-siren"] $ do div ! classes ["key"] $ do ("SIREN\x202F:" :: String) & toHtml div ! classes ["value"] $ do siren & toHtml case entityEmail of Nothing -> return () Just email -> do div ! classes ["key-value", "entity-email"] $ do div ! classes ["key"] $ do ("Email\x202F:" :: String) & toHtml div ! classes ["value"] $ do a ! HA.href ("mailto:" <> toValue email) $ do email & toHtml -} instance Doc.ToBlock (String, Entity) where toBlock (pos, ent) = Doc.classes ["entity"] [ Doc.div { Doc.divClasses = ["entity-name"] , Doc.divBlock = [ Doc.Dict [ pos & Doc.toInline := ent & entityName & Doc.toBlock ] & Doc.toBlock , Doc.div { Doc.divClasses = ["entity-address"] , Doc.divBlock = [ent & entityAddress & Doc.toBlock] } & Doc.toBlock ] } & Doc.toBlock , Doc.Dict ( mconcat $ [ [ "SIREN" := siren & Doc.toBlock | siren <- ent & entitySIREN & maybeToList ] , -- FixMe: a ! HA.href ("mailto:" <> toValue email) [ "Email" := Doc.InlineLink { Doc.inlineLinkText = email & Doc.toInline , Doc.inlineLinkTarget = Doc.Target $ "mailto:" <> email } & Doc.toBlock | email <- ent & entityEmail & maybeToList ] ] ) & Doc.toBlock ] instance (ToMarkup (Quantity qf), UnitShowS unit) => ToMarkup (Amount qf unit) where toMarkup Amount{..} = (amountQuantity & 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: 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 return $ do docTypeHtml do head do title $ "invoice" forM_ ( [ "styles/Document.css" , "styles/Invoice.css" , "styles/List.css" , "styles/Paper.css" , "styles/Table.css" ] & list ) \cssFile -> link ! HA.rel "stylesheet" ! HA.type_ "text/css" ! HA.href (dataPath cssFile & toValue) -- styleCSS $ cssPrintPage pageOrientation pageSize -- styleCSS $ pagesDifficulties & difficultyCSS body do section ! classes ["A4", "portrait", "sheet"] ! styles ["size" := "A4 portrait"] $ toHtml do Doc.classes ["invoice"] [ Doc.flex { Doc.flexDirection = Doc.FlexDirectionColumn , Doc.flexGap = 0.5 & Doc.cm , Doc.flexItems = [ Doc.Dict [ "Invoice" := invId & Doc.toInline & Doc.BlockPara , "IssueDate" := inv & invoiceCreation & Doc.toBlock ] & Doc.toBlock , Doc.classes ["invoice-from-to"] [ Doc.toBlock $ ("Seller" :: String) := inv & invoiceIssuer , Doc.toBlock $ ("Buyer" :: String) := inv & invoiceCustomer ] , Doc.classes ["invoice-details"] [ Doc.table { Doc.tableTemplate = [ Doc.LengthRelative $ Doc.LengthRelativeMaxContent , Doc.LengthRelative $ 2 & Doc.fr , Doc.LengthRelative $ 1 & Doc.fr , Doc.LengthRelative $ 1 & Doc.fr , Doc.LengthRelative $ 1 & Doc.fr , Doc.LengthRelative $ 1 & Doc.fr , Doc.LengthRelative $ 1 & Doc.fr ] , Doc.tableRowsEvenOdd = True , Doc.tableHeads = Just [ Doc.tableCell{Doc.tableCellContent = "#"} , Doc.tableCell{Doc.tableCellContent = "Description"} , Doc.tableCell{Doc.tableCellContent = "Begin"} , Doc.tableCell{Doc.tableCellContent = "End"} , Doc.tableCell{Doc.tableCellContent = "Rate (excl.\xA0taxes.)"} , Doc.tableCell{Doc.tableCellContent = "Quantity"} , Doc.tableCell{Doc.tableCellContent = "Total (excl.\xA0taxes.)"} ] , Doc.tableRows = [ [ Doc.tableCell { Doc.tableCellContent = itemCount & Doc.toBlock , Doc.tableCellJustify = Doc.JustificationEnd } , Doc.tableCell { Doc.tableCellContent = invoiceItem & invoiceItemDescription , Doc.tableCellJustify = Doc.JustificationLeft } , Doc.tableCell { Doc.tableCellContent = invoiceItem & invoiceItemPeriod & periodBegin & Doc.toBlock , Doc.tableCellJustify = Doc.JustificationLeft } , Doc.tableCell { Doc.tableCellContent = invoiceItem & invoiceItemPeriod & periodEnd & Doc.toBlock , Doc.tableCellJustify = Doc.JustificationLeft } , Doc.tableCell { Doc.tableCellContent = invoiceItem & invoiceItemRate & Doc.toBlock , Doc.tableCellJustify = Doc.JustificationEnd } , Doc.tableCell { Doc.tableCellContent = invoiceItem & invoiceItemQuantity & Doc.toBlock , Doc.tableCellJustify = Doc.JustificationEnd } , Doc.tableCell { Doc.tableCellContent = invoiceItem & invoiceItemTotal & Doc.toBlock , Doc.tableCellJustify = Doc.JustificationEnd } ] | (itemCount, invoiceItem) <- inv & invoiceItems & ol1 ] } & Doc.toBlock ] , Doc.table { Doc.tableHeads = Just [ Doc.tableCell{Doc.tableCellContent = "Total quantity"} , Doc.tableCell{Doc.tableCellContent = "Total (excl. taxes)"} ] , Doc.tableRows = [ [ Doc.tableCell { Doc.tableCellJustify = Doc.JustificationCenter , Doc.tableCellContent = sumAmounts [ itm & invoiceItemQuantity | itm <- inv & invoiceItems ] & fromMaybe 0 & Doc.toBlock } , Doc.tableCell { Doc.tableCellJustify = Doc.JustificationCenter , Doc.tableCellContent = sumAmounts [ itm & invoiceItemTotal | itm <- inv & invoiceItems ] & fromMaybe 0 & Doc.toBlock } ] ] } & Doc.toBlock , Doc.List [ case mention of InvoiceMentionTVANonApplicable -> "—" := "TVA non applicable, art. 293 B du code général des impôts" | mention <- inv & invoiceMentions ] & Doc.toBlock ] <&> \blk -> (Doc.flexItem{Doc.flexItemContent = [blk]}) } & Doc.toBlock ]