-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

-- TODO: why is this Handler.Utils.Profile instead of Utils.Profile? 
-- TODO: consider merging with Handler.Utils.Users?
module Handler.Utils.Profile
  ( validDisplayName, checkDisplayName, fixDisplayName
  , validPostAddress  
  , validEmail, validEmail', pickValidEmail, pickValidEmail'
  , validFraportPersonalNumber
  ) where

import Import.NoFoundation

import Data.Char
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LT
import qualified Data.CaseInsensitive as CI

import qualified Data.MultiSet as MultiSet
import qualified Data.Set as Set

import qualified Text.Email.Validate as Email

-- | Instead of CI.mk, this still allows use of Text.isInfixOf, etc.
stripFold :: Text -> Text 
stripFold = Text.toCaseFold . Text.strip

-- | remove last comma and swap order of the two parts, ie. transforming "surname, givennames" into "givennames surname".
--   Input "givennames surname" is left unchanged, except for removing excess whitespace
fixDisplayName :: UserDisplayName -> UserDisplayName 
fixDisplayName udn = 
  let (Text.strip . Text.dropEnd 1 -> surname, Text.strip -> firstnames) = Text.breakOnEnd "," udn 
  in Text.toTitle $ Text.strip $ firstnames <> Text.cons ' ' surname

-- | Like `validDisplayName` but may return an automatically corrected name
checkDisplayName :: Maybe UserTitle -> UserFirstName -> UserSurname -> UserDisplayName -> Maybe UserDisplayName
checkDisplayName mTitle fName sName (fixDisplayName -> dName)
  | validDisplayName mTitle fName sName dName = Just dName
  | otherwise = Nothing

validDisplayName :: Maybe UserTitle
                 -> UserFirstName
                 -> UserSurname
                 -> UserDisplayName
                 -> Bool
validDisplayName (fmap stripFold -> mTitle) (stripFold -> fName) (stripFold -> sName) (stripFold -> dName)
  = and [ dNameFrags `MultiSet.isSubsetOf` MultiSet.unions [titleFrags, fNameFrags, sNameFrags]
        , sName `Text.isInfixOf` dName
        , all ((<= 1) . Text.length) . filter (Text.any isAdd) $ Text.group dName
        , dNameLetters `Set.isSubsetOf` Set.unions [titleLetters, fNameLetters, sNameLetters, addLetters]
        ]
  where
    titleFrags   = foldMap makeMultiSet mTitle
    dNameFrags   =         makeMultiSet dName
    fNameFrags   =         makeMultiSet fName
    sNameFrags   =         makeMultiSet sName

    titleLetters = foldMap (Set.fromList . unpack) mTitle
    fNameLetters =          Set.fromList $ unpack  fName
    sNameLetters =          Set.fromList $ unpack  sName
    dNameLetters =          Set.fromList $ unpack  dName
    addLetters   =          Set.fromList [' ', '.', '-']

    isAdd = (`Set.member` addLetters)
    splitAdd = Text.split isAdd
    makeMultiSet = MultiSet.fromList . filter (not . Text.null) . splitAdd
    

-- | Primitive postal address requires at least one alphabetic character, one digit and a line break
validPostAddress :: Maybe StoredMarkup -> Bool
validPostAddress (Just StoredMarkup {markupInput = addr})
  | Just _ <- LT.find isLetter addr
  , Just _ <- LT.find isNumber addr 
  -- , Just _ <- LT.find ((LineSeparator ==) . generalCategory) addr -- THIS DID NOT WORK
  , 1 < length (LT.lines addr) 
    = True
validPostAddress _ = False

-- also see `Handler.Utils.Users.getEmailAddress` for Tests accepting User Type
validEmail :: Email -> Bool      -- Email = Text
validEmail email = validRFC5322 && not invalidFraport
  where 
    validRFC5322 = Email.isValid $ encodeUtf8 email
    invalidFraport = case Text.stripSuffix "@fraport.de" (foldCase email) of  
      Just fralogin -> all isDigit $ drop 1 fralogin
      Nothing       -> False

validEmail' :: UserEmail -> Bool -- UserEmail = CI Text
validEmail' = validEmail . CI.original

-- | returns first argument, if it is a valid email address; returns second argument untested otherwise; convenience function
pickValidEmail :: UserEmail -> UserEmail -> UserEmail
pickValidEmail x y
  | validEmail' x = x
  | otherwise     = y

-- | returns first valid email address or none if none are valid
pickValidEmail' :: UserEmail -> UserEmail -> Maybe UserEmail
pickValidEmail' x y 
  | validEmail' x = Just x
  | validEmail' y = Just y
  | otherwise     = Nothing

validFraportPersonalNumber :: Maybe Text -> Bool
validFraportPersonalNumber Nothing = False
validFraportPersonalNumber (Just t)
  | (Just pn) <- readMay t
    = pn >= (10000::Int) && pn <= (99999::Int) -- used to filter for SAP export    
  | otherwise = False