{-|
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 -Wno-missing-methods #-}
{-# OPTIONS_GHC -fconstraint-solver-iterations=10 #-}

{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}

module Test.Instances where

import Control.Lens hiding (elements)
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, replace)
import Data.Set qualified as Set
import Data.Text qualified as T
import Data.Validity (Validation(..), ValidationChain (..), prettyValidation)
import EPO.API.Client.Types qualified as EPO
import Gargantext.API.Admin.Auth.Types (AuthenticatedUser, ForgotPasswordAsyncParams)
import Gargantext.API.Admin.Orchestrator.Types qualified as Orch
import Gargantext.API.Errors.Types qualified as Errors
import Gargantext.API.Ngrams
import Gargantext.API.Ngrams.Types
import Gargantext.API.Ngrams.Types qualified as Ngrams
import Gargantext.API.Node.Contact.Types (AddContactParams)
import Gargantext.API.Node.Corpus.Annuaire (AnnuaireWithForm)
import Gargantext.API.Node.Corpus.New (ApiInfo)
import Gargantext.API.Node.Corpus.New.Types (FileFormat, FileType)
import Gargantext.API.Node.Corpus.Types (Datafield)
import Gargantext.API.Node.Corpus.Types qualified as CT
import Gargantext.API.Node.DocumentUpload.Types (DocumentUpload)
import Gargantext.API.Node.DocumentsFromWriteNodes.Types qualified as DFWN
import Gargantext.API.Node.FrameCalcUpload.Types qualified as FCU
import Gargantext.API.Node.Get (GetNodeParams)
import Gargantext.API.Node.New.Types (PostNode(..))
import Gargantext.API.Node.Share.Types (ShareNodeParams(..))
import Gargantext.API.Node.Types (NewWithForm, NewWithTempFile(..), RenameNode(..), WithQuery)
import Gargantext.API.Node.Update.Types qualified as NU
import Gargantext.API.Public.Types (PublicData(..))
import Gargantext.API.Routes.Named.Publish (PublishRequest(..))
import Gargantext.API.Routes.Named.Remote (RemoteExportRequest(..))
import Gargantext.API.Search.Types (SearchQuery(..), SearchResult(..), SearchResultTypes(..), SearchType(..))
import Gargantext.API.Table.Types (TableQuery(..))
import Gargantext.API.Viz.Types (PhyloData)
import Gargantext.Core (Lang)
import Gargantext.Core.NodeStory hiding (buildForest)
import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
import Gargantext.Core.Notifications.Dispatcher.Types qualified as DET
import Gargantext.Core.Text.Corpus.Query (RawQuery(..))
import Gargantext.Core.Types (TableResult)
import Gargantext.Core.Types.Individu qualified as Individu
import Gargantext.Core.Types.Main (ListType(CandidateTerm, StopTerm, MapTerm))
import Gargantext.Core.Utils.DateUtils (UTCTimeR(..))
import Gargantext.Core.Viz.Phylo qualified as Phylo
import Gargantext.Core.Worker.Jobs.Types (Job(..))
import Gargantext.Database.Admin.Types.Hyperdata qualified as Hyperdata
import Gargantext.Database.Admin.Types.Node (NodeId(..), UserId(..), NodeType(..))
import Gargantext.Database.Query.Facet (OrderBy(..))
import Gargantext.Prelude hiding (replace, Location)
import Servant.Client.Core.BaseUrl (BaseUrl(..), Scheme(Http))
import Test.QuickCheck
import Test.QuickCheck.Arbitrary.Generic
import Test.QuickCheck.Instances.Text ()
import Test.QuickCheck.Instances.Vector ()
import Text.Parsec.Error (ParseError, Message(..), newErrorMessage)
import Text.Parsec.Pos


instance Arbitrary AuthenticatedUser where arbitrary = genericArbitrary


instance Arbitrary Message where
  arbitrary = do
    msgContent <- arbitrary
    oneof $ return <$> [ SysUnExpect msgContent
                       , UnExpect msgContent
                       , Expect msgContent
                       , Message msgContent
                       ]

instance Arbitrary SourcePos where
  arbitrary = do
    sn <- arbitrary
    l <- arbitrary
    c <- arbitrary
    return $ newPos sn l c

instance Arbitrary ParseError where
  arbitrary = do
    sp <- arbitrary
    msg <- arbitrary
    return $ newErrorMessage msg sp



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

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

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

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


instance (Arbitrary a, Generic a) => Arbitrary (TableResult a) where arbitrary = genericArbitrary

instance Arbitrary Individu.User where arbitrary = genericArbitrary


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 = genericArbitrary

instance Arbitrary FileFormat where arbitrary = genericArbitrary
instance Arbitrary FileType where arbitrary = genericArbitrary

instance Arbitrary CT.Database where
  arbitrary = oneof [ pure CT.Empty
                    , CT.DB <$> arbitrary ]
instance Arbitrary Datafield where arbitrary = genericArbitrary

instance Arbitrary WithQuery where arbitrary = genericArbitrary


instance Arbitrary PublicData where
  arbitrary = elements
            $ replicate 6 defaultPublicData

defaultPublicData :: PublicData
defaultPublicData =
  PublicData { title = "Title"
             , abstract = foldl (<>) "" $ replicate 100 "abstract "
             , img = "images/Gargantextuel-212x300.jpg"
             , url = "https://.."
             , date = "YY/MM/DD"
             , database = "database"
             , author = "Author" }


instance Arbitrary PublishRequest where
  arbitrary = PublishRequest <$> arbitraryBoundedEnum


instance Arbitrary RemoteExportRequest where
  arbitrary = RemoteExportRequest <$> (pure (BaseUrl Http "dev.sub.gargantext.org" 8008 "")) <*> arbitrary


instance Arbitrary SearchQuery where
  arbitrary = elements [SearchQuery (RawQuery "electrodes") SearchDoc]
  -- arbitrary = elements [SearchQuery "electrodes" 1 ] --SearchDoc]
instance Arbitrary SearchResult where
  arbitrary = SearchResult <$> arbitrary
instance Arbitrary SearchResultTypes where
  arbitrary = do
    srd <- SearchResultDoc     <$> arbitrary
    src <- SearchResultContact <$> arbitrary
    srn <- pure $ SearchNoResult "No result because.."
    elements [srd, src, srn]
instance Arbitrary SearchType where
  arbitrary = elements [SearchDoc, SearchContact]



-- The endpoint does nothing currently, but if it will, we need to provide some valid _wf_data
instance Arbitrary AnnuaireWithForm where arbitrary = genericArbitrary

instance Arbitrary AddContactParams where arbitrary = genericArbitrary

instance Arbitrary DFWN.Params where arbitrary = genericArbitrary

instance Arbitrary ForgotPasswordAsyncParams where arbitrary = genericArbitrary

instance Arbitrary FCU.FrameCalcUpload where arbitrary = genericArbitrary

instance Arbitrary GetNodeParams where arbitrary = genericArbitrary

instance Arbitrary PostNode where
  arbitrary = elements [PostNode "Node test" NodeCorpus]

instance Arbitrary ShareNodeParams where
  arbitrary = elements [ ShareTeamParams "user1"
                       , SharePublicParams (UnsafeMkNodeId 1)
                       ]



instance Arbitrary TableQuery where
  arbitrary = elements [TableQuery { tq_offset = 0
                                   , tq_limit = 10
                                   , tq_orderBy = DateAsc
                                   , tq_view = Ngrams.Docs
                                   , tq_query = "electrodes" }]


instance Arbitrary UTCTimeR where
  arbitrary = do
    year <- arbitrary
    month <- chooseInt (1, 12)
    day <- if month `elem` [1, 3, 5, 7, 8, 10, 12]
      then chooseInt (1, 31)
      else if month == 2
        then chooseInt (1, 28)
        else chooseInt (1, 30)
    hour <- chooseInt (0, 23)
    minute <- chooseInt (0, 59)
    sec <- chooseInt (0, 59)

    pure $ UTCTimeR { .. }





-- phylo

instance Arbitrary Phylo.PhyloSubConfigAPI where arbitrary = genericArbitrary
instance Arbitrary Phylo.Software where
  arbitrary = pure Phylo.defaultSoftware
instance Arbitrary Phylo.Cluster where arbitrary = genericArbitrary
instance Arbitrary Phylo.ComputeTimeHistory where
  arbitrary = oneof [ Phylo.ComputeTimeHistory . NE.fromList . getNonEmpty <$> arbitrary ]
instance Arbitrary Phylo.CorpusParser where arbitrary = genericArbitrary
instance Arbitrary Phylo.Filter where arbitrary = genericArbitrary
instance Arbitrary Phylo.ListParser where arbitrary = genericArbitrary
instance Arbitrary Phylo.MaxCliqueFilter where arbitrary = genericArbitrary
instance Arbitrary Phylo.Order where arbitrary = genericArbitrary
-- The 'resize' ensure our tests won't take too long as
-- we won't be generating very long lists.
instance Arbitrary Phylo.Phylo where
  arbitrary = Phylo.Phylo <$> resize 6 arbitrary
                          <*> resize 6 arbitrary
                          <*> resize 6 arbitrary
                          <*> resize 6 arbitrary
                          <*> resize 6 arbitrary
                          <*> resize 6 arbitrary
                          <*> resize 6 arbitrary
                          <*> resize 6 arbitrary
                          <*> resize 6 arbitrary
instance Arbitrary Phylo.PhyloFoundations where arbitrary = genericArbitrary
instance Arbitrary Phylo.PhyloCounts where arbitrary = genericArbitrary
instance Arbitrary Phylo.PhyloGroup where arbitrary = genericArbitrary
instance Arbitrary Phylo.PhyloLabel where arbitrary = genericArbitrary
instance Arbitrary Phylo.PhyloParam where
  arbitrary = pure Phylo.defaultPhyloParam
instance Arbitrary Phylo.PhyloPeriod where arbitrary = genericArbitrary
instance Arbitrary Phylo.PhyloScale where arbitrary = genericArbitrary
instance Arbitrary Phylo.PhyloSimilarity where arbitrary = genericArbitrary
instance Arbitrary Phylo.PhyloSources where arbitrary = genericArbitrary
instance Arbitrary Phylo.PhyloConfig where
  arbitrary = Phylo.PhyloConfig <$> arbitrary
                                <*> arbitrary
                                <*> arbitrary
                                <*> arbitrary
                                <*> arbitrary 
                                <*> arbitrary
                                <*> arbitrary
                                <*> arbitrary
                                <*> arbitrary
                                <*> arbitrary 
                                <*> arbitrary
                                <*> arbitrary
                                <*> arbitrary
                                <*> arbitrary
                                <*> arbitrary 
                                <*> vectorOf 10 arbitrary
                                <*> arbitrary
                                <*> vectorOf 10 arbitrary
instance Arbitrary Phylo.Quality where arbitrary = genericArbitrary
instance Arbitrary Phylo.SeaElevation where arbitrary = genericArbitrary
instance Arbitrary Phylo.Sort where arbitrary = genericArbitrary
instance Arbitrary Phylo.Synchrony where arbitrary = genericArbitrary
instance Arbitrary Phylo.SynchronyScope where arbitrary = genericArbitrary
instance Arbitrary Phylo.SynchronyStrategy where arbitrary = genericArbitrary
instance Arbitrary Phylo.Tagger where arbitrary = genericArbitrary
instance Arbitrary Phylo.TimeUnit where arbitrary = genericArbitrary
instance Arbitrary PhyloData where arbitrary = genericArbitrary


instance Arbitrary Lang where arbitrary = arbitraryBoundedEnum


instance Arbitrary NU.UpdateNodeParams where arbitrary = genericArbitrary
instance Arbitrary NU.Method where arbitrary = arbitraryBoundedEnum
instance Arbitrary NU.Granularity where arbitrary = arbitraryBoundedEnum
instance Arbitrary NU.Charts where arbitrary = arbitraryBoundedEnum
instance Arbitrary NU.UpdateNodeConfigGraph where arbitrary = genericArbitrary

instance Arbitrary Ngrams.UpdateTableNgramsCharts where arbitrary = genericArbitrary

-- TODO _du_date isn't arbitrary
instance Arbitrary DocumentUpload where arbitrary = genericArbitrary


-- Hyperdata
instance Arbitrary Hyperdata.HyperdataUser where arbitrary = genericArbitrary

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

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



instance Arbitrary Orch.ExternalAPIs where
  arbitrary = oneof [ pure Orch.OpenAlex
                    , Orch.PubMed <$> arbitrary
                    , pure Orch.Arxiv
                    , pure Orch.HAL
                    , pure Orch.IsTex
                    , pure Orch.Isidore
                    , Orch.EPO <$> arbitrary <*> arbitrary ]


-- instance Arbitrary NewWithFile where
--   arbitrary = NewWithFile <$> arbitrary  -- _wfi_b64_data
--                           <*> arbitrary  -- _wf_lang
--                           <*> arbitrary  -- _wf_name

instance Arbitrary Orch.ScraperEvent where
  arbitrary = Orch.ScraperEvent <$> elements [Nothing, Just "test message"]
                                <*> elements [Nothing, Just "INFO", Just "WARN"]
                                <*> elements [Nothing, Just "2018-04-18"]

instance Arbitrary Orch.JobLog where
  arbitrary = Orch.JobLog
           <$> arbitrary
           <*> arbitrary
           <*> arbitrary
           <*> arbitrary

instance Arbitrary NewWithForm where arbitrary = genericArbitrary

instance Arbitrary RenameNode where
  arbitrary = elements [RenameNode "test"]


-- Servant job
-- instance Arbitrary a => Arbitrary (SJ.JobOutput a) where
--   arbitrary = SJ.JobOutput <$> arbitrary
-- instance Arbitrary SJ.States where arbitrary = genericArbitrary
-- 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.UpdateWorkerProgress <$> arbitrary <*> 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.WSRequest where
  arbitrary = oneof [ DET.WSSubscribe <$> arbitrary
                    , DET.WSUnsubscribe <$> arbitrary
                    , DET.WSAuthorize <$> arbitrary
                    , pure DET.WSDeauthorize ]


arbitraryNgramsTerm :: Gen Ngrams.NgramsTerm
arbitraryNgramsTerm = elements
  [ "time"
  , "year"
  , "people"
  , "way"
  , "day"
  , "man"
  , "thing"
  , "woman"
  , "life"
  , "child"
  , "world"
  , "school"
  , "state"
  , "family"
  , "student"
  , "group"
  , "country"
  , "problem"
  , "hand"
  , "part"
  , "place"
  , "case"
  , "week"
  , "company"
  , "system"
  , "program"
  , "question"
  , "work"
  , "government"
  , "number"
  , "night"
  , "point"
  , "home"
  , "water"
  , "room"
  , "mother"
  , "area"
  , "money"
  , "story"
  , "fact"
  , "month"
  , "lot"
  , "right"
  , "study"
  , "book"
  , "eye"
  , "job"
  , "word"
  , "business"
  , "issue"
  , "side"
  , "kind"
  , "head"
  , "house"
  , "service"
  , "friend"
  , "father"
  , "power"
  , "hour"
  , "game"
  , "line"
  , "end"
  , "member"
  , "law"
  , "car"
  , "city"
  , "community"
  , "name"
  , "president"
  , "team"
  , "minute"
  , "idea"
  , "kid"
  , "body"
  , "information"
  , "back"
  , "parent"
  , "face"
  , "others"
  , "level"
  , "office"
  , "door"
  , "health"
  , "person"
  , "art"
  , "war"
  , "history"
  , "party"
  , "result"
  , "change"
  , "morning"
  , "reason"
  , "research"
  , "girl"
  , "guy"
  , "moment"
  , "air"
  , "teacher"
  , "force"
  , "education"
  ]


-- Ngrams
instance Arbitrary a => Arbitrary (Ngrams.MSet a)
-- We cannot pick some completely arbitrary values for the ngrams terms,
-- see the rationale in the instance for 'NgramsElement'.
instance Arbitrary Ngrams.NgramsTerm where
  arbitrary = arbitraryNgramsTerm
instance Arbitrary Ngrams.TabType where arbitrary = arbitraryBoundedEnum
instance Arbitrary Ngrams.NgramsElement where
  -- We cannot pick some completely arbitrary values for the ngrams elements
  -- because we still want to simulate potential hierarchies, i.e. forests of ngrams.
  -- so we sample the ngrams terms from a selection, and we restrict the number of max
  -- children for each 'NgramsElement' to the size parameter to not have very large trees.
  arbitrary = sized $ \n -> do
    _ne_ngrams      <- arbitrary
    _ne_size        <- getPositive <$> arbitrary -- it doesn't make sense to have a negative size
    _ne_list        <- arbitrary
    _ne_occurrences <- resize n arbitrary
    _ne_root        <- arbitrary `suchThat` (maybe True (\x -> x /= _ne_ngrams)) -- can't be root of itself
    _ne_parent      <- arbitrary `suchThat` (maybe True (\x -> x /= _ne_ngrams)) -- can't be parent of itself
    _ne_children    <- Ngrams.mSetFromList <$> (vectorOf n arbitrary `suchThat` (\x -> _ne_ngrams `notElem` x)) -- can't be cyclic
    pure Ngrams.NgramsElement{..}

instance Arbitrary Ngrams.NgramsTable where
  arbitrary = pure ngramsMockTable
instance Arbitrary Ngrams.OrderBy where arbitrary = arbitraryBoundedEnum
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_lookup_failed_user_no_folder
      -> do userId <- arbitrary
            pure $ Errors.mkFrontendErr' txt (Errors.FE_node_lookup_failed_user_no_folder userId)
    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
    Errors.EC_403__node_is_read_only
      -> do nId <- arbitrary
            pure $ Errors.mkFrontendErr' txt $ Errors.FE_node_is_read_only nId "generic reason"
    Errors.EC_403__node_move_error
      -> do sId <- arbitrary
            tId <- arbitrary
            pure $ Errors.mkFrontendErr' txt $ Errors.FE_node_move_error sId tId "generic reason"
    Errors.EC_403__node_export_error
      -> do nId <- arbitrary
            pure $ Errors.mkFrontendErr' txt $ Errors.FE_node_export_error nId "generic reason"

    -- 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)

    -- policy check error
    Errors.EC_403__policy_check_error
      -> pure $ Errors.mkFrontendErr' txt $ Errors.FE_policy_check_error (T.pack "failed policy check.")

    -- 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


instance Arbitrary NewWithTempFile where
  arbitrary = NewWithTempFile <$> arbitrary  -- _wtf_filetype
                              <*> arbitrary  -- _wtf_fileformat
                              <*> arbitrary  -- _wtf_file_oid
                              <*> arbitrary  -- _wtf_lang
                              <*> arbitrary  -- _wtf_name
                              <*> arbitrary  -- _wtf_selection


instance Arbitrary Job where
  arbitrary = oneof [ pure Ping
                    , addContactGen
                    , addCorpusFormAsyncGen
                    , addCorpusWithQueryGen
                    -- , addWithFileGen
                    , addToAnnuaireWithFormGen
                    , documentsFromWriteNodesGen
                    , forgotPasswordAsyncGen
                    , frameCalcUploadGen
                    , jsonPostGen
                    , ngramsPostChartsGen
                    , postNodeAsyncGen
                    , recomputeGraphGen
                    , updateNodeGen
                    , uploadDocumentGen ]
    where
      addContactGen = AddContact <$> arbitrary <*> arbitrary <*> arbitrary
      addCorpusFormAsyncGen = AddCorpusTempFileAsync <$> arbitrary <*> arbitrary <*> arbitrary
      addCorpusWithQueryGen = AddCorpusWithQuery <$> arbitrary <*> arbitrary <*> arbitrary
      -- addWithFileGen = AddWithFile <$> arbitrary <*> arbitrary <*> arbitrary
      addToAnnuaireWithFormGen = AddToAnnuaireWithForm <$> arbitrary <*> arbitrary
      documentsFromWriteNodesGen = DocumentsFromWriteNodes <$> arbitrary <*> arbitrary <*> arbitrary
      forgotPasswordAsyncGen = ForgotPasswordAsync <$> arbitrary
      frameCalcUploadGen = FrameCalcUpload <$> arbitrary <*> arbitrary <*> arbitrary
      jsonPostGen = JSONPost <$> arbitrary <*> arbitrary
      ngramsPostChartsGen = NgramsPostCharts <$> arbitrary <*> arbitrary
      postNodeAsyncGen = PostNodeAsync <$> arbitrary <*> arbitrary <*> arbitrary
      recomputeGraphGen = RecomputeGraph <$> arbitrary
      updateNodeGen = UpdateNode <$> arbitrary <*> arbitrary
      uploadDocumentGen = UploadDocument <$> arbitrary <*> arbitrary

-- | An 'AcyclicTableMap' models a map that associates an 'NgramsTerm' with its 'NgramsElement'.
-- In particular, there are a few preconditions that govers its QuickCheck generator:
--
-- 1. The key matches the '_ne_ngrams' field of each 'NgramsElement';
-- 2. Acyclic: loops are removed.
-- The 'AcyclicTableMap' also carries a random element of the map, which can be
-- used in other tests requiring more specific orchestrations (for example query tests, where
-- we need to be searching for an element in the collection).
data AcyclicTableMap =
  AcyclicTableMap
    { getTableMap      :: Map NgramsTerm NgramsElement
    , randomMapElement :: NgramsElement
    }
  deriving (Show, Eq)

-- | Generate a hierarchy of ngrams element /WITH NO LOOPS/.
-- Furthermore, we need to ensure that when we generate elements, we are not
-- accidentally creating duplicates, because ggtx won't allow us (in the frontend, at least)
-- to create (say) a MapTerm called \"foo\" if we have already a candidate term with that name.
genCorpusWithMatchingElement :: Gen AcyclicTableMap
genCorpusWithMatchingElement = do
  -- cap the depth of the tree, to not make the tests too slow
  depth <- choose (1, 5)
  let mkEntry = do
        trm <- arbitrary
        el  <- over ne_children (breakLoop trm) . makeItRoot <$> (resize depth arbitrary)
        pure (trm, el { _ne_ngrams = trm })
  -- Let's build the map first, so that duplicates will be overwritten.
  fullMapE <- buildForest (BreakLoop LBA_just_do_it) . Map.fromList <$> vectorOf depth mkEntry
  case fullMapE of
    Left e -> panicTrace (show e)
    Right (destroyForest -> fullMap) -> do
      let (hd NE.:| _) = NE.fromList $ map snd fullMap
      pure $ AcyclicTableMap (Map.fromList fullMap) hd
  where
    breakLoop :: NgramsTerm -> MSet NgramsTerm -> MSet NgramsTerm
    breakLoop t = mSetFromSet . Set.delete t . mSetToSet

makeItRoot :: NgramsElement -> NgramsElement
makeItRoot ne = ne & ne_root .~ Nothing
                   & ne_parent .~ Nothing

instance Arbitrary AcyclicTableMap where
  arbitrary = genCorpusWithMatchingElement
  shrink    = shrinkTree

shrinkTree :: AcyclicTableMap -> [AcyclicTableMap]
shrinkTree (AcyclicTableMap mp el) =
  [ AcyclicTableMap (Map.insert k shrunk mp) (if k == _ne_ngrams el then shrunk else el)
  | (k, ne) <- Map.toList mp
  , shrunkChildren <- shrinkSet (_ne_children ne)
  , let shrunk = ne { _ne_children = shrunkChildren }
  ]

shrinkSet :: Ord a => MSet a -> [MSet a]
shrinkSet s = map mSetFromList (shrinkList (const []) (mSetToList s))
