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