[FIX scores]
[gargantext.git] / src / Gargantext / Database / Facet.hs
index 66a29ef12f703d7aa44d7dddbd43075d0be2fb62..0560b3c613fab2e00f6b274b0df638b3ffcfb441 100644 (file)
@@ -11,17 +11,19 @@ Portability : POSIX
 {-# OPTIONS_GHC -fno-warn-orphans        #-}
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 
-{-# LANGUAGE Arrows                      #-}
-{-# LANGUAGE DeriveGeneric               #-}
-{-# LANGUAGE TemplateHaskell             #-}
-{-# LANGUAGE FlexibleContexts            #-}
-{-# LANGUAGE FlexibleInstances           #-}
-{-# LANGUAGE MultiParamTypeClasses       #-}
-{-# LANGUAGE FunctionalDependencies      #-}
-{-# LANGUAGE NoMonomorphismRestriction   #-}
+{-# LANGUAGE Arrows                    #-}
+{-# LANGUAGE DeriveGeneric             #-}
+{-# LANGUAGE FlexibleContexts          #-}
+{-# LANGUAGE FlexibleInstances         #-}
+{-# LANGUAGE FunctionalDependencies    #-}
+{-# LANGUAGE MultiParamTypeClasses     #-}
+{-# LANGUAGE NoImplicitPrelude         #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE TemplateHaskell           #-}
 
 ------------------------------------------------------------------------
-module Gargantext.Database.Facet where
+module Gargantext.Database.Facet 
+  where
 ------------------------------------------------------------------------
 
 import Prelude hiding (null, id, map, sum, not)
@@ -47,50 +49,29 @@ import qualified Opaleye.Internal.Unpackspec()
 import Test.QuickCheck.Arbitrary
 import Test.QuickCheck (elements)
 
-import Gargantext.Types
-import Gargantext.Types.Node (NodeType)
+import Gargantext.Core.Types
+import Gargantext.Core.Types.Node (NodeType)
+import Gargantext.Core.Utils.Prefix (unPrefix)
 import Gargantext.Database.NodeNode
 import Gargantext.Database.NodeNodeNgram
 import Gargantext.Database.Node
 import Gargantext.Database.Queries
-import Gargantext.Utils.Prefix (unPrefix)
 -- import Gargantext.Database.NodeNgram
 
 ------------------------------------------------------------------------
-------------------------------------------------------------------------
-
 -- | DocFacet
---type FacetDoc = Facet NodeId UTCTime HyperdataDocument Bool -- Double
---
---data Facet id created hyperdata favorite  = 
---     FacetDoc { facetDoc_id         :: id
---              , facetDoc_created    :: created
---              , facetDoc_hyperdata  :: hyperdata
---              , facetDoc_favorite   :: favorite
---              } deriving (Show, Generic)
--- $(deriveJSON (unPrefix "facetDoc_") ''Facet)
---
---instance Arbitrary FacetDoc where
---    arbitrary = elements [ FacetDoc id' (jour year 01 01) hp fav 
---                         | id'  <- [   1..10   ]
---                         , year <- [1990..2000 ]
---                         , fav  <- [True, False]
---                         , hp   <- hyperdataDocuments
---                         ]
---
---instance ToSchema FacetDoc
---
----- Facets / Views for the Front End
---type FacetDocRead  = Facet (Column PGInt4       )
---                           (Column PGTimestamptz)
---                           (Column PGJsonb      )
---                           (Column PGBool       ) -- (Column PGFloat8)
---
--- $(makeAdaptorAndInstance "pFacetDoc" ''Facet)
--- $(makeLensesWith abbreviatedFields   ''Facet)
---
-------------------------------------------------------------------------
+
+-- data Facet = FacetDoc | FacetSources | FacetAuthors | FacetTerms
+--    deriving (Show, Generic)
+--instance FromJSON Facet
+--instance ToJSON   Facet
+
 type FacetDoc = Facet NodeId UTCTime HyperdataDocument Bool Int
+type FacetSources = FacetDoc
+type FacetAuthors = FacetDoc
+type FacetTerms   = FacetDoc
+
+
 
 data Facet id created hyperdata favorite ngramCount = 
      FacetDoc { facetDoc_id         :: id
@@ -100,8 +81,15 @@ data Facet id created hyperdata favorite ngramCount =
                , facetDoc_ngramCount :: ngramCount
                } deriving (Show, Generic)
 
+-- | JSON instance
+
 $(deriveJSON (unPrefix "facetDoc_") ''Facet)
 
+-- | Documentation instance
+instance ToSchema FacetDoc
+
+-- | Mock and Quickcheck instances
+
 instance Arbitrary FacetDoc where
     arbitrary = elements [ FacetDoc id' (jour year 01 01) hp fav ngramCount
                          | id'  <- [1..10]
@@ -112,19 +100,29 @@ instance Arbitrary FacetDoc where
                          ]
 
 -- Facets / Views for the Front End
+-- | Database instances
+$(makeAdaptorAndInstance "pFacetDoc" ''Facet)
+$(makeLensesWith abbreviatedFields   ''Facet)
+
 type FacetDocRead = Facet (Column PGInt4       )
                           (Column PGTimestamptz)
                           (Column PGJsonb      )
                           (Column PGBool       )
                           (Column PGInt4       )
 
-instance ToSchema FacetDoc
+-----------------------------------------------------------------------
 
+data FacetChart = FacetChart { facetChart_time  :: UTCTime'
+                             , facetChart_count :: Double
+                        }
+        deriving (Show, Generic)
+$(deriveJSON (unPrefix "facetChart_") ''FacetChart)
+instance ToSchema FacetChart
 
-$(makeAdaptorAndInstance "pFacetDoc" ''Facet)
-$(makeLensesWith abbreviatedFields   ''Facet)
+instance Arbitrary FacetChart where
+    arbitrary = FacetChart <$> arbitrary <*> arbitrary
 
-------------------------------------------------------------------------
+-----------------------------------------------------------------------
 
 
 getDocFacet :: Connection -> Int -> Maybe NodeType 
@@ -239,44 +237,3 @@ selectDocFacet' _ _ = proc () -> do
         returnA  -< FacetDoc (node_id n1) (node_date n1) (node_hyperdata n1) (isFav) (pgInt4 1)
 
 
-
-
-
-
-
-
-
-
-
-
-
---
---
---selectDocFacet' :: ParentId -> Maybe NodeType -> Query FacetDocRead
---selectDocFacet' parentId _ = proc () -> do
---    node <- (proc () -> do
---
---            -- Favorite Column
---            -- (Node docId docTypeId _ docParentId _ created docHyperdata, (Node _ favTypeId _ favParentId _ _ _, NodeNode _ docId' _))  <- leftJoin3'' -< ()
---            (Node docId docTypeId _ docParentId _ created docHyperdata, (NodeNode _ docId' _, (Node _ favTypeId _ favParentId _ _ _)))  <- leftJoin3''' -< ()
---
---            restrict -< docTypeId .== (pgInt4 15) .&& docParentId .== (toNullable $ pgInt4 parentId)
---            
---            -- select nn.score from nodes n left join nodes_nodes nn on n.id = nn.node2_id where n.typename =4;
---            -- Selecting the documents and joining Favorite Node
---            
---            restrict -< favParentId .== (toNullable $ pgInt4 parentId) .&& favTypeId .== (toNullable 4)
---            
---            -- let docTypeId'' = maybe 0 nodeTypeId (Just Document)
---            
---            -- Getting favorite data
---            let isFav = ifThenElse (isNull docId') (pgBool False) (pgBool True)
---            -- Ngram count by document
---            -- Counting the ngram
---            -- (Node occId occTypeId _ _ _ _ _, NodeNode _ _ _ count) <- nodeNodeNgramLeftJoin -< ()
---            -- restrict -< occId .== 347540
---            
---            --returnA  -< (FacetDoc n_id hyperdata isFav ngramCount)) -< ()
---            returnA  -< (FacetDoc docId created docHyperdata isFav)) -< ()
---    returnA -< node
---