[REFACT] Types work (WIP)

src/Gargantext/Core/Text/Terms.hs

@@ -116,6 +116,8 @@ class ExtractNgramsT h
                    -> h
                    -> Cmd err (Map Ngrams (Map NgramsType Int))
 
+
+
 filterNgramsT :: Int -> Map Ngrams (Map NgramsType Int)
                      -> Map Ngrams (Map NgramsType Int)
 filterNgramsT s ms = Map.fromList $ map filter' $ Map.toList ms

src/Gargantext/Database/Action/Flow.hs

@@ -308,7 +308,6 @@ insertDocs uId cId hs = do
   pure (newIds', documentsWithId)
 
 
-
 ------------------------------------------------------------------------
 viewUniqId' :: UniqId a
             => a

src/Gargantext/Database/Action/Flow/List.hs

@@ -37,7 +37,6 @@ import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Query.Table.Node_NodeNgramsNodeNgrams
 import Gargantext.Database.Query.Table.NodeNgrams (NodeNgramsPoly(..), NodeNgramsW, listInsertDb, getCgramsId)
--- import Gargantext.Database.Schema.Ngrams -- (insertNgrams, Ngrams(..), NgramsIndexed(..), indexNgrams,  NgramsType(..), text2ngrams, ngramsTypeId)
 import Gargantext.Database.Schema.Ngrams (Ngrams(..), NgramsType(..))
 import Gargantext.Prelude
 

src/Gargantext/Database/Action/Flow/Utils.hs

@@ -14,15 +14,14 @@ module Gargantext.Database.Action.Flow.Utils
     where
 
 import Data.Map (Map)
-import qualified Data.Map as DM
-
-import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Admin.Types.Hyperdata (Hyperdata)
+import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Database.Query.Table.NodeNodeNgrams
 import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude
+import qualified Data.Map as DM
 
 
 toMaps :: Hyperdata a
@@ -82,7 +81,7 @@ insertDocNgramsOn cId dn =
   $ (map (docNgrams2nodeNodeNgrams cId) dn)
 
 insertDocNgrams :: CorpusId
-                -> Map NgramsIndexed (Map NgramsType (Map NodeId Int))
+                -> Map (NgramsIndexed Ngrams) (Map NgramsType (Map NodeId Int))
                 -> Cmd err Int
 insertDocNgrams cId m =
   insertDocNgramsOn cId [ DocNgrams n (_ngramsId ng) (ngramsTypeId t) (fromIntegral i)

src/Gargantext/Database/Query/Table/Ngrams.hs

@@ -64,10 +64,10 @@ _dbGetNgramsDb = runOpaQuery queryNgramsTable
 
 -- TODO-ACCESS: access must not be checked here but when insertNgrams is called.
 insertNgrams :: [Ngrams] -> Cmd err (Map NgramsTerms NgramsId)
-insertNgrams ns = fromList <$> map (\(NgramIds i t) -> (t, i)) <$> (insertNgrams' ns)
+insertNgrams ns = fromList <$> map (\(NgramsIndexed t i) -> (t, i)) <$> (insertNgrams' ns)
 
 -- TODO-ACCESS: access must not be checked here but when insertNgrams' is called.
-insertNgrams' :: [Ngrams] -> Cmd err [NgramIds]
+insertNgrams' :: [Ngrams] -> Cmd err [NgramsIndexed Text]
 insertNgrams' ns = runPGSQuery queryInsertNgrams (PGS.Only $ Values fields ns)
   where
     fields = map (\t -> QualifiedIdentifier Nothing t) ["text", "int4"]
@@ -88,7 +88,7 @@ queryInsertNgrams = [sql|
        RETURNING id,terms
        )
 
-    SELECT id, terms
+    SELECT terms, id
     FROM   ins
     UNION  ALL
     SELECT c.id, terms

src/Gargantext/Database/Query/Table/NgramsPostag.hs

@@ -37,7 +37,7 @@ type NgramsPostagInsert = ( Int
                           )
 
 
-insertNgramsPostag :: [NgramsPostagInsert] -> Cmd err [NgramIds]
+insertNgramsPostag :: [NgramsPostagInsert] -> Cmd err [NgramsIndexed Text]
 insertNgramsPostag ns = runPGSQuery queryInsertNgramsPostag (PGS.Only $ Values fields ns)
   where
 
@@ -96,7 +96,7 @@ queryInsertNgramsPostag = [sql|
         DO UPDATE SET score = ngrams_postag.score + 1
     )
 
-SELECT id,terms FROM ins_form_ret
+SELECT terms,id FROM ins_form_ret
  INNER JOIN input_rows ir ON ins_form_ret.terms = ir.form
 
   |]

src/Gargantext/Database/Schema/Ngrams.hs

@@ -82,7 +82,6 @@ data NgramsType = Authors | Institutes | Sources | NgramsTerms
   deriving (Eq, Show, Read, Ord, Enum, Bounded, Generic)
 
 instance Serialise NgramsType
-instance Hashable  NgramsType
 
 ngramsTypes :: [NgramsType]
 ngramsTypes = [minBound..]
@@ -107,6 +106,7 @@ instance FromField NgramsTypeId where
 instance FromJSON NgramsType
 instance FromJSONKey NgramsType where
    fromJSONKey = FromJSONKeyTextParser (parseJSON . String)
+
 instance ToJSON NgramsType
 instance ToJSONKey NgramsType where
    toJSONKey = toJSONKeyText (pack . show)
@@ -140,22 +140,30 @@ fromNgramsTypeId id = lookup id
                                | nt <- [minBound .. maxBound] :: [NgramsType]
                                ]
 
+------------------------------------------------------------------------
 ------------------------------------------------------------------------
 -- | TODO put it in Gargantext.Core.Text.Ngrams
 data Ngrams = UnsafeNgrams { _ngramsTerms :: Text
                            , _ngramsSize  :: Int
-                           } deriving (Generic, Show, Eq, Ord)
+                           }
+  deriving (Generic, Show, Eq, Ord)
 
 makeLenses ''Ngrams
 instance PGS.ToRow Ngrams where
   toRow (UnsafeNgrams t s) = [toField t, toField s]
 
+instance FromField Ngrams where
+  fromField fld mdata = do
+    x <- fromField fld mdata
+    pure $ text2ngrams x
+
 text2ngrams :: Text -> Ngrams
 text2ngrams txt = UnsafeNgrams txt' $ length $ splitOn " " txt'
   where
     txt' = strip txt
 
 
+------------------------------------------------------------------------
 -------------------------------------------------------------------------
 -- | TODO put it in Gargantext.Core.Text.Ngrams
 -- Named entity are typed ngrams of Terms Ngrams
@@ -169,40 +177,32 @@ makeLenses ''NgramsT
 instance Functor NgramsT where
   fmap = over ngramsT
 -----------------------------------------------------------------------
-data NgramsIndexed =
+data NgramsIndexed a =
   NgramsIndexed
-  { _ngrams   :: Ngrams
+  { _ngrams   :: a
   , _ngramsId :: NgramsId
   } deriving (Show, Generic, Eq, Ord)
 
 makeLenses ''NgramsIndexed
-------------------------------------------------------------------------
-data NgramIds =
-  NgramIds
-  { ngramId    :: Int
-  , ngramTerms :: Text
-  } deriving (Show, Generic, Eq, Ord)
 
-instance PGS.FromRow NgramIds where
-  fromRow = NgramIds <$> field <*> field
+instance (FromField a) => PGS.FromRow (NgramsIndexed a) where
+  fromRow = NgramsIndexed <$> field <*> field
 
-----------------------
+------------------------------------------------------------------------
 withMap :: Map NgramsTerms NgramsId -> NgramsTerms -> NgramsId
 withMap m n = maybe (panic "withMap: should not happen") identity (lookup n m)
 
-indexNgramsT :: Map NgramsTerms NgramsId -> NgramsT Ngrams -> NgramsT NgramsIndexed
+indexNgramsT :: Map NgramsTerms NgramsId -> NgramsT Ngrams -> NgramsT (NgramsIndexed Ngrams)
 indexNgramsT = fmap . indexNgramsWith . withMap
 
-indexNgrams :: Map NgramsTerms NgramsId -> Ngrams -> NgramsIndexed
+indexNgrams :: Map NgramsTerms NgramsId -> Ngrams -> (NgramsIndexed Ngrams)
 indexNgrams = indexNgramsWith . withMap
 
+{-
 -- NP: not sure we need it anymore
-indexNgramsTWith :: (NgramsTerms -> NgramsId) -> NgramsT Ngrams -> NgramsT NgramsIndexed
+indexNgramsTWith :: (NgramsTerms -> NgramsId) -> NgramsT Ngrams -> NgramsT (NgramsIndexed
 indexNgramsTWith = fmap . indexNgramsWith
+-}
 
-indexNgramsWith :: (NgramsTerms -> NgramsId) -> Ngrams -> NgramsIndexed
+indexNgramsWith :: (NgramsTerms -> NgramsId) -> Ngrams -> NgramsIndexed Ngrams
 indexNgramsWith f n = NgramsIndexed n (f $ _ngramsTerms n)
-
-
-
-

src/Gargantext/Database/Schema/NgramsPostag.hs

@@ -50,7 +50,6 @@ data PosTag = PosTag { unPosTag :: Text }
 
 ------------------------------------------------------------------------
 type NgramsPostag   = NgramsPostagPoly (Maybe Int) Lang PostTagAlgo (Maybe PosTag) NgramsTerm NgramsTerm (Maybe Int)
-
 type NgramsPostagDB = NgramsPostagPoly (Maybe Int) Int Int (Maybe Text) Int Int Int