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