src/Literate/Organization.hs

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