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

module Utils.TypesSpec where

import TestImport
import Utils

import qualified Data.Aeson as Aeson


instance Arbitrary SloppyBool where 
  arbitrary = SloppyBool <$> arbitrary
  shrink (SloppyBool x) = SloppyBool <$> shrink x

instance Arbitrary AvsInternalPersonalNo where 
  arbitrary = mkAvsInternalPersonalNo <$> arbitrary
  shrink (AvsInternalPersonalNo x) = mkAvsInternalPersonalNo <$> shrink x

instance Arbitrary AvsPersonId where 
  arbitrary = AvsPersonId <$> arbitrary
  shrink (AvsPersonId x) = AvsPersonId <$> shrink x

instance Arbitrary AvsCardNo where 
  arbitrary = AvsCardNo . normalizeAvsCardNo <$> arbitrary
  shrink (AvsCardNo x) = AvsCardNo . normalizeAvsCardNo <$> shrink x

instance Arbitrary AvsLicence where 
  arbitrary = genericArbitrary
  shrink = genericShrink

instance Arbitrary AvsObjPersonId where 
  arbitrary = genericArbitrary
  shrink = genericShrink

instance Arbitrary AvsDataCardColor where
  arbitrary = genericArbitrary
  shrink = genericShrink

instance Arbitrary AvsDataPersonCard where
  arbitrary = canonical <$> genericArbitrary    
  shrink = fmap canonical <$> genericShrink

instance Arbitrary AvsStatusPerson where
  arbitrary = genericArbitrary
  shrink = genericShrink

instance Arbitrary AvsDataPerson where
  arbitrary = canonical <$> genericArbitrary
  shrink = fmap canonical <$> genericShrink

instance Arbitrary AvsPersonLicence where
  arbitrary = genericArbitrary
  shrink = genericShrink

instance Arbitrary AvsLicenceResponse where
  arbitrary = genericArbitrary
  shrink = genericShrink

instance Arbitrary AvsResponsePerson where
  arbitrary = resize 5 genericArbitrary
  shrink = genericShrink

instance Arbitrary AvsResponseStatus where
  arbitrary = genericArbitrary
  shrink = genericShrink

instance Arbitrary AvsResponseSetLicences where
  arbitrary = genericArbitrary
  shrink = genericShrink

instance Arbitrary AvsResponseGetLicences where
  arbitrary = genericArbitrary
  shrink = genericShrink

instance Arbitrary AvsQueryStatus where
  arbitrary = genericArbitrary
  shrink = genericShrink

instance Arbitrary AvsQueryPerson where
  arbitrary = genericArbitrary
  shrink = genericShrink

instance Arbitrary AvsQuerySetLicences where
  arbitrary = genericArbitrary
  shrink = genericShrink

instance Arbitrary AvsQueryGetLicences where
  arbitrary = genericArbitrary
  shrink = genericShrink


spec :: Spec
spec = do
  parallel $ do
    lawsCheckHspec (Proxy @AvsPersonId)
      [ eqLaws, ordLaws, showLaws, showReadLaws, jsonLaws ]
    lawsCheckHspec (Proxy @AvsCardNo)
      [ eqLaws, ordLaws, showLaws, jsonLaws ]
    lawsCheckHspec (Proxy @AvsDataPersonCard)                    --iso failed
      [ eqLaws, ordLaws, showLaws, jsonLaws ]
    lawsCheckHspec (Proxy @AvsDataPerson)                        --iso failed
      [ eqLaws, ordLaws, showLaws, jsonLaws ]
    lawsCheckHspec (Proxy @AvsLicence)
      [ eqLaws, ordLaws, showLaws, jsonLaws, persistFieldLaws ]
    lawsCheckHspec (Proxy @AvsPersonLicence)
      [ eqLaws, ordLaws, showLaws, jsonLaws ]
    lawsCheckHspec (Proxy @AvsLicenceResponse)
      [ eqLaws, ordLaws, showLaws, jsonLaws ]
    lawsCheckHspec (Proxy @AvsResponsePerson)                     --iso failed
      [ eqLaws, showLaws, jsonLaws]
    lawsCheckHspec (Proxy @AvsResponseStatus)                     --iso failed
      [ eqLaws, showLaws, jsonLaws]
    lawsCheckHspec (Proxy @AvsResponseGetLicences)
      [ eqLaws, showLaws, jsonLaws]
    lawsCheckHspec (Proxy @AvsResponseSetLicences)
      [ eqLaws, showLaws, jsonLaws]
    lawsCheckHspec (Proxy @AvsQueryPerson)
      [ eqLaws, showLaws, jsonLaws]
    lawsCheckHspec (Proxy @AvsQueryStatus)
      [ eqLaws, showLaws, jsonLaws]
    lawsCheckHspec (Proxy @AvsQueryGetLicences)
      [ eqLaws, showLaws, jsonLaws]
    lawsCheckHspec (Proxy @AvsQuerySetLicences)
      [ eqLaws, showLaws, jsonLaws]

  describe "AvsLicence" $ do       
    it "ordering is consistent with its PersistField instance" . property $ -- this assumption is used in Handler.Utils.Avs.synchAvsLicences
      \a (b :: AvsLicence) -> compare a b == compare (toPersistValue a) (toPersistValue b)
    it "assigns AvsLicence fixed SQL values" . example $ do    -- ensure that DB encoding does not change unnoticed
      toPersistValue AvsLicenceVorfeld  `shouldBe` toPersistValue (1::Int64)
      toPersistValue AvsLicenceRollfeld `shouldBe` toPersistValue (2::Int64)
    it "assigns AvsLicence fixed JSON values" . example $ do   -- ensure that SQL encoding does not change unnoticed
      Aeson.toJSON AvsLicenceVorfeld  `shouldBe` Aeson.Number 1
      Aeson.toJSON AvsLicenceRollfeld `shouldBe` Aeson.Number 2

  describe "Ord AvsPersonLicence" $ do 
    it "proritises avsLicenceRampLicence" . property $ 
      \p0 p1@AvsPersonLicence{avsLicenceRampLicence=v1} ->
        let p2@AvsPersonLicence{avsLicenceRampLicence=v2} = p0 in
        (v1 /= v2) ==> compare p1 p2 == compare v1 v2
    it "has antitone Function avsPersonLicenceIsGEQ" . property $ -- this assumption is used in Handler.Utils.Avs.synchAvsLicences
      \j k l -> j < k ==> avsPersonLicenceIsLEQ j l >= avsPersonLicenceIsLEQ k l

  describe "Ord AvsDataCard" $ do
    it "prioritises avsDataValid" . property $
      \p0 p1@AvsDataPersonCard{avsDataValid=v1} ->
        let p2@AvsDataPersonCard{avsDataValid=v2} = p0 in
        (v1 /= v2) ==> compare p1 p2 == compare v1 v2
    it "prioritises avsDataValidTo after avsDataValid" . property $
      \p0 p1@AvsDataPersonCard{avsDataValid=v1, avsDataValidTo=t1} ->
        let p2@AvsDataPersonCard{avsDataValidTo=t2} = p0{avsDataValid=v1} in
        (t1 /= t2) ==> compare p1 p2 == compare t1 t2
    it "prioritises avsDataIssueDate after avsDataValid and avsDataValidTo" . property $
      \p0 p1@AvsDataPersonCard{avsDataValid=v1, avsDataValidTo=t1, avsDataIssueDate=d1} ->
        let p2@AvsDataPersonCard{avsDataIssueDate=d2} = p0{avsDataValid=v1, avsDataValidTo=t1} in
        (d1 /= d2) ==> compare p1 p2 == compare d1 d2
    {- naive implementations discards too many tests in order to produce a meaningful result:
    it "prioritises avsDataIssueDate after avsDataValid and avsDataValidTo" . property $
      \p1@AvsDataPersonCard{avsDataValid=v1, avsDataValidTo=t1, avsDataIssueDate=d1}
       p2@AvsDataPersonCard{avsDataValid=v2, avsDataValidTo=t2, avsDataIssueDate=d2} ->
        (v1 == v2 && t1 == t2 && d1 /= d2) ==> compare p1 p2 == compare d1 d2
    -}


{-
Failures:
uniworx-test-yesod>   test/TestImport.hs:165:43:
uniworx-test-yesod>   1) Utils.Types.AvsDataPersonCard.ToJSON/FromJSON Partial Isomorphism
uniworx-test-yesod>        Falsified (after 1 test and 4 shrinks):
uniworx-test-yesod>            Description: Right == Data.Aeson.eitherDecode . Data.Aeson.encode
uniworx-test-yesod>            a = AvsDataPersonCard {avsDataValid = False, avsDataValidTo = Nothing, avsDataIssueDate = Nothing, avsDataCardColor = AvsCardColorMisc "", avsDataCardAreas = fromList "", avsDataStreet = Nothing, avsDataPostalCode = Nothing, avsDataCity = Just "", avsDataFirm = Nothing, avsDataCardNo = AvsCardNo {avsCardNo = ""}, avsDataVersionNo = ""}
uniworx-test-yesod>            Data.Aeson.encode a = "{\"CardNo\":\"\",\"CardAreas\":\"\",\"CardColor\":\"\",\"VersionNo\":\"\",\"Valid\":\"False\"}"
uniworx-test-yesod>            Data.Aeson.eitherDecode (Data.Aeson.encode a) = Right (AvsDataPersonCard {avsDataValid = False, avsDataValidTo = Nothing, avsDataIssueDate = Nothing, avsDataCardColor = AvsCardColorMisc "", avsDataCardAreas = fromList "", avsDataStreet = Nothing, avsDataPostalCode = Nothing, avsDataCity = Nothing, avsDataFirm = Nothing, avsDataCardNo = AvsCardNo {avsCardNo = ""}, avsDataVersionNo = ""})
uniworx-test-yesod>   To rerun use: --match "/Utils.Types/AvsDataPersonCard/ToJSON/FromJSON/Partial Isomorphism/"
uniworx-test-yesod>   test/TestImport.hs:165:43:
uniworx-test-yesod>   2) Utils.Types.AvsDataPerson.ToJSON/FromJSON Partial Isomorphism
uniworx-test-yesod>        Falsified (after 1 test):
uniworx-test-yesod>            Description: Right == Data.Aeson.eitherDecode . Data.Aeson.encode
uniworx-test-yesod>            a = AvsDataPerson {avsPersonFirstName = "", avsPersonLastName = "", avsPersonInternalPersonalNo = Just "", avsPersonPersonNo = 0, avsPersonPersonID = AvsPersonId {avsPersonId = 0}, avsPersonPersonCards = fromList []}
uniworx-test-yesod>            Data.Aeson.encode a = "{\"PersonNo\":0,\"personCards\":[],\"LastName\":\"\",\"FirstName\":\"\",\"PersonID\":0}"
uniworx-test-yesod>            Data.Aeson.eitherDecode (Data.Aeson.encode a) = Right (AvsDataPerson {avsPersonFirstName = "", avsPersonLastName = "", avsPersonInternalPersonalNo = Nothing, avsPersonPersonNo = 0, avsPersonPersonID = AvsPersonId {avsPersonId = 0}, avsPersonPersonCards = fromList []})
uniworx-test-yesod>   To rerun use: --match "/Utils.Types/AvsDataPerson/ToJSON/FromJSON/Partial Isomorphism/"
uniworx-test-yesod>   test/TestImport.hs:165:43:
uniworx-test-yesod>   3) Utils.Types.AvsResponsePerson.ToJSON/FromJSON Partial Isomorphism
uniworx-test-yesod>        Falsified (after 3 tests and 12 shrinks):
uniworx-test-yesod>            Description: Right == Data.Aeson.eitherDecode . Data.Aeson.encode
uniworx-test-yesod>            a = AvsResponsePerson (fromList [AvsDataPerson {avsPersonFirstName = "", avsPersonLastName = "", avsPersonInternalPersonalNo = Nothing, avsPersonPersonNo = 0, avsPersonPersonID = AvsPersonId {avsPersonId = 0}, avsPersonPersonCards = fromList [AvsDataPersonCard {avsDataValid = False, avsDataValidTo = Nothing, avsDataIssueDate = Nothing, avsDataCardColor = AvsCardColorMisc "", avsDataCardAreas = fromList "", avsDataStreet = Nothing, avsDataPostalCode = Nothing, avsDataCity = Nothing, avsDataFirm = Just "", avsDataCardNo = AvsCardNo {avsCardNo = ""}, avsDataVersionNo = ""}]}])
uniworx-test-yesod>            Data.Aeson.encode a = "[{\"PersonNo\":0,\"personCards\":[{\"CardNo\":\"\",\"CardAreas\":\"\",\"CardColor\":\"\",\"VersionNo\":\"\",\"Valid\":\"False\"}],\"LastName\":\"\",\"FirstName\":\"\",\"PersonID\":0}]"
uniworx-test-yesod>            Data.Aeson.eitherDecode (Data.Aeson.encode a) = Right (AvsResponsePerson (fromList [AvsDataPerson {avsPersonFirstName = "", avsPersonLastName = "", avsPersonInternalPersonalNo = Nothing, avsPersonPersonNo = 0, avsPersonPersonID = AvsPersonId {avsPersonId = 0}, avsPersonPersonCards = fromList [AvsDataPersonCard {avsDataValid = False, avsDataValidTo = Nothing, avsDataIssueDate = Nothing, avsDataCardColor = AvsCardColorMisc "", avsDataCardAreas = fromList "", avsDataStreet = Nothing, avsDataPostalCode = Nothing, avsDataCity = Nothing, avsDataFirm = Nothing, avsDataCardNo = AvsCardNo {avsCardNo = ""}, avsDataVersionNo = ""}]}]))
uniworx-test-yesod>   To rerun use: --match "/Utils.Types/AvsResponsePerson/ToJSON/FromJSON/Partial Isomorphism/"
uniworx-test-yesod>   test/TestImport.hs:165:43:
uniworx-test-yesod>   4) Utils.Types.AvsResponseStatus.ToJSON/FromJSON Partial Isomorphism
uniworx-test-yesod>        Falsified (after 2 tests and 6 shrinks):
uniworx-test-yesod>            Description: Right == Data.Aeson.eitherDecode . Data.Aeson.encode
uniworx-test-yesod>            a = AvsResponseStatus (fromList [AvsStatusPerson {avsStatusPersonID = AvsPersonId {avsPersonId = 0}, avsStatusPersonCardStatus = fromList [AvsDataPersonCard {avsDataValid = False, avsDataValidTo = Nothing, avsDataIssueDate = Nothing, avsDataCardColor = AvsCardColorGrün, avsDataCardAreas = fromList "", avsDataStreet = Nothing, avsDataPostalCode = Nothing, avsDataCity = Nothing, avsDataFirm = Just "", avsDataCardNo = AvsCardNo {avsCardNo = ""}, avsDataVersionNo = ""}]}])
uniworx-test-yesod>            Data.Aeson.encode a = "[{\"PersonID\":0,\"personCardStatus\":[{\"CardNo\":\"\",\"CardAreas\":\"\",\"CardColor\":\"Gr\195\188n\",\"VersionNo\":\"\",\"Valid\":\"False\"}]}]"
uniworx-test-yesod>            Data.Aeson.eitherDecode (Data.Aeson.encode a) = Right (AvsResponseStatus (fromList [AvsStatusPerson {avsStatusPersonID = AvsPersonId {avsPersonId = 0}, avsStatusPersonCardStatus = fromList [AvsDataPersonCard {avsDataValid = False, avsDataValidTo = Nothing, avsDataIssueDate = Nothing, avsDataCardColor = AvsCardColorGrün, avsDataCardAreas = fromList "", avsDataStreet = Nothing, avsDataPostalCode = Nothing, avsDataCity = Nothing, avsDataFirm = Nothing, avsDataCardNo = AvsCardNo {avsCardNo = ""}, avsDataVersionNo = ""}]}]))
uniworx-test-yesod>   To rerun use: --match "/Utils.Types/AvsResponseStatus/ToJSON/FromJSON/Partial Isomorphism/"


-}