[REFACT] FlowList integration to Terms with instances
[gargantext.git] / src / Gargantext / Database / Schema / Ngrams.hs
index b0d89d156ed3502d6adc895222c6fc1da1b1b4f0..5d1f4870319dc606685bb9254427b349b24b8ff8 100644 (file)
@@ -12,33 +12,23 @@ Ngrams connection to the Database.
 -}
 
 {-# LANGUAGE Arrows                     #-}
-{-# LANGUAGE DeriveGeneric              #-}
-{-# LANGUAGE FlexibleContexts           #-}
-{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE FunctionalDependencies     #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses  #-}
-{-# LANGUAGE NoImplicitPrelude      #-}
-{-# LANGUAGE OverloadedStrings      #-}
 {-# LANGUAGE QuasiQuotes            #-}
-{-# LANGUAGE RankNTypes             #-}
 {-# LANGUAGE TemplateHaskell        #-}
 
 module Gargantext.Database.Schema.Ngrams
   where
 
-import Control.Lens (makeLenses, over)
+import Codec.Serialise (Serialise())
+import Control.Lens (over)
 import Control.Monad (mzero)
 import Data.Aeson
 import Data.Aeson.Types (toJSONKeyText)
 import Data.Map (Map, fromList, lookup)
-import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
-import Data.Swagger (ToParamSchema, toParamSchema, ToSchema)
-import Data.Text (Text, splitOn, pack)
-import GHC.Generics (Generic)
+import Data.Text (Text, splitOn, pack, strip)
 import Gargantext.Core.Types (TODO(..))
 import Gargantext.Prelude
-import Prelude (Enum, Bounded, minBound, maxBound, Functor)
+import Prelude (Functor)
 import Servant (FromHttpApiData, parseUrlPiece, Proxy(..))
 import Text.Read (read)
 import Gargantext.Database.Schema.Prelude
@@ -49,7 +39,7 @@ type NgramsId    = Int
 type NgramsTerms = Text
 type Size        = Int
 
-data NgramsPoly id terms n = NgramsDb { _ngrams_id    :: !id
+data NgramsPoly id terms n = NgramsDB { _ngrams_id    :: !id
                                       , _ngrams_terms :: !terms
                                       , _ngrams_n     :: !n
                                       } deriving (Show)
@@ -66,14 +56,14 @@ type NgramsReadNull = NgramsPoly (Column (Nullable PGInt4))
                                  (Column (Nullable PGText))
                                  (Column (Nullable PGInt4))
 
-type NgramsDb = NgramsPoly Int Text Int
+type NgramsDB = NgramsPoly Int Text Int
 
 $(makeAdaptorAndInstance "pNgramsDb"    ''NgramsPoly)
 makeLenses ''NgramsPoly
 
 
 ngramsTable :: Table NgramsWrite NgramsRead
-ngramsTable = Table "ngrams" (pNgramsDb NgramsDb { _ngrams_id    = optional "id"
+ngramsTable = Table "ngrams" (pNgramsDb NgramsDB { _ngrams_id    = optional "id"
                                                  , _ngrams_terms = required "terms"
                                                  , _ngrams_n     = required "n"
                                                  }
@@ -90,6 +80,8 @@ ngramsTable = Table "ngrams" (pNgramsDb NgramsDb { _ngrams_id    = optional "id"
 data NgramsType = Authors | Institutes | Sources | NgramsTerms
   deriving (Eq, Show, Read, Ord, Enum, Bounded, Generic)
 
+instance Serialise NgramsType
+
 ngramsTypes :: [NgramsType]
 ngramsTypes = [minBound..]
 
@@ -147,20 +139,22 @@ fromNgramsTypeId id = lookup id
                                ]
 
 ------------------------------------------------------------------------
--- | TODO put it in Gargantext.Text.Ngrams
-data Ngrams = Ngrams { _ngramsTerms :: Text
-                     , _ngramsSize  :: Int
-           } deriving (Generic, Show, Eq, Ord)
+-- | TODO put it in Gargantext.Core.Text.Ngrams
+data Ngrams = UnsafeNgrams { _ngramsTerms :: Text
+                           , _ngramsSize  :: Int
+                           } deriving (Generic, Show, Eq, Ord)
 
 makeLenses ''Ngrams
 instance PGS.ToRow Ngrams where
-  toRow (Ngrams t s) = [toField t, toField s]
+  toRow (UnsafeNgrams t s) = [toField t, toField s]
 
 text2ngrams :: Text -> Ngrams
-text2ngrams txt = Ngrams txt $ length $ splitOn " " txt
+text2ngrams txt = UnsafeNgrams txt' $ length $ splitOn " " txt'
+  where
+    txt' = strip txt
 
 -------------------------------------------------------------------------
--- | TODO put it in Gargantext.Text.Ngrams
+-- | TODO put it in Gargantext.Core.Text.Ngrams
 -- Named entity are typed ngrams of Terms Ngrams
 data NgramsT a =
   NgramsT { _ngramsType :: NgramsType