{-# OPTIONS_GHC -Wwarn #-}

module Handler.Utils.ExamSpec where

import TestImport

import ModelSpec ()     -- instance Arbitrary User

import Test.Hspec.QuickCheck (prop)

import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.CaseInsensitive as CI

import Handler.Utils.Exam

-- TODO
-- use frequency instead of elements?
-- are these capacity values realistic?
instance Arbitrary ExamOccurrence where
    arbitrary = ExamOccurrence
        <$> arbitrary                       -- examOccurrenceExam
        <*> arbitrary                       -- examOccurrenceName
        <*> arbitrary                       -- examOccurrenceRoom
        <*> arbitrary                       -- examOccurrenceRoomHidden
        <*> elements [10, 20, 50, 100, 200] -- examOccurrenceCapacity
        <*> arbitrary                       -- examOccurrenceStart
        <*> arbitrary                       -- examOccurrenceEnd
        <*> arbitrary                       -- examOccurrenceDescription

-- function Handler.Utils.examAutoOccurrence
-- examAutoOccurrence :: forall seed.
--                       Hashable seed
--                    => seed
--                    -> ExamOccurrenceRule
--                    -> ExamAutoOccurrenceConfig
--                    -> Map ExamOccurrenceId Natural
--                    -> Map UserId (User, Maybe ExamOccurrenceId)
--                    -> (Maybe (ExamOccurrenceMapping ExamOccurrenceId), Map UserId (Maybe ExamOccurrenceId))
-- examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences users
spec :: Spec
spec = do
    describe "examAutoOccurrence" $ do
        prop "Surname, no Nudges, no preselection" $ do -- TODO
            users <- genUsers
            occurrences <- genOccurrences $ length users
            let result@(_maybeMapping, userMap) = examAutoOccurrence seed rule config occurrences users
            pure $ ioProperty $ do
                -- every user got assigned a room
                shouldBe (length userMap) (length users)
                shouldSatisfy userMap $ all isJust
                -- no room is overfull
                shouldSatisfy userMap $ fitsInRooms occurrences
                -- all users match the shown ranges
                shouldSatisfy result $ showsCorrectRanges users
        -- TODO test with some users fixed/preselected to certain rooms
        -- TODO test with ExamRoomManual, ExamRoomFifo, (ExamRoomSurname), ExamRoomMatriculation, ExamRoomRandom
    where
        -- | generate users without any pre-assigned rooms
        genUsers :: Gen (Map UserId (User, Maybe ExamOccurrenceId))
        genUsers = do
            rawUsers <- listOf1 $ Entity <$> arbitrary <*> arbitrary
            -- user surnames anpassen, sodass interessante instanz
            fmap Map.fromList $ forM rawUsers $ \Entity {entityKey, entityVal} -> do
                userSurname <- elements surnames
                pure (entityKey, (entityVal {userSurname}, Nothing))
        genOccurrences :: Int -> Gen (Map ExamOccurrenceId Natural)
        genOccurrences numUsers = do
            -- TODO is this realistic?
            -- extra space to get nice borders
            extraSpace <- elements [numUsers `div` 4 .. numUsers `div` 2]
            let totalSpaceRequirement = fromIntegral $ numUsers + extraSpace
                createOccurrences acc
                    |  sum (map snd acc) < totalSpaceRequirement = do
                        Entity {entityKey, entityVal} <- Entity <$> arbitrary <*> arbitrary
                        createOccurrences $ (entityKey, examOccurrenceCapacity entityVal) : acc
                    | otherwise = pure acc
            Map.fromList <$> createOccurrences []
        -- name list copied from test/Database/Fill.hs
        surnames :: [Text]
        surnames =   [ "Smith", "Johnson", "Williams", "Brown"
                    , "Jones", "Miller", "Davis", "Garcia"
                    , "Rodriguez", "Wilson", "Martinez", "Anderson"
                    , "Taylor", "Thomas", "Hernandez", "Moore"
                    , "Martin", "Jackson", "Thompson", "White"
                    , "Lopez", "Lee", "Gonzalez", "Harris"
                    , "Clark", "Lewis", "Robinson", "Walker"
                    , "Perez", "Hall", "Young", "Allen"
                    ]
        seed :: ()
        seed = ()
        rule :: ExamOccurrenceRule
        rule = ExamRoomSurname
        config :: ExamAutoOccurrenceConfig
        config = def
        -- TODO adjust with different nudges, depended on occurrences list/map
        -- def {eaocNudge = Map.singleton occ20Id (-11)}
        --ExamAutoOccurrenceConfig {eaocMinimizeRooms = False, eaocFinenessCost = 1 % 5, eaocNudge = fromList [(SqlBackendKey {unSqlBackendKey = 4},-11)], eaocNudgeSize = 1 % 20}
        occurrenceMap :: Map UserId (Maybe ExamOccurrenceId) -> Map ExamOccurrenceId [UserId]
        occurrenceMap userMap = foldl' (\acc (userId, maybeOccurrenceId) -> appendJust maybeOccurrenceId userId acc)
            Map.empty $ Map.toAscList userMap
            where
                appendJust :: Maybe ExamOccurrenceId -> UserId -> Map ExamOccurrenceId [UserId] -> Map ExamOccurrenceId [UserId]
                appendJust Nothing _userId = id
                appendJust (Just occurrenceId) userId = Map.insertWith (++) occurrenceId [userId]
        fitsInRooms :: Map ExamOccurrenceId Natural
                    -> Map UserId (Maybe ExamOccurrenceId)
                    -> Bool
        fitsInRooms occurrences userMap
            = all roomIsBigEnough $ Map.toAscList $ occurrenceMap userMap
            where
                roomIsBigEnough :: (ExamOccurrenceId, [UserId]) -> Bool
                roomIsBigEnough (roomId, userIds) = case lookup roomId occurrences of
                    Nothing -> False
                    (Just capacity) -> length userIds <= fromIntegral capacity
        showsCorrectRanges :: Map UserId (User, Maybe ExamOccurrenceId)
                            -> (Maybe (ExamOccurrenceMapping ExamOccurrenceId), Map UserId (Maybe ExamOccurrenceId))
                            -> Bool
        showsCorrectRanges _users (Nothing, _userMap) = False
        showsCorrectRanges users (Just (examOccurrenceMappingMapping -> m), userMap)
            = all userFitsInRange $ Map.toAscList $ occurrenceMap userMap
            where
                userFitsInRange :: (ExamOccurrenceId, [UserId]) -> Bool
                userFitsInRange (roomId, userIds) = flip all userIds $ \userId ->
                    case (Map.lookup roomId m, Map.lookup userId users) of
                        (Just ranges, Just (User {userSurname}, _fixedRoom))
                            -> any fitsInRange ranges
                            where
                                ciSurname :: [CI Char]
                                ciSurname = map CI.mk $ Text.unpack userSurname
                                fitsInRange :: ExamOccurrenceMappingDescription -> Bool
                                fitsInRange ExamOccurrenceMappingRange {eaomrStart, eaomrEnd}
                                    = eaomrStart <= ciSurname && (take (length eaomrEnd) ciSurname <= eaomrEnd)
                                fitsInRange ExamOccurrenceMappingSpecial {}
                                    = True      -- FIXME what is the meaning of special?
                        _otherwise -> False