src/Literate/Organization.hs

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