[refactor] Arbitrary instances removal from code, move to Test.Instances

src/Gargantext/API/Count.hs

@@ -29,5 +29,5 @@ import Servant.Server.Generic (AsServerT)
 -- TODO-ACCESS: CanCount
 -- TODO-EVENTS: No events as this is a read only query.
 -----------------------------------------------------------------------
-countAPI :: Monad m => Query -> Named.CountAPI (AsServerT m)
+countAPI :: Query -> Named.CountAPI (AsServerT m)
 countAPI _ = Named.CountAPI undefined

src/Gargantext/API/Ngrams/Types.hs

@@ -15,7 +15,7 @@ Portability : POSIX
 {-# LANGUAGE TemplateHaskell      #-}
 {-# LANGUAGE TypeOperators        #-}
 {-# LANGUAGE TypeFamilies         #-}
-{-# OPTIONS -fno-warn-orphans     #-}
+{-# OPTIONS -fno-warn-orphans     #-}  -- some instances are orphaned here
 
 module Gargantext.API.Ngrams.Types where
 
@@ -52,8 +52,6 @@ import Gargantext.Utils.Servant (TSV, ZIP)
 import Gargantext.Utils.Zip (zipContentsPure)
 import Servant ( FromHttpApiData(parseUrlPiece), ToHttpApiData(toUrlPiece), Required, Strict, QueryParam', MimeRender(.. ), MimeUnrender(..))
 import Servant.Job.Utils (jsonOptions)
-import Test.QuickCheck (elements, frequency)
-import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
 ------------------------------------------------------------------------
 
@@ -96,7 +94,7 @@ instance ToJSONKey TabType where
 
 newtype MSet a = MSet (Map a ())
   deriving stock (Eq, Ord, Show, Read, Generic)
-  deriving newtype (Arbitrary, Semigroup, Monoid)
+  deriving newtype (Semigroup, Monoid)
   deriving anyclass (ToExpr)
 
 instance ToJSON a => ToJSON (MSet a) where
@@ -123,14 +121,14 @@ instance Foldable MSet where
 instance (Ord a, FromJSON a) => FromJSON (MSet a) where
   parseJSON = fmap mSetFromList . parseJSON
 
-instance (ToJSONKey a, ToSchema a) => ToSchema (MSet a) where
+instance ToSchema (MSet a) where
   -- TODO
   declareNamedSchema _ = wellNamedSchema "" (Proxy :: Proxy TODO)
 
 ------------------------------------------------------------------------
 newtype NgramsTerm = NgramsTerm { unNgramsTerm :: Text }
   deriving (Ord, Eq, Show, Read, Generic)
-  deriving newtype (ToJSONKey, ToJSON, FromJSON, Semigroup, Arbitrary, Serialise, ToSchema, Hashable, NFData, FromField, ToField)
+  deriving newtype (ToJSONKey, ToJSON, FromJSON, Semigroup, Serialise, ToSchema, Hashable, NFData, FromField, ToField)
   deriving anyclass (ToExpr)
 instance IsHashable NgramsTerm where
   hash (NgramsTerm t) = hash t
@@ -243,24 +241,6 @@ toNgramsElement ns = map toNgramsElement' ns
                   $ map (\(NgramsTableData _ p t _ _ _) -> (p, Set.singleton t)) ns
 -}
 
-mockTable :: NgramsTable
-mockTable = NgramsTable
-  [ mkNgramsElement "animal"  MapTerm        Nothing       (mSetFromList ["dog", "cat"])
-  , mkNgramsElement "cat"     MapTerm       (rp "animal")  mempty
-  , mkNgramsElement "cats"    StopTerm       Nothing       mempty
-  , mkNgramsElement "dog"     MapTerm       (rp "animal")  (mSetFromList ["dogs"])
-  , mkNgramsElement "dogs"    StopTerm      (rp "dog")     mempty
-  , mkNgramsElement "fox"     MapTerm        Nothing       mempty
-  , mkNgramsElement "object"  CandidateTerm  Nothing       mempty
-  , mkNgramsElement "nothing" StopTerm       Nothing       mempty
-  , mkNgramsElement "organic" MapTerm        Nothing       (mSetFromList ["flower"])
-  , mkNgramsElement "flower"  MapTerm       (rp "organic") mempty
-  , mkNgramsElement "moon"    CandidateTerm  Nothing       mempty
-  , mkNgramsElement "sky"     StopTerm       Nothing       mempty
-  ]
-  where
-    rp n = Just $ RootParent n n
-
 instance ToSchema NgramsTable
 
 ------------------------------------------------------------------------
@@ -412,7 +392,7 @@ makePrisms ''PatchMSet
 _PatchMSetIso :: Ord a => Iso' (PatchMSet a) (PatchSet a)
 _PatchMSetIso = _PatchMSet . _PatchMap . iso f g . from _PatchSet
   where
-    f :: Ord a => Map a (Replace (Maybe ())) -> (Set a, Set a)
+    f :: Map a (Replace (Maybe ())) -> (Set a, Set a)
     f = Map.partition isRem >>> both %~ Map.keysSet
 
     g :: Ord a => (Set a, Set a) -> Map a (Replace (Maybe ()))
@@ -432,7 +412,7 @@ instance (Ord a, ToJSON a) => ToJSON (PatchMSet a) where
 instance (Ord a, FromJSON a) => FromJSON (PatchMSet a) where
   parseJSON = fmap (_PatchMSetIso #) . parseJSON
 
-instance ToSchema a => ToSchema (PatchMSet a) where
+instance ToSchema (PatchMSet a) where
   -- TODO
   declareNamedSchema _ = wellNamedSchema "" (Proxy :: Proxy TODO)
 
@@ -833,37 +813,6 @@ instance (Serialise a, Ord a) => Serialise (PatchMap a AddRem)
 instance (Serialise a, Ord a) => Serialise (PatchMSet a)
 instance (Serialise s, Serialise p) => Serialise (Repo s p)
 
---
--- Arbitrary instances
---
-instance Arbitrary     TabType where
-  arbitrary = elements [minBound .. maxBound]
-instance Arbitrary NgramsElement where
-  arbitrary = elements [newNgramsElement Nothing "sport"]
-instance Arbitrary NgramsTable where
-  arbitrary = pure mockTable
-instance Arbitrary OrderBy
-  where
-    arbitrary = elements [minBound..maxBound]
-instance (Ord a, Arbitrary a) => Arbitrary (PatchMSet a) where
-  arbitrary = (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 NgramsPatch where
-  arbitrary = frequency [ (9, NgramsPatch <$> arbitrary <*> (replace <$> arbitrary <*> arbitrary))
-                        , (1, NgramsReplace <$> arbitrary <*> arbitrary)
-                        ]
-instance Arbitrary NgramsTablePatch where
-  arbitrary = NgramsTablePatch <$> PM.fromMap <$> arbitrary
-instance Arbitrary a => Arbitrary (Versioned a) where
-  arbitrary = Versioned 1 <$> arbitrary -- TODO 1 is constant so far
-instance Arbitrary a => Arbitrary (VersionedWithCount a) where
-  arbitrary = VersionedWithCount 1 1 <$> arbitrary -- TODO 1 is constant so far
-instance Arbitrary NgramsRepoElement where
-  arbitrary = elements $ map ngramsElementToRepo ns
-    where
-      NgramsTable ns = mockTable
 
 
 toNgramsPatch :: [NgramsTerm] -> NgramsPatch

src/Gargantext/API/Node.hs

@@ -21,6 +21,8 @@ Node API
 
 -}
 
+{-# OPTIONS_GHC -Wredundant-constraints #-}
+
 {-# LANGUAGE ScopedTypeVariables  #-}
 {-# LANGUAGE TemplateHaskell      #-}
 {-# LANGUAGE TypeOperators        #-}

src/Gargantext/Core/Methods/Matrix/Accelerate/Utils.hs

@@ -22,7 +22,7 @@ Implementation use Accelerate library which enables GPU and CPU computation:
 
 -}
 
-{-# OPTIONS_GHC -fno-warn-deprecations #-}
+{-# OPTIONS_GHC -fno-warn-deprecations -fno-warn-redundant-constraints #-}
 
 {-# LANGUAGE TypeFamilies        #-}
 {-# LANGUAGE TypeOperators       #-}

src/Gargantext/Core/Methods/Similarities/Accelerate/Distributional.hs

@@ -81,6 +81,8 @@ where $n_{ij}$ is the cooccurrence between term $i$ and term $j$
                         )
 -}
 
+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
+
 {-# LANGUAGE TypeFamilies        #-}
 {-# LANGUAGE TypeOperators       #-}
 {-# LANGUAGE ScopedTypeVariables #-}

src/Gargantext/Core/NodeStory/Types.hs

@@ -26,7 +26,6 @@ module Gargantext.Core.NodeStory.Types
   , NgramsStatePatch'
   , NodeListStory
   , ArchiveList
-  , initNodeListStoryMock
   , NodeStoryEnv(..)
   , initNodeStory
   , nse_getter
@@ -160,19 +159,6 @@ initArchive = Archive { _a_version = 0
                       , _a_state = mempty
                       , _a_history = [] }
 
-initNodeListStoryMock :: NodeListStory
-initNodeListStoryMock = NodeStory $ Map.singleton nodeListId archive
-  where
-    nodeListId = 0
-    archive = Archive { _a_version = 0
-                      , _a_state = ngramsTableMap
-                      , _a_history = [] }
-    ngramsTableMap = Map.singleton Ngrams.NgramsTerms
-                   $ Map.fromList
-                   [ (n ^. ne_ngrams, ngramsElementToRepo n)
-                   | n <- mockTable ^. _NgramsTable
-                   ]
-
 ----------------------------------------------------------------------
 data NodeStoryPoly nid v ngtid ngid nre =
   NodeStoryDB { node_id             :: !nid

src/Gargantext/Core/Text/Terms/Eleve.hs

@@ -95,7 +95,7 @@ makeLenses ''I
 
 type ModEntropy i o e = (e -> e) -> i -> o
 
-set_autonomy :: Entropy e => ModEntropy (I e) (I e) e
+set_autonomy :: ModEntropy (I e) (I e) e
 set_autonomy fe i = i & info_autonomy .~ fe (i ^. info_entropy_var)
 
 set_entropy_var :: Entropy e => Setter e (I e) e e

src/Gargantext/Core/Utils.hs

@@ -61,7 +61,7 @@ randomString num = do
 
 -- | Given a list of items of type 'a', return list with unique items
 -- (like List.nub) but tuple-d with their counts in the original list
-groupWithCounts :: (Ord a, Eq a) => [a] -> [(a, Int)]
+groupWithCounts :: (Eq a, Ord a) => [a] -> [(a, Int)]
 groupWithCounts = map f
                 . List.group
                 . List.sort

test/Test/Instances.hs

@@ -14,13 +14,20 @@ Portability : POSIX
 
 module Test.Instances where
 
+import Data.Map.Strict qualified as Map
+import Data.Map.Strict.Patch qualified as PM
+import Data.Patch.Class (Replace(Keep), replace)
 import EPO.API.Client.Types qualified as EPO
+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.Hyperdata qualified as Hyperdata
-import Gargantext.Prelude
+import Gargantext.Prelude hiding (replace)
 import Servant.Job.Core qualified as SJ
 import Servant.Job.Types qualified as SJ
 import Test.QuickCheck
@@ -150,3 +157,67 @@ instance Arbitrary DET.WSRequest where
                     , 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
+--                    ]