src/Literate/Organization.hs

   1 {-# LANGUAGE DeriveAnyClass #-}
   2 {-# LANGUAGE OverloadedLists #-}
   3
   4 module Literate.Organization where
   5
   6 import Country qualified
   7 import Country.Identifier qualified as Country
   8 import Data.Text qualified as Text
   9 import Literate.Document qualified as Doc
  10 import Literate.Document.HTML qualified as HTML
  11 import Literate.Prelude
  12 import Text.Printf qualified as Printf
  13 import Prelude qualified
  14
  15 data EntityId = EntityId {unEntityId :: Natural}
  16   deriving (Eq, Ord, Show, Generic, NFData)
  17 instance HTML.ToMarkup EntityId where
  18   toMarkup i = i & unEntityId & HTML.toHtml
  19 instance Doc.ToInline EntityId where
  20   toInline i = i & unEntityId & show & Doc.toInline
  21
  22 data URL = URL {unURL :: Text}
  23   deriving (Eq, Ord, Show, Generic, NFData)
  24 instance IsString URL where
  25   fromString = URL . fromString
  26 instance Doc.ToInline URL where
  27   toInline = unURL >>> Doc.Target >>> Doc.inlineLinkExplicit
  28
  29 data Email = Email
  30   { emailLocal :: Text
  31   , emailServer :: Text
  32   }
  33   deriving (Eq, Ord, Show, Generic, NFData)
  34 instance IsString Email where
  35   fromString s =
  36     case s & fromString & Text.split (== '@') of
  37       [emailLocal, emailServer] -> Email{..}
  38       _ -> Prelude.error $ "IsString Email: " <> s
  39 instance Doc.ToBlock Email where
  40   toBlock = Doc.toBlock . Doc.toInline
  41 instance Doc.ToInline Email where
  42   toInline eml =
  43     Doc.InlineLink
  44       { Doc.inlineLinkText =
  45           [ eml & emailLocal & Doc.toInline
  46           , "\x200B@"
  47           , eml & emailServer & Doc.toInline
  48           ]
  49             & Doc.Inlines
  50       , Doc.inlineLinkTarget =
  51           Doc.Target $
  52             "mailto:"
  53               <> mconcat
  54                 [ eml & emailLocal
  55                 , "@"
  56                 , eml & emailServer
  57                 ]
  58       }
  59 type Phone = Text
  60 type Role = Text
  61
  62 -- newtype Organization = Organization (Tree.Tree (Role, Organization))
  63 -- organization = Organization (Tree.Node ("", entity) [])
  64 data Organization
  65   = Organization
  66   { orgEntity :: Entity
  67   , orgParts :: [(Role, Organization)]
  68   }
  69   deriving (Eq, Ord, Show, Generic, NFData)
  70 organization =
  71   Organization
  72     { orgEntity = entity
  73     , orgParts = []
  74     }
  75 data Entity = Entity
  76   { entityId :: EntityId
  77   , entityAddress :: Maybe Address
  78   , entityEmail :: Maybe Email
  79   , entityIBAN :: Maybe IBAN
  80   , entityName :: Maybe Text
  81   , entityPhone :: Maybe Phone
  82   , entitySIREN :: Maybe Text
  83   }
  84   deriving (Eq, Ord, Show, Generic, NFData)
  85 instance Doc.ToBlock Entity where
  86   toBlock ent = do
  87     Doc.classes
  88       ["entity"]
  89       [ Doc.toBlock $
  90           Doc.Dict $
  91             mconcat
  92               [ [ "Name" := addr & Doc.toBlock
  93                 | addr <- ent & entityName & maybeToList
  94                 ]
  95               , [ "Address" := addr & Doc.toBlock
  96                 | addr <- ent & entityAddress & maybeToList
  97                 ]
  98               , [ "SIREN" := siren & Doc.toBlock
  99                 | siren <- ent & entitySIREN & maybeToList
 100                 ]
 101               , [ "Email" := email & Doc.toBlock
 102                 | email <- ent & entityEmail & maybeToList
 103                 ]
 104               , [ "Phone" := phone & Doc.toBlock
 105                 | phone <- ent & entityPhone & maybeToList
 106                 ]
 107               , [ "IBAN" := iban & Doc.toBlock
 108                 | iban <- ent & entityIBAN & maybeToList
 109                 ]
 110               ]
 111       ]
 112 instance Doc.ToBlock Organization where
 113   toBlock org =
 114     Doc.classes
 115       ["org"]
 116       [ if (org & orgEntity) == entity then Doc.emptyBlock else Doc.toBlock $ org & orgEntity
 117       , Doc.toBlock $
 118           Doc.Dict $
 119             [ role & Doc.toInline := part & Doc.toBlock
 120             | (role, part) <- org & orgParts
 121             ]
 122       ]
 123     where
 124       scope role
 125         | Text.null role = "" :: Doc.Inline
 126         | otherwise =
 127             Doc.classes @Doc.Inline ["entity-role"] $
 128               "(" <> Doc.toInline role <> ")"
 129 entity =
 130   Entity
 131     { entityId = EntityId 0
 132     , entityAddress = Nothing
 133     , entityEmail = Nothing
 134     , entityIBAN = Nothing
 135     , entityName = Nothing
 136     , entityPhone = Nothing
 137     , entitySIREN = Nothing
 138     }
 139
 140 data Address = Address
 141   { addressText :: [Text]
 142   , addressZipCode :: ZipCode
 143   , addressCity :: City
 144   , addressCountry :: Country.Country
 145   }
 146   deriving (Eq, Ord, Show, Generic, NFData)
 147 instance Doc.ToBlock Address where
 148   toBlock addr =
 149     Doc.classes ["address"] $
 150       Doc.Blocks $
 151         fromList
 152           [ t & Doc.toBlock
 153           | t <- addr & addressText
 154           ]
 155           <> [ Doc.classes
 156                  ["address-bottom"]
 157                  $ Doc.toBlock
 158                  $ Doc.words
 159                  $ [ addr & addressZipCode & Doc.toInline
 160                    , addr & addressCity & Doc.toInline
 161                    , addr & addressCountry & Country.encodeEnglish & Doc.toInline
 162                    ]
 163              ]
 164 address =
 165   Address
 166     { addressText = []
 167     , addressZipCode = ""
 168     , addressCity = ""
 169     , addressCountry = Country.france
 170     }
 171
 172 type ZipCode = Text
 173 type City = Text
 174
 175 -- | International Bank Account Number
 176 data IBAN = IBAN
 177   { ibanCountry :: Country.Country
 178   , ibanCheckDigits :: Natural
 179   , ibanBasicBankAccountNumber :: Text
 180   }
 181   deriving (Eq, Ord, Show, Generic, NFData)
 182
 183 instance Doc.ToBlock IBAN where
 184   toBlock iban =
 185     [ iban & ibanCountry & Country.alphaTwoUpper & Doc.toInline
 186     , iban & ibanCheckDigits & (Printf.printf "%02d" :: _ -> String) & Doc.toInline
 187     , " "
 188     , iban & ibanBasicBankAccountNumber & Text.chunksOf 4 & Text.intercalate " " & Doc.toInline
 189     ]
 190       & Doc.Inlines
 191       & Doc.toBlock