-- SPDX-FileCopyrightText: 2024-2025 Steffen Jost <s.jost@fraport.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later
{-# OPTIONS_GHC -fno-warn-unused-top-binds -fno-warn-orphans #-}
-- Module for Template Haskell functions to be executed at compile time
-- to allow safe static partial functions

module Handler.Utils.AvsUpdate where


import Import

{-# ANN module ("HLint: ignore Use camelCase" :: String) #-}

-- import Utils.Avs


-- FAILED ATTEMPTS AT COMPILE-TIME-CHECKS USING TEMPLATE HASKELL:
-- import Language.Haskell.TH.Lift
-- import Language.Haskell.TH.Syntax
--
-- deriving instance Lift (EntityField User typ) -- possible
--
-- Lift instances for lenses are not possible:
-- type Getting r s a = (a -> Const r a) -> s -> Const r s
-- deriving instance Lift (Getting        typ AvsPersonInfo typ)
-- deriving instance Lift (Getting (First typ) AvsPersonInfo typ)
-- deriving instance Lift (CheckUpdate User AvsPersonInfo)
-- instance Lift (CheckUpdate User i) where
--     -- liftTyped :: forall (m :: Type -> Type). Quote m => t -> Code m t
--     liftTyped (CheckUpdate    up l) = [||CheckUpdate up l||]
--     liftTyped (CheckUpdateOpt up l) = [||CheckUpdateOpt up l||]
--
-- instance Lift (CheckUpdate record iraw) where
--     -- liftTyped :: forall (m :: Type -> Type). Quote m => t -> Code m t
--     lift = $(makeLift ''CheckUpdate)
-- mkUsrPerUpd upd = getUserPersonUpd $$(liftTyped upd)


{-
    CheckUpdate is usually a statically known pair between a DB record and a lens.
    However, lenses cannot be an instance of Lift for compile time checking (see above).
    Hence we encode the statically known pairs through a type family.
-}


class MkCheckUpdate a where
  type MCU_Rec a :: Type
  type MCU_Raw a :: Type
  mkCheckUpdate :: a -> CheckUpdate (MCU_Rec a) (MCU_Raw a)

data CU_AvsPersonInfo_User
  = CU_API_UserFirstName
  | CU_API_UserSurname
  | CU_API_UserDisplayName
  | CU_API_UserBirthday
  | CU_API_UserMobile
  | CU_API_UserMatrikelnummer
  | CU_API_UserCompanyPersonalNumber
  | CU_API_UserLdapPrimaryKey
  -- CU_API_UserDisplayEmail        -- use _avsContactPrimaryEmailAddress instead
  deriving (Show, Eq)

instance MkCheckUpdate CU_AvsPersonInfo_User where
  type MCU_Rec CU_AvsPersonInfo_User = User
  type MCU_Raw CU_AvsPersonInfo_User = AvsPersonInfo
  mkCheckUpdate CU_API_UserFirstName             = CheckUpdate     UserFirstName               _avsInfoFirstName
  mkCheckUpdate CU_API_UserSurname               = CheckUpdate     UserSurname                 _avsInfoLastName
  mkCheckUpdate CU_API_UserDisplayName           = CheckUpdate     UserDisplayName             _avsInfoDisplayName
  mkCheckUpdate CU_API_UserBirthday              = CheckUpdateMay  UserBirthday                _avsInfoDateOfBirth
  mkCheckUpdate CU_API_UserMobile                = CheckUpdateMay  UserMobile                  _avsInfoPersonMobilePhoneNo
  mkCheckUpdate CU_API_UserMatrikelnummer        = CheckUpdateMay  UserMatrikelnummer        $ _avsInfoPersonNo . re _Just                                              -- Maybe im User, aber nicht im AvsInfo; also: `re _Just` work like `to Just
  mkCheckUpdate CU_API_UserCompanyPersonalNumber = CheckUpdateMay  UserCompanyPersonalNumber $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just   -- Maybe im User und im AvsInfo; needs special treatment, see ldap_ups abov
  mkCheckUpdate CU_API_UserLdapPrimaryKey        = CheckUpdateMay  UserLdapPrimaryKey        $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just
  -- mkCheckUpdate CU_API_UserDisplayEmail          = CheckUpdateOpt  UserDisplayEmail          $ _avsInfoPersonEMail  . _Just . from _CI                                  -- Maybe im AvsInfo, aber nicht im User, daher Opt

data CU_AvsDataContact_User
  = CU_ADC_UserPostAddress
  | CU_ADC_UserDisplayEmail
  deriving (Show, Eq)

instance MkCheckUpdate CU_AvsDataContact_User where
  type MCU_Rec CU_AvsDataContact_User = User
  type MCU_Raw CU_AvsDataContact_User = AvsDataContact
  mkCheckUpdate CU_ADC_UserPostAddress  = CheckUpdateMay UserPostAddress    _avsContactPrimaryPostAddress
  mkCheckUpdate CU_ADC_UserDisplayEmail = CheckUpdateOpt UserDisplayEmail $ _avsContactPrimaryEmail . _Just . from _CI

data CU_AvsFirmInfo_User
  = CU_AFI_UserPostAddress
  -- CU_AFI_UserEmail               -- PROBLEM: UserEmail must be unique!
  -- CU_AFI_UserDisplayEmail        -- use _avsContactPrimaryEmailAddress instead
  deriving (Show, Eq)

instance MkCheckUpdate CU_AvsFirmInfo_User where
  type MCU_Rec CU_AvsFirmInfo_User = User
  type MCU_Raw CU_AvsFirmInfo_User = AvsFirmInfo
  mkCheckUpdate CU_AFI_UserPostAddress           = CheckUpdateMay  UserPostAddress             _avsFirmPostAddress
  -- mkCheckUpdate CU_AFI_UserEmail              = CheckUpdateOpt  UserEmail                 $ _avsFirmEMailSuperior . _Just . from _CI   -- in rare cases, firm superior email is used as fallback here; but UserEmail must be unique!
  -- mkCheckUpdate CU_AFI_UserDisplayEmail       = CheckUpdateOpt  UserDisplayEmail          $ _avsFirmPrimaryEmail  . _Just . from _CI   -- Maybe im AvsInfo, aber nicht im User, daher Opt


-- NOTE: Ensure that the lenses between CU_UserAvs_User and CU_AvsPersonInfo_User/CU_AvsFirmInfo_User agree!
data CU_UserAvs_User                -- only used in templates/profileData.hamlet for detection
  = CU_UA_UserPinPassword
  -- CU_UA_UserPostAddress          -- use _avsContactPrimaryPostAddress instead
  | CU_UA_UserFirstName
  | CU_UA_UserSurname
  | CU_UA_UserDisplayName
  | CU_UA_UserBirthday
  | CU_UA_UserMobile
  | CU_UA_UserMatrikelnummer
  | CU_UA_UserCompanyPersonalNumber
  | CU_UA_UserLdapPrimaryKey
  -- CU_UA_UserDisplayEmail         -- use _avsContactPrimaryEmail instead
  deriving (Show, Eq)

instance MkCheckUpdate CU_UserAvs_User where
  type MCU_Rec CU_UserAvs_User = User
  type MCU_Raw CU_UserAvs_User = UserAvs
  mkCheckUpdate CU_UA_UserPinPassword           = CheckUpdateOpt  UserPinPassword           $ _userAvsLastCardNo     . _Just . to avsFullCardNo2pin . re _Just
  -- mkCheckUpdate CU_UA_UserPostAddress           = CheckUpdateOpt  UserPostAddress           $ _userAvsLastFirmInfo   . _Just . _avsFirmPostAddress
  mkCheckUpdate CU_UA_UserFirstName             = CheckUpdateOpt  UserFirstName             $ _userAvsLastPersonInfo . _Just . _avsInfoFirstName
  mkCheckUpdate CU_UA_UserSurname               = CheckUpdateOpt  UserSurname               $ _userAvsLastPersonInfo . _Just . _avsInfoLastName
  mkCheckUpdate CU_UA_UserDisplayName           = CheckUpdateOpt  UserDisplayName           $ _userAvsLastPersonInfo . _Just . _avsInfoDisplayName
  mkCheckUpdate CU_UA_UserBirthday              = CheckUpdateOpt  UserBirthday              $ _userAvsLastPersonInfo . _Just . _avsInfoDateOfBirth
  mkCheckUpdate CU_UA_UserMobile                = CheckUpdateOpt  UserMobile                $ _userAvsLastPersonInfo . _Just . _avsInfoPersonMobilePhoneNo
  mkCheckUpdate CU_UA_UserMatrikelnummer        = CheckUpdateOpt  UserMatrikelnummer        $ _userAvsLastPersonInfo . _Just . _avsInfoPersonNo . re _Just                                              -- Maybe im User, aber nicht im AvsInfo; also: `re _Just` work like `to Just
  mkCheckUpdate CU_UA_UserCompanyPersonalNumber = CheckUpdateOpt  UserCompanyPersonalNumber $ _userAvsLastPersonInfo . _Just . _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just   -- Maybe im User und im AvsInfo; needs special treatment, see ldap_ups abov
  mkCheckUpdate CU_UA_UserLdapPrimaryKey        = CheckUpdateOpt  UserLdapPrimaryKey        $ _userAvsLastPersonInfo . _Just . _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just
  -- mkCheckUpdate CU_UA_UserDisplayEmail          = CheckUpdateOpt  UserDisplayEmail          $ _userAvsLastPersonInfo . _Just . _avsInfoPersonEMail  . _Just . from _CI