Remove superfluous gfortran extra-libraries stanza
[gargantext.git] / src / Gargantext / Database / Schema / NodeNodeNgrams.hs
index dff6735550d56d27c3fd7d0e77763eb9b4577918..5ac16e8e9cd96925930f620cf2854e4e94d70546 100644 (file)
@@ -9,76 +9,64 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE Arrows #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-#  OPTIONS_GHC -fno-warn-orphans  #-}
 
+{-# LANGUAGE Arrows                 #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE TemplateHaskell        #-}
 
 module Gargantext.Database.Schema.NodeNodeNgrams
   where
 
 import Prelude
-import Data.Maybe (Maybe)
-import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
-import Control.Lens.TH (makeLensesWith, abbreviatedFields)
-import Gargantext.Database.Utils (Cmd, runOpaQuery)
-
-import Opaleye
-
-
-data NodeNodeNgramsPoly node1_id node2_id ngram_id score
-                   = NodeNodeNgrams { nnng_node1_id :: node1_id
-                                    , nnng_node2_id :: node2_id
-                                    , nnng_ngrams_id :: ngram_id
-                                    , nnng_score   :: score
-                                    } deriving (Show)
-
-
-type NodeNodeNgramsWrite = NodeNodeNgramsPoly (Column PGInt4          )
-                                            (Column PGInt4          )
-                                            (Column PGInt4          )
-                                            (Maybe (Column PGFloat8))
-
-type NodeNodeNgramsRead  = NodeNodeNgramsPoly (Column PGInt4  )
-                                            (Column PGInt4  )
-                                            (Column PGInt4  )
-                                            (Column PGFloat8)
-
-type NodeNodeNgramsReadNull  = NodeNodeNgramsPoly (Column (Nullable PGInt4  ))
-                                                (Column (Nullable PGInt4  ))
-                                                (Column (Nullable PGInt4  ))
-                                                (Column (Nullable PGFloat8))
-
-type NodeNodeNgrams = NodeNodeNgramsPoly Int
-                                       Int
-                                       Int 
-                                (Maybe Double)
-
+import Gargantext.Database.Schema.Prelude
+import Gargantext.Database.Schema.Ngrams (NgramsTypeId, NgramsId)
+import Gargantext.Database.Admin.Types.Node
+
+data NodeNodeNgramsPoly n1 n2 ngrams_id ngt w
+   = NodeNodeNgrams { _nnng_node1_id   :: !n1
+                    , _nnng_node2_id   :: !n2
+                    , _nnng_ngrams_id  :: !ngrams_id
+                    , _nnng_ngramsType :: !ngt
+                    , _nnng_weight     :: !w
+                    } deriving (Show)
+
+type NodeNodeNgramsWrite =
+     NodeNodeNgramsPoly (Column PGInt4  )
+                        (Column PGInt4  )
+                        (Column PGInt4  )
+                        (Column PGInt4  )
+                        (Column PGFloat8)
+
+type NodeNodeNgramsRead  =
+     NodeNodeNgramsPoly (Column PGInt4  )
+                        (Column PGInt4  )
+                        (Column PGInt4  )
+                        (Column PGInt4  )
+                        (Column PGFloat8)
+
+type NodeNodeNgramsReadNull =
+     NodeNodeNgramsPoly (Column (Nullable PGInt4  ))
+                        (Column (Nullable PGInt4  ))
+                        (Column (Nullable PGInt4  ))
+                        (Column (Nullable PGInt4  ))
+                        (Column (Nullable PGFloat8))
+
+type NodeNodeNgrams =
+  NodeNodeNgramsPoly CorpusId DocId NgramsId NgramsTypeId Double
 
 $(makeAdaptorAndInstance "pNodeNodeNgrams" ''NodeNodeNgramsPoly)
-$(makeLensesWith abbreviatedFields        ''NodeNodeNgramsPoly)
+makeLenses ''NodeNodeNgramsPoly
+
 
 nodeNodeNgramsTable :: Table NodeNodeNgramsWrite NodeNodeNgramsRead
-nodeNodeNgramsTable  = Table "nodes_nodes_ngrams" 
+nodeNodeNgramsTable  = Table "node_node_ngrams"
                           ( pNodeNodeNgrams NodeNodeNgrams
-                               { nnng_node1_id  = required "node1_id"
-                               , nnng_node2_id  = required "node2_id"
-                               , nnng_ngrams_id = required "ngram_id"
-                               , nnng_score     = optional "score"
+                               { _nnng_node1_id   = required "node1_id"
+                               , _nnng_node2_id   = required "node2_id"
+                               , _nnng_ngrams_id  = required "ngrams_id"
+                               , _nnng_ngramsType = required "ngrams_type"
+                               , _nnng_weight     = required "weight"
                                }
                           )
 
-
-queryNodeNodeNgramsTable :: Query NodeNodeNgramsRead
-queryNodeNodeNgramsTable = queryTable nodeNodeNgramsTable
-
--- | not optimized (get all ngrams without filters)
-nodeNodeNgrams :: Cmd err [NodeNodeNgrams]
-nodeNodeNgrams = runOpaQuery queryNodeNodeNgramsTable
-
-instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
-    queryRunnerColumnDefault = fieldQueryRunnerColumn