module Model.Types.Allocation
  ( AllocationPriority(..)
  , sqlAllocationPriorityNumeric
  , AllocationPriorityComparison(..)
  , AllocationFingerprint
  , module Utils.Allocation
  , AllocationPriorityNumericRecord(..)
  , allocationPriorityNumericMap
  ) where

import Import.NoModel
import Utils.Allocation (MatchingLog(..))
import Model.Types.Common

import qualified Data.Csv as Csv
import qualified Data.Vector as Vector

import qualified Data.Map.Strict as Map

import Crypto.Hash (SHAKE128)

import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Internal.Internal as E
import qualified Database.Esqueleto.PostgreSQL.JSON as E

import qualified Data.Text as Text

{-# ANN module ("HLint: ignore Use newtype instead of data"::String) #-}


data AllocationPriority
  = AllocationPriorityNumeric { allocationPriorities :: Vector Integer }
  | AllocationPriorityOrdinal { allocationOrdinal :: Natural }
  deriving (Eq, Ord, Read, Show, Generic, Typeable)
deriveJSON defaultOptions
  { fieldLabelModifier = camelToPathPiece' 1
  , constructorTagModifier = camelToPathPiece' 2
  , allNullaryToStringTag = False
  , sumEncoding = TaggedObject "mode" "value"
  , unwrapUnaryRecords = False
  , tagSingleConstructors = True
  } ''AllocationPriority

deriving via E.JSONB AllocationPriority instance E.PersistField AllocationPriority
deriving via E.JSONB AllocationPriority instance E.PersistFieldSql AllocationPriority

instance Binary AllocationPriority

data AllocationPriorityNumericRecord = AllocationPriorityNumericRecord
  { apmrMatrikelnummer :: UserMatriculation
  , apmrPriority :: Vector Integer
  } deriving (Eq, Ord, Read, Show, Generic, Typeable)

allocationPriorityNumericMap :: Prism' (Map UserMatriculation AllocationPriority) AllocationPriorityNumericRecord
allocationPriorityNumericMap = prism' fromPrioRecord toPrioRecord
  where
    fromPrioRecord AllocationPriorityNumericRecord{..}
      = Map.singleton apmrMatrikelnummer $ AllocationPriorityNumeric apmrPriority

    toPrioRecord recordMap = do
      [(matr, AllocationPriorityNumeric{..})] <- pure $ Map.toList recordMap
      return $ AllocationPriorityNumericRecord matr allocationPriorities

instance Csv.FromRecord AllocationPriorityNumericRecord where
  parseRecord v = parseNumeric
    where
      parseNumeric
        | Vector.length v >= 1 = AllocationPriorityNumericRecord <$> v Csv..! 0 <*> mapM Csv.parseField (Vector.tail v)
        | otherwise = mzero

instance Csv.ToRecord AllocationPriorityNumericRecord where
  toRecord AllocationPriorityNumericRecord{..} = Csv.record $
      Csv.toField apmrMatrikelnummer
    : map Csv.toField (otoList apmrPriority)

instance Csv.FromRecord (Map UserMatriculation AllocationPriority) where
  parseRecord = fmap (review allocationPriorityNumericMap) . Csv.parseRecord


instance Csv.ToField AllocationPriority where
  toField (AllocationPriorityOrdinal n ) = Csv.toField n
  toField (AllocationPriorityNumeric ns) = encodeUtf8 . (\ns' -> "[" <> ns' <> "]") . Text.intercalate "," . map tshow $ Vector.toList ns


sqlAllocationPriorityNumeric :: E.SqlExpr (E.Value AllocationPriority) -> E.SqlExpr (E.Value Bool)
sqlAllocationPriorityNumeric prio = E.veryUnsafeCoerceSqlExprValue prio E.->. "mode" E.==. E.jsonbVal ("numeric" :: Text)


data AllocationPriorityComparison
  = AllocationPriorityComparisonNumeric { allocationGradeScale :: Rational }
  | AllocationPriorityComparisonOrdinal { allocationCloneIndex :: Down Natural, allocationOrdinalScale :: Rational }
  deriving (Eq, Ord, Read, Show, Generic, Typeable)


type AllocationFingerprint = Digest (SHAKE128 128)
