[NGRAMS] fixes

parent 78505cd6
...@@ -103,6 +103,7 @@ library: ...@@ -103,6 +103,7 @@ library:
- hxt - hxt
- hlcm - hlcm
- ini - ini
- insert-ordered-containers
- jose-jwt - jose-jwt
# - kmeans-vector # - kmeans-vector
- KMP - KMP
......
...@@ -23,48 +23,49 @@ add get ...@@ -23,48 +23,49 @@ add get
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS -fno-warn-orphans #-}
module Gargantext.API.Ngrams module Gargantext.API.Ngrams
where where
-- import Gargantext.Database.User (UserId) -- import Gargantext.Database.User (UserId)
import Data.Patch.Class (Replace(..), replace) import Data.Patch.Class (Replace, replace)
import qualified Data.Map.Strict.Patch as PM --import qualified Data.Map.Strict.Patch as PM
import Data.Monoid import Data.Monoid
import Data.Semigroup --import Data.Semigroup
import Data.Set (Set) import Data.Set (Set)
import qualified Data.Set as Set import qualified Data.Set as Set
--import Data.Maybe (catMaybes) --import Data.Maybe (catMaybes)
--import qualified Data.Map.Strict as DM --import qualified Data.Map.Strict as DM
--import qualified Data.Set as Set --import qualified Data.Set as Set
import Control.Lens (view) import Control.Lens (view, (.~))
import Data.Aeson (FromJSON, ToJSON) import Data.Aeson
import Data.Aeson.TH (deriveJSON) import Data.Aeson.TH (deriveJSON)
import Data.Either(Either(Left)) import Data.Either(Either(Left))
import Data.List (concat) import Data.List (concat)
import Data.Set (Set) import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
import Data.Swagger (ToSchema, ToParamSchema) import Data.Swagger
import Data.Text (Text) import Data.Text (Text)
import Database.PostgreSQL.Simple (Connection) import Database.PostgreSQL.Simple (Connection)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Gargantext.Core.Types (node_id) 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.Core.Utils.Prefix (unPrefix)
import Gargantext.Database.Ngrams (NgramsId) import Gargantext.Database.Ngrams (NgramsId)
import Gargantext.Database.Node (getListsWithParentId) import Gargantext.Database.Node (getListsWithParentId)
-- import Gargantext.Database.NodeNgram -- (NodeNgram(..), NodeNgram, updateNodeNgrams, NodeNgramPoly) -- import Gargantext.Database.NodeNgram -- (NodeNgram(..), NodeNgram, updateNodeNgrams, NodeNgramPoly)
import Gargantext.Database.NodeNgramsNgrams -- (NodeNgramsNgramsPoly(NodeNgramsNgrams)) import Gargantext.Database.NodeNgramsNgrams -- (NodeNgramsNgramsPoly(NodeNgramsNgrams))
import Gargantext.Prelude 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 Prelude (Enum, Bounded, minBound, maxBound)
import Servant hiding (Patch) import Servant hiding (Patch)
import Test.QuickCheck (elements) import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
-- import qualified Data.Set as Set
------------------------------------------------------------------------ ------------------------------------------------------------------------
--data FacetFormat = Table | Chart --data FacetFormat = Table | Chart
...@@ -145,9 +146,26 @@ data PatchSet a = PatchSet ...@@ -145,9 +146,26 @@ data PatchSet a = PatchSet
instance (Ord a, Arbitrary a) => Arbitrary (PatchSet a) where instance (Ord a, Arbitrary a) => Arbitrary (PatchSet a) where
arbitrary = PatchSet <$> arbitrary <*> arbitrary 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 (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 = data NgramsPatch =
NgramsPatch { _patch_children :: PatchSet NgramsElement NgramsPatch { _patch_children :: PatchSet NgramsElement
...@@ -156,7 +174,7 @@ data NgramsPatch = ...@@ -156,7 +174,7 @@ data NgramsPatch =
deriving (Ord, Eq, Show, Generic) deriving (Ord, Eq, Show, Generic)
$(deriveJSON (unPrefix "_") ''NgramsPatch) $(deriveJSON (unPrefix "_") ''NgramsPatch)
instance Semigroup NgramsPatch where -- instance Semigroup NgramsPatch where
instance ToSchema NgramsPatch instance ToSchema NgramsPatch
...@@ -239,10 +257,12 @@ defaultList c cId = view node_id <$> maybe (panic noListFound) identity ...@@ -239,10 +257,12 @@ defaultList c cId = view node_id <$> maybe (panic noListFound) identity
where where
noListFound = "Gargantext.API.Ngrams.defaultList: no list found" noListFound = "Gargantext.API.Ngrams.defaultList: no list found"
{-
toLists :: ListId -> NgramsIdPatchs -> [(ListId, NgramsId, ListTypeId)] toLists :: ListId -> NgramsIdPatchs -> [(ListId, NgramsId, ListTypeId)]
toLists = undefined
{-
toLists lId np = toLists lId np =
[ (lId,ngId,listTypeId lt) | map (toList lId) (_nip_ngramsIdPatchs np) ] [ (lId,ngId,listTypeId lt) | map (toList lId) (_nip_ngramsIdPatchs np) ]
-}
toList :: ListId -> NgramsIdPatch -> (ListId, NgramsId, ListTypeId) toList :: ListId -> NgramsIdPatch -> (ListId, NgramsId, ListTypeId)
toList = undefined toList = undefined
...@@ -252,7 +272,7 @@ toGroups lId addOrRem ps = concat $ map (toGroup lId addOrRem) $ _nip_ngramsIdPa ...@@ -252,7 +272,7 @@ toGroups lId addOrRem ps = concat $ map (toGroup lId addOrRem) $ _nip_ngramsIdPa
toGroup :: ListId -> (NgramsPatch -> Set NgramsId) -> NgramsIdPatch -> [NodeNgramsNgrams] toGroup :: ListId -> (NgramsPatch -> Set NgramsId) -> NgramsIdPatch -> [NodeNgramsNgrams]
toGroup = undefined toGroup = undefined
-}
{- {-
toGroup lId addOrRem (NgramsIdPatch ngId patch) = toGroup lId addOrRem (NgramsIdPatch ngId patch) =
map (\ng -> (NodeNgramsNgrams lId ngId ng (Just 1))) (Set.toList $ addOrRem patch) map (\ng -> (NodeNgramsNgrams lId ngId ng (Just 1))) (Set.toList $ addOrRem patch)
......
...@@ -211,7 +211,7 @@ insertGroups lId ngrs = ...@@ -211,7 +211,7 @@ insertGroups lId ngrs =
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- TODO: verify NgramsT lost here -- TODO: verify NgramsT lost here
ngrams2list :: Map (NgramsT NgramsIndexed) (Map NodeId Int) -> Map ListType NgramsIndexed 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 -- | TODO: weight of the list could be a probability
insertLists :: ListId -> Map ListType NgramsIndexed -> Cmd Int insertLists :: ListId -> Map ListType NgramsIndexed -> Cmd Int
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment