diff --git a/package.yaml b/package.yaml index 1d7710b43e0d8d25c283bebcd95e2d15fb8ebb52..335a50c2ba3466aecd858d5f1f8c7c557f2f65e0 100644 --- a/package.yaml +++ b/package.yaml @@ -103,6 +103,7 @@ library: - hxt - hlcm - ini + - insert-ordered-containers - jose-jwt # - kmeans-vector - KMP diff --git a/src/Gargantext/API/Ngrams.hs b/src/Gargantext/API/Ngrams.hs index 291796b7f3d35c93189961ad529f1dcb7a0eb74e..0de01d18a0265d36d7274cba7ddf3f54e1dcf9d8 100644 --- a/src/Gargantext/API/Ngrams.hs +++ b/src/Gargantext/API/Ngrams.hs @@ -23,48 +23,49 @@ add get {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# OPTIONS -fno-warn-orphans #-} module Gargantext.API.Ngrams where -- import Gargantext.Database.User (UserId) -import Data.Patch.Class (Replace(..), replace) -import qualified Data.Map.Strict.Patch as PM +import Data.Patch.Class (Replace, replace) +--import qualified Data.Map.Strict.Patch as PM import Data.Monoid -import Data.Semigroup +--import Data.Semigroup import Data.Set (Set) import qualified Data.Set as Set --import Data.Maybe (catMaybes) --import qualified Data.Map.Strict as DM --import qualified Data.Set as Set -import Control.Lens (view) -import Data.Aeson (FromJSON, ToJSON) +import Control.Lens (view, (.~)) +import Data.Aeson import Data.Aeson.TH (deriveJSON) import Data.Either(Either(Left)) import Data.List (concat) -import Data.Set (Set) -import Data.Swagger (ToSchema, ToParamSchema) +import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap +import Data.Swagger import Data.Text (Text) import Database.PostgreSQL.Simple (Connection) import GHC.Generics (Generic) import Gargantext.Core.Types (node_id) -import Gargantext.Core.Types.Main (Tree(..)) +--import Gargantext.Core.Types.Main (Tree(..)) import Gargantext.Core.Utils.Prefix (unPrefix) import Gargantext.Database.Ngrams (NgramsId) import Gargantext.Database.Node (getListsWithParentId) -- import Gargantext.Database.NodeNgram -- (NodeNgram(..), NodeNgram, updateNodeNgrams, NodeNgramPoly) import Gargantext.Database.NodeNgramsNgrams -- (NodeNgramsNgramsPoly(NodeNgramsNgrams)) import Gargantext.Prelude -import Gargantext.Text.List.Types (ListType(..), ListId, ListTypeId) --,listTypeId ) +import Gargantext.Text.List.Types (ListType(..), ListId, ListTypeId) -- ,listTypeId ) import Prelude (Enum, Bounded, minBound, maxBound) import Servant hiding (Patch) import Test.QuickCheck (elements) import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) --- import qualified Data.Set as Set ------------------------------------------------------------------------ --data FacetFormat = Table | Chart @@ -145,9 +146,26 @@ data PatchSet a = PatchSet instance (Ord a, Arbitrary a) => Arbitrary (PatchSet a) where arbitrary = PatchSet <$> arbitrary <*> arbitrary +instance ToJSON a => ToJSON (PatchSet a) where + toJSON = genericToJSON $ unPrefix "_" + toEncoding = genericToEncoding $ unPrefix "_" + +instance (Ord a, FromJSON a) => FromJSON (PatchSet a) where + parseJSON = genericParseJSON $ unPrefix "_" + instance ToSchema a => ToSchema (PatchSet a) -instance ToSchema a => ToSchema (Replace a) +instance ToSchema a => ToSchema (Replace a) where + declareNamedSchema (_ :: proxy (Replace a)) = do + aSchema <- declareSchemaRef (Proxy :: Proxy a) + return $ NamedSchema (Just "Replace") $ mempty + & type_ .~ SwaggerObject + & properties .~ + InsOrdHashMap.fromList + [ ("old", aSchema) + , ("new", aSchema) + ] + & required .~ [ "old", "new" ] data NgramsPatch = NgramsPatch { _patch_children :: PatchSet NgramsElement @@ -156,7 +174,7 @@ data NgramsPatch = deriving (Ord, Eq, Show, Generic) $(deriveJSON (unPrefix "_") ''NgramsPatch) -instance Semigroup NgramsPatch where +-- instance Semigroup NgramsPatch where instance ToSchema NgramsPatch @@ -239,10 +257,12 @@ defaultList c cId = view node_id <$> maybe (panic noListFound) identity where noListFound = "Gargantext.API.Ngrams.defaultList: no list found" -{- toLists :: ListId -> NgramsIdPatchs -> [(ListId, NgramsId, ListTypeId)] +toLists = undefined +{- toLists lId np = [ (lId,ngId,listTypeId lt) | map (toList lId) (_nip_ngramsIdPatchs np) ] +-} toList :: ListId -> NgramsIdPatch -> (ListId, NgramsId, ListTypeId) toList = undefined @@ -252,7 +272,7 @@ toGroups lId addOrRem ps = concat $ map (toGroup lId addOrRem) $ _nip_ngramsIdPa toGroup :: ListId -> (NgramsPatch -> Set NgramsId) -> NgramsIdPatch -> [NodeNgramsNgrams] toGroup = undefined --} + {- toGroup lId addOrRem (NgramsIdPatch ngId patch) = map (\ng -> (NodeNgramsNgrams lId ngId ng (Just 1))) (Set.toList $ addOrRem patch) diff --git a/src/Gargantext/Database/Flow.hs b/src/Gargantext/Database/Flow.hs index c4b56336c9c8a07c5d21e95d4c741fb5d2e56ba0..fb3467bdb5d41c73dda5f585b0fa00980d79afa9 100644 --- a/src/Gargantext/Database/Flow.hs +++ b/src/Gargantext/Database/Flow.hs @@ -211,7 +211,7 @@ insertGroups lId ngrs = ------------------------------------------------------------------------ -- TODO: verify NgramsT lost here ngrams2list :: Map (NgramsT NgramsIndexed) (Map NodeId Int) -> Map ListType NgramsIndexed -ngrams2list = DM.fromList . zip (repeat Candidate) . map (\(NgramsT t ng) -> ng) . DM.keys +ngrams2list = DM.fromList . zip (repeat Candidate) . map (\(NgramsT _lost_t ng) -> ng) . DM.keys -- | TODO: weight of the list could be a probability insertLists :: ListId -> Map ListType NgramsIndexed -> Cmd Int