src/Literate/Invoice/HTML.hs

   1 {-# LANGUAGE OverloadedLists #-}
   2 {-# LANGUAGE PolyKinds #-}
   3 -- For QuantFact
   4 {-# LANGUAGE UndecidableInstances #-}
   5 {-# OPTIONS_GHC -Wno-orphans #-}
   6
   7 module Literate.Invoice.HTML where
   8
   9 import Data.List qualified as List
  10 import Data.Map.Strict qualified as Map
  11 import Data.Time qualified as Time
  12 import Literate.Accounting.Math
  13 import Literate.Accounting.Math qualified as Math
  14 import Literate.Document.HTML
  15 import Literate.Document.HTML qualified as HTML
  16 import Literate.Document.Table qualified as Doc
  17 import Literate.Document.Type qualified as Doc
  18 import Literate.Invoice.Invoice
  19 import Literate.Organization
  20 import Literate.Prelude
  21 import Paths_literate_invoice qualified as Self
  22 import System.FilePath.Posix qualified as File
  23 import Text.Printf qualified as Printf
  24 import Prelude qualified
  25
  26 class HTMLIOable a where
  27   htmlIO :: a -> IO Html
  28
  29 instance Doc.ToBlock InvoiceType where
  30   toBlock = \case
  31     InvoiceTypeProForma -> "pro forma"
  32     InvoiceTypeSale -> "sale"
  33     InvoiceTypeVoucher -> "voucher"
  34 instance Doc.ToBlock InvoiceItemType where
  35   toBlock = \case
  36     InvoiceItemTypeItem -> "item"
  37     InvoiceItemTypeService -> "service"
  38
  39 instance (ToMarkup (Quantity qf), UnitShowS unit) => ToMarkup (Amount qf unit) where
  40   toMarkup Amount{..} =
  41     (amountQuantity & HTML.toMarkup)
  42       <> (if null unit then "" else "\x202F" <> (unit & toHtml))
  43     where
  44       unit = unitShow @unit
  45 instance (Doc.ToInline (Quantity qf), UnitShowS unit) => Doc.ToInline (Amount qf unit) where
  46   toInline Amount{..} =
  47     (amountQuantity & Doc.toInline)
  48       <> (if null unit then "" else "\x202F" <> (unit & Doc.toInline))
  49     where
  50       unit = unitShow @unit
  51 instance (Doc.ToBlock (Quantity qf), QuantFact qf, UnitShowS unit) => Doc.ToBlock (Amount qf unit) where
  52   toBlock x = Doc.BlockPara $ x & Doc.toInline
  53
  54 instance QuantFact qf => ToMarkup (Quantity qf) where
  55   toMarkup qty = do
  56     toHtml $
  57       qty
  58         & quantityToRatio @qf
  59         & (Prelude.toRational >>> Prelude.fromRational :: Ratio Natural -> Double)
  60         & ( `Printf.formatArg`
  61               Printf.FieldFormat
  62                 { fmtAdjust = Nothing
  63                 , fmtAlternate = False
  64                 , fmtChar = 'f'
  65                 , fmtModifiers = ""
  66                 , fmtPrecision =
  67                     Just $
  68                       quantisationFactor @qf
  69                         & (Prelude.fromIntegral :: _ -> Double)
  70                         & Prelude.logBase 10
  71                         & Prelude.floor
  72                 , fmtSign = Nothing
  73                 , fmtWidth = Nothing
  74                 }
  75           )
  76         & ($ "")
  77 instance QuantFact qf => Doc.ToInline (Quantity qf) where
  78   toInline qty = Doc.toInline do
  79     qty
  80       & quantityToRatio @qf
  81       & (Prelude.toRational >>> Prelude.fromRational :: Ratio Natural -> Double)
  82       & ( `Printf.formatArg`
  83             Printf.FieldFormat
  84               { fmtAdjust = Nothing
  85               , fmtAlternate = False
  86               , fmtChar = 'f'
  87               , fmtModifiers = ""
  88               , fmtPrecision =
  89                   Just $
  90                     quantisationFactor @qf
  91                       & (Prelude.fromIntegral :: _ -> Double)
  92                       & Prelude.logBase 10
  93                       & Prelude.floor
  94               , fmtSign = Nothing
  95               , fmtWidth = Nothing
  96               }
  97         )
  98       & ($ "")
  99 instance QuantFact qf => Doc.ToBlock (Quantity qf) where
 100   toBlock x = Doc.BlockPara $ x & Doc.toInline
 101
 102 instance HTMLIOable (InvoiceId, Invoice) where
 103   htmlIO (invId, inv) = do
 104     -- FixMe(portability): this absolute path is not portable out of my system
 105     dataPath <- Self.getDataDir <&> File.normalise
 106     -- paperCSS <- dataPath </> "styles" </> "Paper.css" & BS.readFile <&> Text.decodeUtf8
 107     -- invoiceCSS <- dataPath </> "styles" </> "Invoice.css" & BS.readFile <&> Text.decodeUtf8
 108     let invSummary :: [InvoiceItem _ _] =
 109           invoiceSummary (inv & invoiceRates) (inv & invoiceLogs)
 110             & foldMap (foldMap pure)
 111     let invSummaryQuantityTotal :: Math.Quantity 100 =
 112           invSummary <&> invoiceItemQuantity <&> Math.amountQuantity & Math.sumQuantities & fromMaybe 0
 113     let invTitle :: Doc.Inline =
 114           Doc.toInline $
 115             List.intersperse " - " $
 116               mconcat
 117                 [ case inv & invoiceIssuer & orgEntity & entityName of
 118                     Nothing -> []
 119                     Just n -> [Doc.toInline n]
 120                 , [inv & invoiceEmittedOn & Doc.toInline]
 121                 , ["Invoice #" <> (invId & Doc.toInline)]
 122                 , inv & invoiceOrders
 123                 ]
 124     return $
 125       toHtml $
 126         dataPath :=
 127           Doc.Document
 128             { documentTitle = invTitle
 129             , documentAttachments =
 130                 [ "css" :=
 131                     [ "styles/Document.css"
 132                     , "styles/Invoice.css"
 133                     , "styles/List.css"
 134                     , "styles/Paper.css"
 135                     , "styles/Table.css"
 136                     ]
 137                 ]
 138             , documentPages =
 139                 [
 140                   [ Doc.page
 141                       { Doc.pageSection = Just $ invTitle
 142                       , Doc.pageContent =
 143                           Doc.flex
 144                             { Doc.flexDirection = Doc.FlexDirectionColumn
 145                             , Doc.flexGap = 0.5 & Doc.cm
 146                             , Doc.flexItems =
 147                                 [ "Invoice" & Doc.classes ["title"]
 148                                 , Doc.section
 149                                     ( [ ["InvoiceIdentifier" := invId & Doc.toInline & Doc.toBlock]
 150                                       , ["InvoiceType" := invId & invoiceIdType & Doc.toBlock]
 151                                       , ["InvoiceOrders" := inv & invoiceOrders <&> (\x -> "-" := Doc.toBlock x) & Doc.List & Doc.toBlock]
 152                                       , ["InvoiceEmittedOn" := inv & invoiceEmittedOn & Doc.toBlock]
 153                                       , ["InvoicePaymentDueBefore" := inv & invoicePaymentDueBefore & Doc.toBlock]
 154                                       ]
 155                                         & mconcat
 156                                         & Doc.Dict
 157                                         & Doc.toBlock
 158                                     )
 159                                     & (\x -> x{Doc.containerClasses = ["invoice-headers"]})
 160                                     & Doc.BlockDiv
 161                                 , Doc.section
 162                                     [ organization
 163                                         { orgParts =
 164                                             [ "Seller" := inv & invoiceIssuer
 165                                             , "Buyer" := inv & invoiceRecipient
 166                                             ]
 167                                         }
 168                                         & Doc.toBlock
 169                                     ]
 170                                     & \x ->
 171                                       x{Doc.containerClasses = ["invoice-from-to"]}
 172                                         & Doc.BlockDiv
 173                                 , Doc.section
 174                                     [ "Grand totals" & Doc.classes ["title"]
 175                                     , Doc.table
 176                                         { Doc.tableHeads =
 177                                             Just
 178                                               [ "Time frame"
 179                                               , "Workload"
 180                                               , "To pay (excl. taxes)"
 181                                               ]
 182                                         , Doc.tableRows =
 183                                             [
 184                                               [ Doc.tableCell
 185                                                   { Doc.tableCellJustify = Doc.JustifyCenter
 186                                                   , Doc.tableCellContent =
 187                                                       invSummary
 188                                                         <&> invoiceItemPeriod
 189                                                         & List.foldr1
 190                                                           ( \x y ->
 191                                                               Period
 192                                                                 { periodBeginning = min (x & periodBeginning) (y & periodBeginning)
 193                                                                 , periodEnd = max (x & periodEnd) (y & periodEnd)
 194                                                                 }
 195                                                           )
 196                                                         & \period ->
 197                                                           [ period & periodBeginning & Doc.toInline & Doc.BlockPara
 198                                                           , period & periodEnd & Doc.toInline & Doc.BlockPara
 199                                                           ]
 200                                                   }
 201                                               , Doc.tableCell
 202                                                   { Doc.tableCellJustify = Doc.JustifyCenter
 203                                                   , Doc.tableCellContent =
 204                                                       sumAmounts
 205                                                         [ itm & invoiceItemQuantity
 206                                                         | itm <- invSummary
 207                                                         ]
 208                                                         & fromMaybe 0
 209                                                         & Doc.toBlock
 210                                                   }
 211                                               , Doc.tableCell
 212                                                   { Doc.tableCellJustify = Doc.JustifyCenter
 213                                                   , Doc.tableCellContent =
 214                                                       sumAmounts
 215                                                         [ itm & invoiceItemTotal
 216                                                         | itm <- invSummary
 217                                                         ]
 218                                                         & fromMaybe 0
 219                                                         & Doc.toBlock
 220                                                   }
 221                                               ]
 222                                             ]
 223                                         }
 224                                         & Doc.toBlock
 225                                     ]
 226                                     & Doc.BlockDiv
 227                                 , Doc.section
 228                                     [ "Mandatory legal notices" & Doc.classes ["title"]
 229                                     , Doc.List
 230                                         [ case mention of
 231                                             InvoiceMentionTVANonApplicable ->
 232                                               -- "TVA non applicable, art. 293 B du code général des impôts."
 233                                               "—" := "VAT not applicable, art. 293 B of the French General Tax Code."
 234                                             InvoiceMentionIndemnitéForfaitaire ->
 235                                               "—" :=
 236                                                 [ -- "Indemnité forfaitaire pour frais de recouvrement en cas de retard de paiement\x202F: "
 237                                                   "Fixed compensation for recovery costs in case of late payment: "
 238                                                 , (40 :: Math.Amount 100 (Math.UnitName "€"))
 239                                                     & Doc.toInline
 240                                                 ]
 241                                                   & Doc.BlockPara
 242                                             InvoiceMentionIndemnitéTaux rate ->
 243                                               "—" :=
 244                                                 [ -- "Taux des pénalités pour retard de paiement exigibles à compter du "
 245                                                   "Late payment penalty rate (applicable from "
 246                                                 , inv & invoicePaymentDueBefore & Time.addLocalTime Time.nominalDay & Doc.toInline
 247                                                 , -- , "\x202F: "
 248                                                   "): "
 249                                                 , rate & Doc.toInline
 250                                                 , -- , " × montant impayé × nombre de jours de retard / 365.25"
 251                                                   " × unpaid amount × number of days late / 365.25"
 252                                                 ]
 253                                                   & Doc.BlockPara
 254                                         | mention <- inv & invoiceMentions
 255                                         ]
 256                                         & Doc.toBlock
 257                                     ]
 258                                     & Doc.BlockDiv
 259                                 ]
 260                                   <&> \blk -> Doc.flexItem{Doc.flexItemContent = blk}
 261                             }
 262                             & Doc.toBlock
 263                       }
 264                   ]
 265                 , invSummary & ol1 & chunksOf 15 <&> \invItemsChunk ->
 266                     Doc.page
 267                       { Doc.pageSection = Just $ invTitle <> " — Summary"
 268                       , Doc.pageContent =
 269                           Doc.flex
 270                             { Doc.flexDirection = Doc.FlexDirectionColumn
 271                             , Doc.flexGap = 0.5 & Doc.cm
 272                             , Doc.flexItems =
 273                                 [ Doc.flexItem
 274                                     { Doc.flexItemContent =
 275                                         [ [ ("Summary" :: Text) & Doc.toBlock & Doc.classes ["title"]
 276                                           | invItemsChunk & headMaybe & maybe False (fst >>> (== 1))
 277                                           ]
 278                                             & Doc.toBlock
 279                                         ,
 280                                           [ Doc.table
 281                                               { Doc.tableTemplate =
 282                                                   [ Doc.LengthRelative $ Doc.LengthRelativeMaxContent
 283                                                   , Doc.LengthRelative $ Doc.LengthRelativeMaxContent
 284                                                   , Doc.LengthRelative $ 1 & Doc.fr
 285                                                   , Doc.LengthRelative $ Doc.LengthRelativeMaxContent
 286                                                   , Doc.LengthRelative $ Doc.LengthRelativeMaxContent
 287                                                   , Doc.LengthRelative $ Doc.LengthRelativeMaxContent
 288                                                   , Doc.LengthRelative $ Doc.LengthRelativeMaxContent
 289                                                   , Doc.LengthRelative $ Doc.LengthRelativeMaxContent
 290                                                   ]
 291                                               , Doc.tableRowsEvenOdd = True
 292                                               , Doc.tableHeads =
 293                                                   Just
 294                                                     [ "#"
 295                                                     , "Type"
 296                                                     , "Scope"
 297                                                     , "Action"
 298                                                     , "Time frame"
 299                                                     , Doc.tableCell
 300                                                         { Doc.tableCellContent =
 301                                                             [ "Rate" & Doc.BlockPara
 302                                                             , "(excl.\xA0taxes.)" & Doc.BlockPara
 303                                                             ]
 304                                                         , Doc.tableCellJustify = Doc.JustifyCenter
 305                                                         }
 306                                                     , "Quantity"
 307                                                     , Doc.tableCell
 308                                                         { Doc.tableCellContent =
 309                                                             [ "Total" & Doc.BlockPara
 310                                                             , "(excl.\xA0taxes.)" & Doc.BlockPara
 311                                                             ]
 312                                                         , Doc.tableCellJustify = Doc.JustifyCenter
 313                                                         }
 314                                                     ]
 315                                               , Doc.tableRows =
 316                                                   [ [ Doc.tableCell
 317                                                         { Doc.tableCellContent = itemCount & Printf.printf "%i" & Doc.toBlock @String
 318                                                         , Doc.tableCellJustify = Doc.JustifyEnd
 319                                                         }
 320                                                     , Doc.tableCell
 321                                                         { Doc.tableCellContent = invItem & invoiceItemType & Doc.toBlock
 322                                                         , Doc.tableCellJustify = Doc.JustifyCenter
 323                                                         }
 324                                                     , Doc.tableCell
 325                                                         { Doc.tableCellContent = invItem & invoiceItemScope & pathToBlock
 326                                                         , Doc.tableCellJustify = Doc.JustifyStart
 327                                                         }
 328                                                     , Doc.tableCell
 329                                                         { Doc.tableCellContent = invItem & invoiceItemAction & pathToBlock
 330                                                         , Doc.tableCellJustify = Doc.JustifyStart
 331                                                         }
 332                                                     , Doc.tableCell
 333                                                         { Doc.tableCellContent =
 334                                                             [ invItem & invoiceItemPeriod & periodBeginning & Doc.toInline & Doc.BlockPara
 335                                                             , invItem & invoiceItemPeriod & periodEnd & Doc.toInline & Doc.BlockPara
 336                                                             ]
 337                                                         , Doc.tableCellJustify = Doc.JustifyStart
 338                                                         }
 339                                                     , Doc.tableCell
 340                                                         { Doc.tableCellContent = invItem & invoiceItemRate & Doc.toBlock
 341                                                         , Doc.tableCellJustify = Doc.JustifyEnd
 342                                                         }
 343                                                     , Doc.tableCell
 344                                                         { Doc.tableCellContent =
 345                                                             [ invItem & invoiceItemQuantity & Doc.toBlock
 346                                                             , let (qtyPercent, _actualRate) =
 347                                                                     Math.fraction
 348                                                                       (invSummaryQuantityTotal & Math.quantityToRatio & (100 Prelude./))
 349                                                                       (invItem & invoiceItemQuantity & Math.amountQuantity)
 350                                                               in qtyPercent
 351                                                                    & Math.quantityToRational
 352                                                                    & (fromRational :: _ -> Double)
 353                                                                    & (Printf.printf "(%02f%%)" :: _ -> String)
 354                                                                    & Doc.toBlock
 355                                                             ]
 356                                                         , Doc.tableCellJustify = Doc.JustifyEnd
 357                                                         }
 358                                                     , Doc.tableCell
 359                                                         { Doc.tableCellContent = invItem & invoiceItemTotal & Doc.toBlock
 360                                                         , Doc.tableCellJustify = Doc.JustifyEnd
 361                                                         }
 362                                                     ]
 363                                                   | (itemCount, invItem) <- invItemsChunk
 364                                                   ]
 365                                               }
 366                                               & Doc.toBlock
 367                                           ]
 368                                         ]
 369                                     }
 370                                 ]
 371                             }
 372                             & Doc.toBlock
 373                             & Doc.section
 374                             & ( \x ->
 375                                   x{Doc.containerClasses = ["invoice-summary"]}
 376                               )
 377                             & Doc.toBlock
 378                       }
 379                 , inv & invoiceLogs & ol1 & chunksOf 15 <&> \invLogsChunk ->
 380                     Doc.page
 381                       { Doc.pageSection = Just $ invTitle <> " — Details"
 382                       , Doc.pageContent =
 383                           Doc.flex
 384                             { Doc.flexDirection = Doc.FlexDirectionColumn
 385                             , Doc.flexGap = 0.5 & Doc.cm
 386                             , Doc.flexItems =
 387                                 [ Doc.flexItem
 388                                     { Doc.flexItemContent =
 389                                         [ [ ("Details" :: Text) & Doc.toBlock & Doc.classes ["title"]
 390                                           | invLogsChunk & headMaybe & maybe False (fst >>> (== 1))
 391                                           ]
 392                                             & Doc.toBlock
 393                                         , Doc.table
 394                                             { Doc.tableTemplate =
 395                                                 [ Doc.LengthRelative $ Doc.LengthRelativeMaxContent
 396                                                 , Doc.LengthRelative $ Doc.LengthRelativeMaxContent
 397                                                 , Doc.LengthRelative $ Doc.LengthRelativeMaxContent
 398                                                 , Doc.LengthRelative $ 1 & Doc.fr
 399                                                 , Doc.LengthRelative $ 1 & Doc.fr
 400                                                 , Doc.LengthAbsolute $ 5 & Doc.cm
 401                                                 , Doc.LengthRelative $ 2 & Doc.fr
 402                                                 ]
 403                                             , Doc.tableRowsEvenOdd = True
 404                                             , Doc.tableHeads =
 405                                                 Just
 406                                                   [ "#"
 407                                                   , "Date"
 408                                                   , "Duration"
 409                                                   , "Scope"
 410                                                   , "Action"
 411                                                   , "References"
 412                                                   , "Description"
 413                                                   ]
 414                                             , Doc.tableRows =
 415                                                 [ [ Doc.tableCell
 416                                                       { Doc.tableCellContent = logCount & Printf.printf "%i" & Doc.toBlock @String
 417                                                       , Doc.tableCellJustify = Doc.JustifyEnd
 418                                                       }
 419                                                   , Doc.tableCell
 420                                                       { Doc.tableCellContent = invoiceLog & invoiceLogDate & Doc.toBlock
 421                                                       , Doc.tableCellJustify = Doc.JustifyCenter
 422                                                       }
 423                                                   , Doc.tableCell
 424                                                       { Doc.tableCellContent =
 425                                                           invoiceLog & invoiceLogDuration & Doc.toBlock
 426                                                       , Doc.tableCellJustify = Doc.JustifyEnd
 427                                                       }
 428                                                   , Doc.tableCell
 429                                                       { Doc.tableCellContent = invoiceLog & invoiceLogScope & pathToBlock
 430                                                       , Doc.tableCellJustify = Doc.JustifyStart
 431                                                       }
 432                                                   , Doc.tableCell
 433                                                       { Doc.tableCellContent = invoiceLog & invoiceLogAction & pathToBlock
 434                                                       , Doc.tableCellJustify = Doc.JustifyStart
 435                                                       }
 436                                                   , Doc.tableCell
 437                                                       { Doc.tableCellContent =
 438                                                           [ ref & Doc.toInline
 439                                                           | ref <- invoiceLog & invoiceLogReferences
 440                                                           ]
 441                                                             & Doc.toInline
 442                                                             & Doc.toBlock
 443                                                       , Doc.tableCellJustify = Doc.JustifyStart
 444                                                       }
 445                                                   , Doc.tableCell
 446                                                       { Doc.tableCellContent = invoiceLog & invoiceLogDescription & Doc.toBlock
 447                                                       , Doc.tableCellJustify = Doc.JustifyStart
 448                                                       }
 449                                                   ]
 450                                                 | (logCount, invoiceLog) <- invLogsChunk & traceShowId
 451                                                 ]
 452                                             }
 453                                             & Doc.toBlock
 454                                         ]
 455                                     }
 456                                 ]
 457                             }
 458                             & Doc.toBlock
 459                             & Doc.section
 460                             & (\x -> x{Doc.containerClasses = ["invoice-details"]})
 461                             & Doc.toBlock
 462                       }
 463                 ]
 464                   & mconcat
 465                   & ol1
 466                   & \l ->
 467                     l & List.map \(pageIdx, pag) ->
 468                       pag
 469                         { Doc.pageOrientation = Doc.PageOrientationPortrait
 470                         , Doc.pageSize = Doc.PageSizeA4
 471                         , Doc.pageNumber = Just pageIdx
 472                         , Doc.pageNumberTotal = Just $ l & List.length & fromIntegral
 473                         , Doc.pageSide =
 474                             Just $
 475                               if pageIdx & even
 476                                 then Doc.PageSideLeft
 477                                 else Doc.PageSideRight
 478                         }
 479             }
 480     where
 481       pathToBlock segs =
 482         [ seg & Doc.toInline
 483         | seg <- segs
 484         ]
 485           & List.intersperse " / "
 486           & Doc.toInline
 487           & Doc.toBlock
 488
 489 invoiceSummary :: _ -> _ -> Map [Text] (Map [Text] (InvoiceItem _ _))
 490 invoiceSummary invRates invLogs =
 491   Map.unionsWith
 492     ( Map.unionWith
 493         ( \x y ->
 494             InvoiceItem
 495               { invoiceItemScope = x & invoiceItemScope
 496               , invoiceItemAction = x & invoiceItemAction
 497               , invoiceItemPeriod =
 498                   Period
 499                     { periodBeginning = min (x & invoiceItemPeriod & periodBeginning) (y & invoiceItemPeriod & periodBeginning)
 500                     , periodEnd = max (x & invoiceItemPeriod & periodEnd) (y & invoiceItemPeriod & periodEnd)
 501                     }
 502               , invoiceItemQuantity = (x & invoiceItemQuantity) + (y & invoiceItemQuantity)
 503               , invoiceItemType = x & invoiceItemType
 504               , invoiceItemRate = x & invoiceItemRate
 505               }
 506         )
 507     )
 508     [ Map.singleton (invLog & invoiceLogScope) $
 509         Map.singleton (invLog & invoiceLogAction) $
 510           InvoiceItem
 511             { invoiceItemScope = invLog & invoiceLogScope
 512             , invoiceItemAction = invLog & invoiceLogAction
 513             , invoiceItemType = InvoiceItemTypeService
 514             , invoiceItemQuantity = invLog & invoiceLogDuration
 515             , invoiceItemPeriod =
 516                 Period
 517                   { periodBeginning = invLog & invoiceLogDate
 518                   , periodEnd = invLog & invoiceLogDate
 519                   }
 520             , invoiceItemRate = invRates & Map.lookup (invLog & invoiceLogAction) & fromMaybe (errorShow ("missing action" :: Text, invLog & invoiceLogAction))
 521             }
 522     | invLog <- invLogs
 523     ]