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