{-|
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 EPO.API.Client.Types qualified as EPO
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.Database.Admin.Types.Hyperdata qualified as Hyperdata
import Gargantext.Prelude
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 ]