-- SPDX-FileCopyrightText: 2022-2023 Sarah Vaupel <sarah.vaupel@uniworx.de>, Steffen Jost <S.Jost@Fraport.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-|
Module: Model.Types.Lms
Description: Types for Learning Management System Interface operated by Know how! AG

-}
module Model.Types.Lms
  ( module Model.Types.Lms 
  ) where

import Import.NoModel
-- import qualified Data.Map as Map
-- import Data.Map ((!))
import Database.Persist.Sql 
import qualified Database.Esqueleto.Experimental as E
import qualified Data.Csv as Csv
import qualified Data.Time.Format as Time
import Data.Time.Format.ISO8601 (iso8601ParseM)
import Utils.Lens.TH

newtype LmsIdent = LmsIdent { getLmsIdent :: Text }
  deriving (Eq, Ord, Read, Show, Generic)
  deriving newtype (NFData, PathPiece, PersistField, PersistFieldSql, Csv.ToField, Csv.FromField, Hashable)
instance E.SqlString LmsIdent
makeLenses_ ''LmsIdent

deriveJSON defaultOptions
  { constructorTagModifier = camelToPathPiece' 1  
  , fieldLabelModifier = camelToPathPiece' 2
  , omitNothingFields = True  
  } ''LmsIdent 

-- TODO: Is this a good idea? An ordinary Enum and a separate Day column in the DB would be better, e.g. allowing use of insertSelect in Jobs.Handler.LMS?
-- ...also see similar type QualificationBlocked
data LmsStatus = LmsExpired
               | LmsBlocked               
               | LmsSuccess
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, NFData, Universe, Finite)  

-- embedRenderMessage ''UniWorX ''LmsStatus (uncurry ((<>) . (<> "Status")) . Text.splitAt 3) -- moved to src/Foundation.hs

deriveJSON  defaultOptions
  { constructorTagModifier = camelToPathPiece' 1      -- remove lms from constructor
  , fieldLabelModifier     = camelToPathPiece' 1
  , sumEncoding = UntaggedValue
  } ''LmsStatus
derivePersistFieldJSON ''LmsStatus

nullaryPathPiece ''LmsStatus $ camelToPathPiece' 1

instance Csv.ToField LmsStatus where
  toField = Csv.toField . toPathPiece


-- | Default Block/Unblock reasons
data QualificationStandardReason
      = QualificationRenewELearningBy       LmsIdent
      | QualificationBlockFailedELearningBy LmsIdent
      | QualificationBlockFailedELearning      
      | QualificationBlockReturnedByCompany
      | QualificationBlockExpired
      
  -- deriving (Eq, Ord, Enum, Bounded, Universe, Finite)

instance Show QualificationStandardReason where
  show (QualificationRenewELearningBy       lid) = "E-Learning bestanden für "     <> show lid
  show (QualificationBlockFailedELearningBy lid) = "E-Learning durchgefallen für " <> show lid
  show  QualificationBlockFailedELearning        = "E-Learning durchgefallen"  
  show  QualificationBlockReturnedByCompany      = "Rückgabe Firma"
  show  QualificationBlockExpired                = "Abgelaufen"
  
{-
qualificationBlockedReasonText :: QualificationStandardReason -> Text
qualificationBlockedReasonText = 
  let dictionary :: Map.Map QualificationStandardReason Text = Map.fromList [(r, tshow r) | r <- universeF]
  in (dictionary !) -- cannot fail due to universeF

qualificationBlockedReasonText :: QualificationStandardReason -> Text
qualificationBlockedReasonText = tshow
-}

type QualificationChangeReason = Either Text QualificationStandardReason

qualificationChangeReasonText :: QualificationChangeReason -> Text
qualificationChangeReasonText (Left     reason) = reason
qualificationChangeReasonText (Right stdreason) = tshow stdreason

-- | LMS interface requires Bool to be encoded by 0 or 1 only
newtype LmsBool = LmsBool { lms2bool :: Bool }
  deriving (Eq, Ord, Read, Show, Generic)

_lmsBool :: Iso' Bool LmsBool
_lmsBool = iso LmsBool lms2bool

instance Csv.ToField LmsBool where 
  toField (LmsBool False) = "0"
  toField (LmsBool True ) = "1"
  
instance Csv.FromField LmsBool where 
  parseField "0" = pure $ LmsBool False
  parseField "1" = pure $ LmsBool True 
  parseField  _  = mempty

-- | Only to be used in LMS interface communicating user status
data LmsState = LmsFailed | LmsOpen | LmsPassed
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, NFData, Universe, Finite)

instance Csv.ToField LmsState where
  toField LmsFailed = "0"
  toField LmsOpen   = "1"          
  toField LmsPassed = "2"

instance Csv.FromField LmsState where
  parseField "0" = pure LmsFailed
  parseField "1" = pure LmsOpen
  parseField "2" = pure LmsPassed
  parseField _   = mempty    

deriveJSON  defaultOptions
  { constructorTagModifier = camelToPathPiece' 1      -- remove lms from constructor
  , fieldLabelModifier     = camelToPathPiece' 1      
  , sumEncoding = UntaggedValue
  } ''LmsState
derivePersistFieldJSON ''LmsState
nullaryPathPiece ''LmsState $ camelToPathPiece' 1


-- | LMS interface requires day format not compliant with iso8601; also LMS uses LOCAL TIMEZONE
newtype LmsDay = LmsDay { lms2day :: Day }
  deriving (Eq, Ord, Read, Show, Generic)

_lmsDay :: Iso' Day LmsDay 
_lmsDay = iso LmsDay lms2day

-- | Format for day for LMS interface
lmsDayFormat :: String 
lmsDayFormat = "%d-%m-%Y" -- fixed in LMS interface desctiption, due defaultTimeLocale, should not use named entities like weekdays or month names

instance Csv.ToField LmsDay where 
  toField (LmsDay d) = Csv.toField $ Time.formatTime Time.defaultTimeLocale lmsDayFormat d -- TimeLocale should not matter since format string does not use names; getTimeLocale requires MonadHandler

instance Csv.FromField LmsDay where 
--  parseField = fmap LmsDay . parseLmsDay <=< Csv.parseField
--    where parseLmsDay = Time.parseTimeM True Time.defaultTimeLocale lmsDayFormat
  parseField i = do 
    s <- Csv.parseField i 
    d <- Time.parseTimeM True Time.defaultTimeLocale lmsDayFormat s
         <|> iso8601ParseM s -- Know-How AG considers supplying iso8601 dates in the future
    return $ LmsDay d

-- | LMS interface requires day format not compliant with iso8601; also LMS uses LOCAL TIMEZONE
newtype LmsTimestamp = LmsTimestamp { lms2timestamp :: UTCTime }
  deriving (Eq, Ord, Read, Show, Generic)

_lmsTimestamp :: Iso' UTCTime LmsTimestamp 
_lmsTimestamp = iso LmsTimestamp lms2timestamp

-- | Format for day for LMS interface
lmsTimestampFormat :: String 
lmsTimestampFormat = "%d-%m-%Y %T" -- fixed in LMS interface desctiption, due defaultTimeLocale, should not use named entities like weekdays or month names

instance Csv.ToField LmsTimestamp where 
  toField (LmsTimestamp d) = Csv.toField $ Time.formatTime Time.defaultTimeLocale lmsTimestampFormat d -- TimeLocale should not matter since format string does not use names; getTimeLocale requires MonadHandler

instance Csv.FromField LmsTimestamp where 
--  parseField = fmap LmsDay . parseLmsDay <=< Csv.parseField
--    where parseLmsDay = Time.parseTimeM True Time.defaultTimeLocale lmsDayFormat
  parseField i = do 
      s <- Csv.parseField i 
      d <- Time.parseTimeM True Time.defaultTimeLocale lmsTimestampFormat s
            <|> (utctDayMidnight <$> Time.parseTimeM True Time.defaultTimeLocale lmsDayFormat s)
            <|> iso8601ParseM s -- Know-How AG considers supplying iso8601 dates in the future
      return $ LmsTimestamp d
