{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Foundation.I18n
  ( appLanguages
  , UniWorXMessage(..)
  , ShortTermIdentifier(..)
  , MsgLanguage(..)
  , ShortSex(..)
  , SheetTypeHeader(..)
  , ShortStudyDegree(..)
  , ShortStudyTerms(..)
  , StudyDegreeTerm(..)
  , ShortStudyFieldType(..)
  , StudyDegreeTermType(..)
  , ErrorResponseTitle(..)
  , UniWorXMessages(..)
  , uniworxMessages
  ) where

import Foundation.Type


import Import.NoFoundation

import Auth.LDAP
import Auth.PWHash
import Auth.Dummy

import Data.CaseInsensitive (original, mk)

import qualified Data.Text as Text

import Utils.Form

import GHC.Exts (IsList(..))


appLanguages :: NonEmpty Lang
appLanguages = "de-de-formal" :| ["en-eu"]


pluralDE :: (Eq a, Num a)
            =>    a -- ^ Count
            -> Text -- ^ Singular
            -> Text -- ^ Plural
            -> Text
pluralDE num singularForm pluralForm
  | num == 1  = singularForm
  | otherwise = pluralForm

noneOneMoreDE :: (Eq a, Num a)
            =>    a -- ^ Count
            -> Text -- ^ None
            -> Text -- ^ Singular
            -> Text -- ^ Plural
            -> Text
noneOneMoreDE num noneText singularForm pluralForm
  | num == 0  = noneText
  | num == 1  = singularForm
  | otherwise = pluralForm

-- noneMoreDE :: (Eq a, Num a)
--             =>    a -- ^ Count
--             -> Text -- ^ None
--             -> Text -- ^ Some
--             -> Text
-- noneMoreDE num noneText someText
--   | num == 0  = noneText
--   | otherwise = someText

pluralEN :: (Eq a, Num a)
            =>    a -- ^ Count
            -> Text -- ^ Singular
            -> Text -- ^ Plural
            -> Text
pluralEN num singularForm pluralForm
  | num == 1  = singularForm
  | otherwise = pluralForm

noneOneMoreEN :: (Eq a, Num a)
            =>    a -- ^ Count
            -> Text -- ^ None
            -> Text -- ^ Singular
            -> Text -- ^ Plural
            -> Text
noneOneMoreEN num noneText singularForm pluralForm
  | num == 0  = noneText
  | num == 1  = singularForm
  | otherwise = pluralForm

-- noneMoreEN :: (Eq a, Num a)
--             =>    a -- ^ Count
--             -> Text -- ^ None
--             -> Text -- ^ Some
--             -> Text
-- noneMoreEN num noneText someText
--   | num == 0  = noneText
--   | otherwise = someText

ordinalEN :: ToMessage a
          => a
          -> Text
ordinalEN (toMessage -> numStr) = case lastChar of
  Just '1' -> [st|#{numStr}st|]
  Just '2' -> [st|#{numStr}nd|]
  Just '3' -> [st|#{numStr}rd|]
  _other   -> [st|#{numStr}th|]
  where
    lastChar = last <$> fromNullable numStr 


-- Convenience Type for Messages, since Yesod messages cannot deal with compound type identifiers
type IntMaybe  = Maybe Int

-- | Convenience function for i18n messages definitions
maybeToMessage :: ToMessage m => Text -> Maybe m -> Text -> Text
maybeToMessage _      Nothing  _     = mempty
maybeToMessage before (Just x) after = before <> toMessage x <> after

-- Messages creates type UniWorXMessage and RenderMessage UniWorX instance
mkMessage "UniWorX" "messages/uniworx" "de-de-formal"
mkMessageVariant "UniWorX" "Campus" "messages/campus" "de"
mkMessageVariant "UniWorX" "Dummy" "messages/dummy" "de"
mkMessageVariant "UniWorX" "PWHash" "messages/pw-hash" "de"
mkMessageVariant "UniWorX" "Button" "messages/button" "de"
mkMessageVariant "UniWorX" "Frontend" "messages/frontend" "de-de-formal"

instance RenderMessage UniWorX TermIdentifier where
  renderMessage foundation ls TermIdentifier{..} = case season of
    Summer -> renderMessage' $ MsgSummerTerm year
    Winter -> renderMessage' $ MsgWinterTerm year
    where renderMessage' = renderMessage foundation ls

newtype ShortTermIdentifier = ShortTermIdentifier TermIdentifier
  deriving stock (Eq, Ord, Read, Show)
instance RenderMessage UniWorX ShortTermIdentifier where
  renderMessage foundation ls (ShortTermIdentifier TermIdentifier{..}) = case season of
    Summer -> renderMessage' $ MsgSummerTermShort year
    Winter -> renderMessage' $ MsgWinterTermShort year
    where renderMessage' = renderMessage foundation ls

instance RenderMessage UniWorX String where
  renderMessage f ls str = renderMessage f ls $ Text.pack str

-- TODO: raw number representation; instead, display e.g. 1000 as 1.000 or 1,000 or ... (language-dependent!)
instance RenderMessage UniWorX Int where
  renderMessage f ls = renderMessage f ls . tshow
instance RenderMessage UniWorX Int64 where
  renderMessage f ls = renderMessage f ls . tshow
instance RenderMessage UniWorX Integer where
  renderMessage f ls = renderMessage f ls . tshow
instance RenderMessage UniWorX Natural where
  renderMessage f ls = renderMessage f ls . tshow

instance HasResolution a => RenderMessage UniWorX (Fixed a) where
  renderMessage f ls = renderMessage f ls . showFixed True

instance RenderMessage UniWorX Load where
  renderMessage foundation ls = renderMessage foundation ls . \case
    Load { byTutorial = Nothing   , byProportion = p } -> MsgCorByProportionOnly p
    Load { byTutorial = Just True , byProportion = p } -> MsgCorByProportionIncludingTutorial p
    Load { byTutorial = Just False, byProportion = p } -> MsgCorByProportionExcludingTutorial p

newtype MsgLanguage = MsgLanguage Lang
  deriving stock (Eq, Ord, Show, Read)
instance RenderMessage UniWorX MsgLanguage where
  renderMessage foundation ls (MsgLanguage lang@(map mk . Text.splitOn "-" -> lang'))
    | ("de" : "DE" : _) <- lang' = mr MsgGermanGermany
    | ("de" : _)        <- lang' = mr MsgGerman
    | ("en" : "EU" : _) <- lang' = mr MsgEnglishEurope
    | ("en" : _)        <- lang' = mr MsgEnglish 
    | otherwise = lang
    where
      mr = renderMessage foundation $ lang : filter (/= lang) ls

embedRenderMessage ''UniWorX ''MessageStatus ("Message" <>)
embedRenderMessage ''UniWorX ''NotificationTrigger $ ("NotificationTrigger" <>) . concat . drop 1 . splitCamel
embedRenderMessage ''UniWorX ''StudyFieldType id
embedRenderMessage ''UniWorX ''SheetFileType id
embedRenderMessage ''UniWorX ''SubmissionFileType id
embedRenderMessage ''UniWorX ''CorrectorState id
embedRenderMessage ''UniWorX ''RatingException id
embedRenderMessage ''UniWorX ''SubmissionSinkException ("SubmissionSinkException" <>)
embedRenderMessage ''UniWorX ''SheetGrading ("SheetGrading" <>)
embedRenderMessage ''UniWorX ''AuthTag $ ("AuthTag" <>) . concat . drop 1 . splitCamel
embedRenderMessage ''UniWorX ''EncodedSecretBoxException id
embedRenderMessage ''UniWorX ''LecturerType id
embedRenderMessage ''UniWorX ''SubmissionModeDescr
  $ let verbMap [_, _, "None"] = "NoSubmissions"
        verbMap [_, _, v] = v <> "Submissions"
        verbMap _ = error "Invalid number of verbs"
     in verbMap . splitCamel
embedRenderMessage ''UniWorX ''UploadModeDescr id
embedRenderMessage ''UniWorX ''SecretJSONFieldException id
embedRenderMessage ''UniWorX ''AFormMessage $ concat . drop 2 . splitCamel
embedRenderMessage ''UniWorX ''SchoolFunction id
embedRenderMessage ''UniWorX ''CsvPreset id
embedRenderMessage ''UniWorX ''Quoting ("Csv" <>)
embedRenderMessage ''UniWorX ''FavouriteReason id
embedRenderMessage ''UniWorX ''Sex id
embedRenderMessage ''UniWorX ''ExamGradingMode id

embedRenderMessage ''UniWorX ''AuthenticationMode id

newtype ShortSex = ShortSex Sex
embedRenderMessageVariant ''UniWorX ''ShortSex ("Short" <>)

newtype SheetTypeHeader = SheetTypeHeader SheetType
embedRenderMessageVariant ''UniWorX ''SheetTypeHeader ("SheetType" <>)

instance RenderMessage UniWorX SheetType where
  renderMessage foundation ls sheetType = case sheetType of
      NotGraded -> mr $ SheetTypeHeader NotGraded
      other -> mr (grading other) <> ", " <> mr (SheetTypeHeader other)
    where
      mr :: RenderMessage UniWorX msg => msg -> Text
      mr = renderMessage foundation ls

instance RenderMessage UniWorX StudyDegree where
  renderMessage _found _ls StudyDegree{..} = fromMaybe (tshow studyDegreeKey) (studyDegreeName <|> studyDegreeShorthand)

newtype ShortStudyDegree = ShortStudyDegree StudyDegree

instance RenderMessage UniWorX ShortStudyDegree where
  renderMessage _found _ls (ShortStudyDegree StudyDegree{..}) = fromMaybe (tshow studyDegreeKey) studyDegreeShorthand

instance RenderMessage UniWorX StudyTerms where
  renderMessage _found _ls StudyTerms{..} = fromMaybe (tshow studyTermsKey) (studyTermsName <|> studyTermsShorthand)

newtype ShortStudyTerms = ShortStudyTerms StudyTerms

instance RenderMessage UniWorX ShortStudyTerms where
  renderMessage _found _ls (ShortStudyTerms StudyTerms{..}) = fromMaybe (tshow studyTermsKey) studyTermsShorthand

data StudyDegreeTerm = StudyDegreeTerm StudyDegree StudyTerms

instance RenderMessage UniWorX StudyDegreeTerm where
  renderMessage foundation ls (StudyDegreeTerm deg trm) = mr trm <> " (" <> mr (ShortStudyDegree deg) <> ")"
    where
      mr :: RenderMessage UniWorX msg => msg -> Text
      mr = renderMessage foundation ls
  
newtype ShortStudyFieldType = ShortStudyFieldType StudyFieldType
embedRenderMessageVariant ''UniWorX ''ShortStudyFieldType ("Short" <>)

data StudyDegreeTermType = StudyDegreeTermType StudyDegree StudyTerms StudyFieldType

instance RenderMessage UniWorX StudyDegreeTermType where
  renderMessage foundation ls (StudyDegreeTermType deg trm typ) = mr trm <> " (" <> mr (ShortStudyDegree deg) <> ", " <> mr (ShortStudyFieldType typ) <> ")"
    where
      mr :: RenderMessage UniWorX msg => msg -> Text
      mr = renderMessage foundation ls

instance RenderMessage UniWorX ExamGrade where
  renderMessage _ _ = pack . (showFixed False :: Deci -> String) . fromRational . review numberGrade

instance RenderMessage UniWorX ExamPassed where
  renderMessage foundation ls = \case
    ExamPassed True  -> mr MsgExamPassed
    ExamPassed False -> mr MsgExamNotPassed
    where
      mr :: RenderMessage UniWorX msg => msg -> Text
      mr = renderMessage foundation ls

instance RenderMessage UniWorX a => RenderMessage UniWorX (ExamResult' a) where
  renderMessage foundation ls = \case
    ExamAttended{..} -> mr examResult
    ExamNoShow       -> mr MsgExamResultNoShow
    ExamVoided       -> mr MsgExamResultVoided
    where
      mr :: RenderMessage UniWorX msg => msg -> Text
      mr = renderMessage foundation ls

instance RenderMessage UniWorX (Either ExamPassed ExamGrade) where
  renderMessage foundation ls = either mr mr
    where
      mr :: RenderMessage UniWorX msg => msg -> Text
      mr = renderMessage foundation ls

instance RenderMessage UniWorX CourseParticipantState where
  renderMessage foundation ls = \case
    CourseParticipantActive         -> mr MsgCourseParticipantActive
    CourseParticipantInactive False -> mr MsgCourseParticipantInactive
    CourseParticipantInactive True  -> mr MsgCourseParticipantNoShow
    where
      mr :: RenderMessage UniWorX msg => msg -> Text
      mr = renderMessage foundation ls

-- ToMessage instances for converting raw numbers to Text (no internationalization)

instance ToMessage Int where
  toMessage = tshow
instance ToMessage Int64 where
  toMessage = tshow
instance ToMessage Integer where
  toMessage = tshow
instance ToMessage Natural where
  toMessage = tshow

instance HasResolution a => ToMessage (Fixed a) where
  toMessage = toMessage . showFixed True

-- Do not use toMessage on Rationals and round them automatically. Instead, use rationalToFixed3 (declared in src/Utils.hs) to convert a Rational to Fixed E3!
-- instance ToMessage Rational where
--   toMessage = toMessage . fromRational'
--     where fromRational' = fromRational :: Rational -> Fixed E3


newtype ErrorResponseTitle = ErrorResponseTitle ErrorResponse
embedRenderMessageVariant ''UniWorX ''ErrorResponseTitle ("ErrorResponseTitle" <>)

newtype UniWorXMessages = UniWorXMessages [SomeMessage UniWorX]
  deriving stock (Generic, Typeable)
  deriving newtype (Semigroup, Monoid)

instance IsList UniWorXMessages where
  type Item UniWorXMessages = SomeMessage UniWorX
  fromList = UniWorXMessages
  toList (UniWorXMessages msgs) = msgs

instance RenderMessage UniWorX UniWorXMessages where
  renderMessage foundation ls (UniWorXMessages msgs) =
    Text.unwords $ map (renderMessage foundation ls) msgs

uniworxMessages :: [UniWorXMessage] -> UniWorXMessages
uniworxMessages = UniWorXMessages . map SomeMessage