{-|
Module      : Test.Instances
Description : Instances for test data
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX
-}

{-# OPTIONS_GHC -Wno-orphans #-}

{-# LANGUAGE StandaloneDeriving #-}

module Test.Instances
where

import Data.List.NonEmpty qualified as NE
import Data.Map.Strict qualified as Map
import Data.Map.Strict.Patch qualified as PM
import Data.Patch.Class (Replace(Keep), replace)
import Data.Text qualified as T
import Data.Validity (Validation(..), ValidationChain (..), prettyValidation)
import EPO.API.Client.Types qualified as EPO
import Gargantext.API.Errors.Types qualified as Errors
import Gargantext.API.Ngrams.Types qualified as Ngrams
import Gargantext.API.Node.Corpus.New (ApiInfo(..))
import Gargantext.API.Node.Types (RenameNode(..), WithQuery(..))
import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET
import Gargantext.Core.AsyncUpdates.Dispatcher.Types qualified as DET
import Gargantext.Core.NodeStory.Types qualified as NS
import Gargantext.Core.Text.Ngrams (NgramsType(..))
import Gargantext.Core.Types.Main (ListType(CandidateTerm, StopTerm, MapTerm))
import Gargantext.Database.Admin.Types.Node (UserId(UnsafeMkUserId))
import Gargantext.Database.Admin.Types.Hyperdata qualified as Hyperdata
import Gargantext.Prelude hiding (replace, Location)
import Servant.Job.Core qualified as SJ
import Servant.Job.Types qualified as SJ
import Test.QuickCheck



smallLetter :: [Char]
smallLetter = ['a'..'z']

largeLetter :: [Char]
largeLetter = ['A'..'Z']

digit :: [Char]
digit = ['0'..'9']

alphanum :: [Char]
alphanum = smallLetter <> largeLetter <> digit


instance Arbitrary EPO.AuthKey where
  arbitrary = do
    user <- arbitrary
    token <- arbitrary
    pure $ EPO.AuthKey { .. }

instance Arbitrary EPO.User where
  arbitrary = EPO.User <$> arbitrary

instance Arbitrary EPO.Token where
  arbitrary = EPO.Token <$> arbitrary


instance Arbitrary ApiInfo where
  arbitrary = ApiInfo <$> arbitrary


instance Arbitrary WithQuery where
  arbitrary = do
    _wq_query <- arbitrary
    _wq_databases <- arbitrary
    _wq_datafield <- arbitrary
    _wq_lang <- arbitrary
    _wq_node_id <- arbitrary
    _wq_flowListWith <- arbitrary
    _wq_pubmedAPIKey <- arbitrary
    _wq_epoAPIUser <- arbitrary
    _wq_epoAPIToken <- arbitrary
    pure $ WithQuery { .. }


-- Hyperdata
instance Arbitrary Hyperdata.HyperdataUser where
  arbitrary = Hyperdata.HyperdataUser <$> arbitrary
                                      <*> arbitrary
                                      <*> arbitrary
                                      <*> arbitrary
                                      <*> arbitrary
                                      <*> arbitrary

instance Arbitrary Hyperdata.HyperdataPrivate where
  arbitrary = pure Hyperdata.defaultHyperdataPrivate

instance Arbitrary Hyperdata.HyperdataPublic where
  arbitrary = pure Hyperdata.defaultHyperdataPublic


-- Servant job
instance Arbitrary a => Arbitrary (SJ.JobOutput a) where
  arbitrary = SJ.JobOutput <$> arbitrary

instance Arbitrary RenameNode where
  arbitrary = elements [RenameNode "test"]
  
instance Arbitrary SJ.States where
  arbitrary = oneof $ pure <$> [ SJ.IsPending
                               , SJ.IsReceived
                               , SJ.IsStarted
                               , SJ.IsRunning
                               , SJ.IsKilled
                               , SJ.IsFailure
                               , SJ.IsFinished ]


instance Arbitrary (SJ.ID 'SJ.Safe k) where
  arbitrary = do
    _id_type <- arbitrary
    _id_number <- arbitrary
    _id_time <- arbitrary
    _id_token <- arbitrary
    pure $ SJ.PrivateID { .. }

instance Arbitrary a => Arbitrary (SJ.JobStatus 'SJ.Safe a) where
  arbitrary = do
    _job_id <- arbitrary
    _job_log <- arbitrary
    _job_status <- arbitrary
    _job_error <- arbitrary
    pure $ SJ.JobStatus { .. }
deriving instance Eq a => Eq (SJ.JobStatus 'SJ.Safe a)


-- Notifications
instance Arbitrary CET.CEMessage where
  arbitrary = oneof [
    -- | JobStatus to/from json doesn't work
    -- CET.UpdateJobProgress <$> arbitrary  -
      CET.UpdateTreeFirstLevel <$> arbitrary
     ]
deriving instance Eq CET.CEMessage

instance Arbitrary DET.Topic where
  arbitrary = oneof [
    -- | JobStatus to/from json doesn't work
    -- DET.UpdateJobProgress <$> arbitrary
      DET.UpdateTree <$> arbitrary
      ]

instance Arbitrary DET.Message where
  arbitrary = oneof [
    -- | JobStatus to/from json doesn't work
    -- DET.MJobProgress <$> arbitrary
      pure DET.MEmpty
      ]

instance Arbitrary DET.WSRequest where
  arbitrary = oneof [ DET.WSSubscribe <$> arbitrary
                    , DET.WSUnsubscribe <$> arbitrary
                    , DET.WSAuthorize <$> arbitrary
                    , pure DET.WSDeauthorize ]


-- Ngrams
instance Arbitrary a => Arbitrary (Ngrams.MSet a)
instance Arbitrary Ngrams.NgramsTerm
instance Arbitrary Ngrams.TabType where
  arbitrary = elements [minBound .. maxBound]
instance Arbitrary Ngrams.NgramsElement where
  arbitrary = elements [Ngrams.newNgramsElement Nothing "sport"]
instance Arbitrary Ngrams.NgramsTable where
  arbitrary = pure ngramsMockTable
instance Arbitrary Ngrams.OrderBy
  where
    arbitrary = elements [minBound..maxBound]
instance (Ord a, Arbitrary a) => Arbitrary (Ngrams.PatchMSet a) where
  arbitrary = (Ngrams.PatchMSet . PM.fromMap) <$> arbitrary
instance (Eq a, Arbitrary a) => Arbitrary (Replace a) where
  arbitrary = uncurry replace <$> arbitrary
    -- If they happen to be equal then the patch is Keep.
instance Arbitrary Ngrams.NgramsPatch where
  arbitrary = frequency [ (9, Ngrams.NgramsPatch <$> arbitrary <*> (replace <$> arbitrary <*> arbitrary))
                        , (1, Ngrams.NgramsReplace <$> arbitrary <*> arbitrary)
                        ]
instance Arbitrary Ngrams.NgramsTablePatch where
  arbitrary = Ngrams.NgramsTablePatch <$> PM.fromMap <$> arbitrary
instance Arbitrary a => Arbitrary (Ngrams.Versioned a) where
  arbitrary = Ngrams.Versioned 1 <$> arbitrary -- TODO 1 is constant so far
instance Arbitrary a => Arbitrary (Ngrams.VersionedWithCount a) where
  arbitrary = Ngrams.VersionedWithCount 1 1 <$> arbitrary -- TODO 1 is constant so far
instance Arbitrary Ngrams.NgramsRepoElement where
  arbitrary = elements $ map Ngrams.ngramsElementToRepo ns
    where
      Ngrams.NgramsTable ns = ngramsMockTable
ngramsMockTable :: Ngrams.NgramsTable
ngramsMockTable = Ngrams.NgramsTable
  [ Ngrams.mkNgramsElement "animal"  MapTerm        Nothing       (Ngrams.mSetFromList ["dog", "cat"])
  , Ngrams.mkNgramsElement "cat"     MapTerm       (rp "animal")  mempty
  , Ngrams.mkNgramsElement "cats"    StopTerm       Nothing       mempty
  , Ngrams.mkNgramsElement "dog"     MapTerm       (rp "animal")  (Ngrams.mSetFromList ["dogs"])
  , Ngrams.mkNgramsElement "dogs"    StopTerm      (rp "dog")     mempty
  , Ngrams.mkNgramsElement "fox"     MapTerm        Nothing       mempty
  , Ngrams.mkNgramsElement "object"  CandidateTerm  Nothing       mempty
  , Ngrams.mkNgramsElement "nothing" StopTerm       Nothing       mempty
  , Ngrams.mkNgramsElement "organic" MapTerm        Nothing       (Ngrams.mSetFromList ["flower"])
  , Ngrams.mkNgramsElement "flower"  MapTerm       (rp "organic") mempty
  , Ngrams.mkNgramsElement "moon"    CandidateTerm  Nothing       mempty
  , Ngrams.mkNgramsElement "sky"     StopTerm       Nothing       mempty
  ]
  where
    rp n = Just $ Ngrams.RootParent n n


-- initNodeListStoryMock :: NS.NodeListStory
-- initNodeListStoryMock = NS.NodeStory $ Map.singleton nodeListId archive
--   where
--     nodeListId = 0
--     archive = NS.Archive { _a_version = 0
--                          , _a_state = ngramsTableMap
--                          , _a_history = [] }
--     ngramsTableMap = Map.singleton NgramsTerms
--                    $ Map.fromList
--                    [ (n ^. Ngrams.ne_ngrams, Ngrams.ngramsElementToRepo n)
--                    | n <- ngramsMockTable ^. Ngrams._NgramsTable
--                    ]



instance Arbitrary Errors.BackendErrorCode where
  arbitrary = arbitraryBoundedEnum
----------------------------------------------------------------------------
-- Arbitrary instances and test data generation
----------------------------------------------------------------------------

genFrontendErr :: Errors.BackendErrorCode -> Gen Errors.FrontendError
genFrontendErr be = do
  txt <- arbitrary
  case be of

    -- node errors
    Errors.EC_404__node_list_not_found
      -> arbitrary >>= \lid -> pure $ Errors.mkFrontendErr' txt $ Errors.FE_node_list_not_found lid
    Errors.EC_404__node_root_not_found
      -> pure $ Errors.mkFrontendErr' txt Errors.FE_node_root_not_found
    Errors.EC_404__node_corpus_not_found
      -> pure $ Errors.mkFrontendErr' txt Errors.FE_node_corpus_not_found
    Errors.EC_500__node_not_implemented_yet
      -> pure $ Errors.mkFrontendErr' txt Errors.FE_node_not_implemented_yet
    Errors.EC_404__node_lookup_failed_not_found
      -> do nodeId <- arbitrary
            pure $ Errors.mkFrontendErr' txt (Errors.FE_node_lookup_failed_not_found nodeId)
    Errors.EC_404__node_lookup_failed_parent_not_found
      -> do nodeId <- arbitrary
            pure $ Errors.mkFrontendErr' txt (Errors.FE_node_lookup_failed_parent_not_found nodeId)
    Errors.EC_404__node_lookup_failed_user_not_found
      -> do userId <- arbitrary
            pure $ Errors.mkFrontendErr' txt (Errors.FE_node_lookup_failed_user_not_found userId)
    Errors.EC_404__node_lookup_failed_username_not_found
      -> do username <- arbitrary
            pure $ Errors.mkFrontendErr' txt (Errors.FE_node_lookup_failed_username_not_found username)
    Errors.EC_400__node_lookup_failed_user_too_many_roots
      -> do userId <- arbitrary
            roots  <- arbitrary
            pure $ Errors.mkFrontendErr' txt (Errors.FE_node_lookup_failed_user_too_many_roots userId roots)
    Errors.EC_404__node_context_not_found
      -> do contextId <- arbitrary
            pure $ Errors.mkFrontendErr' txt (Errors.FE_node_context_not_found contextId)
    Errors.EC_400__node_creation_failed_no_parent
      -> do userId   <- arbitrary
            pure $ Errors.mkFrontendErr' txt (Errors.FE_node_creation_failed_no_parent userId)
    Errors.EC_400__node_creation_failed_parent_exists
      -> do userId   <- arbitrary
            parentId <- arbitrary
            pure $ Errors.mkFrontendErr' txt (Errors.FE_node_creation_failed_parent_exists userId parentId)
    Errors.EC_400__node_creation_failed_insert_node
      -> do userId   <- arbitrary
            parentId <- arbitrary
            pure $ Errors.mkFrontendErr' txt $ Errors.FE_node_creation_failed_insert_node parentId userId
    Errors.EC_400__node_creation_failed_user_negative_id
      ->    pure $ Errors.mkFrontendErr' txt (Errors.FE_node_creation_failed_user_negative_id (UnsafeMkUserId (-42)))
    Errors.EC_500__node_generic_exception
      -> do err <- arbitrary
            pure $ Errors.mkFrontendErr' txt $ Errors.FE_node_generic_exception err
    Errors.EC_400__node_needs_configuration
      ->    pure $ Errors.mkFrontendErr' txt $ Errors.FE_node_needs_configuration

    -- validation error
    Errors.EC_400__validation_error
      -> do let genValChain = oneof [ Violated <$> arbitrary, Location <$> arbitrary <*> genValChain ]
            chain <- listOf1 genValChain
            pure $ Errors.mkFrontendErr' txt $ Errors.FE_validation_error (T.pack $ fromMaybe "unknown_validation_error" $ prettyValidation $ Validation chain)

    -- authentication error
    Errors.EC_403__login_failed_error
      -> do nid <- arbitrary
            uid <- arbitrary
            pure $ Errors.mkFrontendErr' txt $ Errors.FE_login_failed_error nid uid

    Errors.EC_403__login_failed_invalid_username_or_password
      -> do
            pure $ Errors.mkFrontendErr' txt $ Errors.FE_login_failed_invalid_username_or_password

    Errors.EC_403__user_not_authorized
      -> do
            uid <- arbitrary
            msg <- arbitrary
            pure $ Errors.mkFrontendErr' txt $ Errors.FE_user_not_authorized uid msg

    -- internal error
    Errors.EC_500__internal_server_error
      -> do err <- arbitrary
            pure $ Errors.mkFrontendErr' txt $ Errors.FE_internal_server_error err

    Errors.EC_405__not_allowed
      -> do err <- arbitrary
            pure $ Errors.mkFrontendErr' txt $ Errors.FE_not_allowed err

    -- tree errors
    Errors.EC_404__tree_root_not_found
      -> pure $ Errors.mkFrontendErr' txt $ Errors.FE_tree_root_not_found
    Errors.EC_404__tree_empty_root
      -> pure $ Errors.mkFrontendErr' txt $ Errors.FE_tree_empty_root
    Errors.EC_500__tree_too_many_roots
      -> do nodes <- getNonEmpty <$> arbitrary
            pure $ Errors.mkFrontendErr' txt $ Errors.FE_tree_too_many_roots (NE.fromList nodes)

    -- job errors
    Errors.EC_500__job_invalid_id_type
      -> do idTy <- arbitrary
            pure $ Errors.mkFrontendErr' txt $ Errors.FE_job_invalid_id_type idTy
    Errors.EC_500__job_expired
      -> do jobId <- getPositive <$> arbitrary
            pure $ Errors.mkFrontendErr' txt $ Errors.FE_job_expired jobId
    Errors.EC_500__job_invalid_mac
      -> do macId <- arbitrary
            pure $ Errors.mkFrontendErr' txt $ Errors.FE_job_expired macId
    Errors.EC_500__job_unknown_job
      -> do jobId <- getPositive <$> arbitrary
            pure $ Errors.mkFrontendErr' txt $ Errors.FE_job_unknown_job jobId
    Errors.EC_500__job_generic_exception
      -> do err <- arbitrary
            pure $ Errors.mkFrontendErr' txt $ Errors.FE_job_generic_exception err
