{-# 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.Document.Type (Block (BlockPara)) 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 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 (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.ToInlines (Quantity qf), UnitShowS unit) => Doc.ToInlines (Amount qf unit) where toInlines Amount{..} = (amountQuantity & Doc.toInlines) <> (if null unit then "" else "\x202F" <> (unit & Doc.toInlines)) 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.toInlines 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.ToInlines (Quantity qf) where toInlines qty = do Doc.toInlines $ 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.toInlines instance HTMLIOable (InvoiceId, Invoice) where htmlIO (invoiceId, invoice@Invoice{..}) = 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/Paper.css" , "styles/Table.css" , "styles/Invoice.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"] $ do div ! classes ["invoice"] $ do div ! classes ["key-value", "invoice-id"] $ do div ! classes ["key"] $ do ("Invoice#\x202F:" :: String) & toHtml div ! classes ["value"] $ do invoiceId & toHtml div ! classes ["key-value", "invoice-creation"] $ do div ! classes ["key"] $ do ("Date\x202F:" :: String) & toHtml div ! classes ["value"] $ do invoiceCreation & Time.localDay & Time.iso8601Show & toHtml div ! classes ["invoice-from-to"] $ do div ! classes ["invoice-issuer"] $ do toHtml $ ("Seller" :: String) := invoiceIssuer div ! classes ["invoice-recipient"] $ do toHtml $ ("Buyer" :: String) := invoiceCustomer toHtml $ Doc.BlockFlex Doc.flex { Doc.flexDirection = Doc.FlexDirectionColumn , Doc.flexGap = 0.5 & Doc.cm , Doc.flexItems = [ Doc.flexItem { Doc.flexItemContent = [ Doc.BlockTable Doc.table { Doc.tableTemplate = [ Doc.LengthRelative $ Doc.LengthRelativeMaxContent , Doc.LengthRelative $ 5 & Doc.fr , Doc.LengthRelative $ 1 & Doc.fr , Doc.LengthRelative $ 1 & Doc.fr , Doc.LengthRelative $ 1 & Doc.fr ] , Doc.tableRowsEvenOdd = True , Doc.tableHeads = Doc.Head { Doc.tableHeadColumns = [ Doc.tableCell{Doc.tableCellContent = "#"} , Doc.tableCell{Doc.tableCellContent = "Description"} , Doc.tableCell{Doc.tableCellContent = "Rate (excl.\xA0taxes.)"} , Doc.tableCell{Doc.tableCellContent = "Quantity"} , Doc.tableCell{Doc.tableCellContent = "Total (excl.\xA0taxes.)"} ] } & Just , Doc.tableRows = [ Doc.TableRow { tableRowColumns = [ Doc.tableCell { Doc.tableCellContent = itemCount & Doc.toBlock , Doc.tableCellJustify = Doc.JustificationEnd } , Doc.tableCell { Doc.tableCellContent = invoiceItem & invoiceItemDescription & 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) <- invoiceItems & ol1 ] } ] } , Doc.flexItem { Doc.flexItemContent = [ Doc.BlockTable Doc.table { Doc.tableHeads = Just Doc.Head { tableHeadColumns = [ Doc.tableCell{Doc.tableCellContent = "Total quantity"} , Doc.tableCell{Doc.tableCellContent = "Total (excl. taxes)"} ] } , Doc.tableRows = [ Doc.tableRow { Doc.tableRowColumns = [ Doc.tableCell { Doc.tableCellJustify = Doc.JustificationCenter , Doc.tableCellContent = sumAmounts [ itm & invoiceItemQuantity | itm <- invoiceItems ] & fromMaybe 0 & Doc.toBlock } , Doc.tableCell { Doc.tableCellJustify = Doc.JustificationCenter , Doc.tableCellContent = sumAmounts [ itm & invoiceItemTotal | itm <- invoiceItems ] & fromMaybe 0 & Doc.toBlock } ] } ] } ] } ] }