[TYPES/Structure Database] Fixing the types for database interaction.

src/Data/Gargantext/Database/Instances.hs

@@ -22,3 +22,5 @@ instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where
 
 instance QueryRunnerColumnDefault PGTimestamptz (Maybe UTCTime) where
   queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+

src/Data/Gargantext/Database/Node.hs

@@ -9,32 +9,38 @@
 
 module Data.Gargantext.Database.Node where
 
-import           Database.PostgreSQL.Simple.FromField (Conversion, ResultError(ConversionFailed), FromField, fromField, returnError)
-import           Database.PostgreSQL.Simple.Internal  (Field)
+import Database.PostgreSQL.Simple.FromField ( Conversion
+                                            , ResultError(ConversionFailed)
+                                            , FromField
+                                            , fromField
+                                            , returnError
+                                            )
+import Database.PostgreSQL.Simple.Internal  (Field)
 import Control.Arrow (returnA)
 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
 import Data.Aeson
 import Data.Gargantext.Database.Private (infoGargandb)
 import Data.Gargantext.Types
 import Data.Maybe (Maybe)
+import Data.Text (Text)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
 import Data.Typeable (Typeable)
 import qualified Data.ByteString.Internal as DBI
 import qualified Database.PostgreSQL.Simple as PGS
 import Opaleye
 
-
 -- | Types for Node Database Management
+data PGTSVector
 
-type NodeWrite = NodePoly  (Maybe (Column PGInt4))        (Column PGInt4)
-                                  (Column PGInt4)         (Column PGInt4)
-                                  (Column PGText)  (Maybe (Column PGTimestamptz))
-                                  (Column PGJsonb)
+type NodeWrite = NodePoly  (Maybe (Column PGInt4))  (Column PGInt4)
+                                  (Column PGInt4)   (Maybe (Column (Nullable PGInt4)))
+                                  (Column (PGText)) (Maybe (Column PGTimestamptz))
+                                  (Column PGJsonb) -- (Maybe (Column PGTSVector))
 
-type NodeRead = NodePoly  (Column PGInt4) (Column PGInt4)
-                          (Column PGInt4) (Column PGInt4)
-                          (Column PGText) (Column PGTimestamptz)
-                          (Column PGJsonb)
+type NodeRead = NodePoly  (Column PGInt4)   (Column PGInt4)
+                          (Column PGInt4)   (Column (Nullable PGInt4))
+                          (Column (PGText)) (Column PGTimestamptz)
+                          (Column PGJsonb) -- (Column PGTSVector)
 
 instance FromField HyperdataCorpus where
     fromField = fromField'
@@ -42,11 +48,11 @@ instance FromField HyperdataCorpus where
 instance FromField HyperdataDocument where
     fromField = fromField'
 
---instance FromField HyperdataProject where
---    fromField = fromField'
+instance FromField HyperdataProject where
+    fromField = fromField'
 
---instance FromField HyperdataUser where
---    fromField = fromField'
+instance FromField HyperdataUser where
+    fromField = fromField'
 
 
 fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DBI.ByteString -> Conversion b
@@ -55,16 +61,30 @@ fromField' field mb = do
     valueToHyperdata v
       where
           valueToHyperdata v = case fromJSON v of
-             Success a -> pure a
+             Success a  -> pure a
              Error _err -> returnError ConversionFailed field "cannot parse hyperdata"
 
 
 instance QueryRunnerColumnDefault PGJsonb HyperdataDocument where
   queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus where
+instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus   where
+  queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+instance QueryRunnerColumnDefault PGJsonb HyperdataProject  where
+  queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+instance QueryRunnerColumnDefault PGJsonb HyperdataUser     where
+  queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+instance QueryRunnerColumnDefault (Nullable PGInt4) Int     where
   queryRunnerColumnDefault = fieldQueryRunnerColumn
 
+instance QueryRunnerColumnDefault (Nullable PGText) Text    where
+  queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+instance QueryRunnerColumnDefault PGInt4 Integer            where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
 
 
 
@@ -73,27 +93,24 @@ $(makeLensesWith abbreviatedFields   ''NodePoly)
 
 
 nodeTable :: Table NodeWrite NodeRead
-nodeTable = Table "nodes" (pNode Node { node_id           = optional "id"
-                                        , node_typename   = required "typename"
-                                        , node_userId     = required "user_id"
-                                        , node_parentId   = required "parent_id"
-                                        , node_name       = required "name"
-                                        , node_date       = optional "date"
-                                        , node_hyperdata  = required "hyperdata"
+nodeTable = Table "nodes" (pNode Node { node_id                = optional "id"
+                                        , node_typename        = required "typename"
+                                        , node_userId          = required "user_id"
+                                        , node_parentId        = optional "parent_id"
+                                        , node_name            = required "name"
+                                        , node_date            = optional "date"
+                                        , node_hyperdata       = required "hyperdata"
+                     --                   , node_titleAbstract   = optional "title_abstract"
                                         }
                             )
 
 
-selectNodes :: Column PGInt4 -> Query (Column PGText)
+selectNodes :: Column PGInt4 -> Query (Column (PGText))
 selectNodes node_id = proc () -> do
-    (Node n_id _tn _u _p n _d _h) <- queryNodeTable -< ()
+    (Node n_id _tn _u _p n _d _h ) <- queryNodeTable -< ()
     restrict -< n_id .== node_id
     returnA -< n
 
-instance QueryRunnerColumnDefault PGInt4 Integer where
-    queryRunnerColumnDefault = fieldQueryRunnerColumn
-
-
 runGetNodes :: PGS.Connection -> Query NodeRead -> IO [Document]
 runGetNodes = runQuery
 
@@ -102,23 +119,35 @@ queryNodeTable :: Query NodeRead
 queryNodeTable = queryTable nodeTable
 
 
-selectNode :: Column PGInt4 -> Query NodeRead
-selectNode node_id = proc () -> do
+selectNodeWithParentID :: Column (Nullable PGInt4) -> Query NodeRead
+selectNodeWithParentID node_id = proc () -> do
     row@(Node _id _tn _u p_id _n _d _h) <- queryNodeTable -< ()
     restrict -< p_id .== node_id
     returnA -< row
 
+selectNodesWithType :: Column PGInt4 -> Query NodeRead
+selectNodesWithType type_id = proc () -> do
+    row@(Node _id _tn _uid p_id n _d _h) <- queryNodeTable -< ()
+    restrict -< _tn .== type_id
+    --let noParent = ifThenElse (isNull nullableBoss) (pgString "no") (pgString "a")
+    --returnA -< Node _id _tn _uid (pgInt4 0) (pgString "") _d _h
+    returnA -< row
+
+getNodesWithType :: Column PGInt4 -> IO [NodeUser]
+getNodesWithType type_id = do
+    conn <- PGS.connect infoGargandb
+    runQuery conn $ selectNodesWithType type_id
 
-getNodes :: Column PGInt4 -> IO [Document]
-getNodes node_id = do
+getNodesWithParentId :: Column (Nullable PGInt4) -> IO [Document]
+getNodesWithParentId node_id = do
     conn <- PGS.connect infoGargandb
-    runQuery conn $ selectNode node_id
+    runQuery conn $ selectNodeWithParentID node_id
 
-getCorpusDocument :: Column PGInt4 -> IO [Document]
+getCorpusDocument :: Column (Nullable PGInt4) -> IO [Document]
 getCorpusDocument node_id = PGS.connect infoGargandb >>=
-                          \conn -> runQuery conn (selectNode node_id)
+                          \conn -> runQuery conn (selectNodeWithParentID node_id)
 
-getProjectCorpora :: Column PGInt4 -> IO [Corpus]
+getProjectCorpora :: Column (Nullable PGInt4) -> IO [Corpus]
 getProjectCorpora node_id = do
     conn <- PGS.connect infoGargandb
-    runQuery conn $ selectNode node_id
+    runQuery conn $ selectNodeWithParentID node_id

src/Data/Gargantext/Database/Private.hs

@@ -5,6 +5,7 @@ module Data.Gargantext.Database.Private where
 import qualified Database.PostgreSQL.Simple as PGS
 
 -- TODO add a reader Monad here
+-- read this in the init file
 infoGargandb :: PGS.ConnectInfo
 infoGargandb =  PGS.ConnectInfo { PGS.connectHost = "127.0.0.1"
                                , PGS.connectPort = 5432

src/Data/Gargantext/Types/Main.hs

@@ -10,7 +10,7 @@ import Protolude (fromMaybe)
 --import Data.ByteString (ByteString())
 import Data.Text (Text)
 import Data.Time (UTCTime)
-import Data.Gargantext.Types.Node ( NodePoly
+import Data.Gargantext.Types.Node ( NodePoly, HyperdataUser
                                , HyperdataFolder   , HyperdataCorpus   , HyperdataDocument
                                , HyperdataFavorites, HyperdataResource
                                , HyperdataList  , HyperdataScore
@@ -35,13 +35,17 @@ type Ngrams = (Text, Text, Text)
 type ErrorMessage = String
 
 
--- All the Database is structred like a hierachical Tree
+-- All the Database is structred like a hierarchical Tree
 data Tree b a = LeafT a | NodeT b [Tree b a]
               deriving (Show, Read, Eq)
 
--- Garg Database Schema Typed as specification
-gargDatabase :: [Tree NodeType NodeType]
-gargDatabase = [userTree]
+-- Garg Network is a network of all Garg nodes
+--gargNetwork = undefined
+
+-- | Garg Node is Database Schema Typed as specification
+-- gargNode gathers all the Nodes of all users on one Node
+gargNode :: [Tree NodeType NodeType]
+gargNode = [userTree]
 
 -- | User Tree simplified
 userTree :: Tree NodeType NodeType
@@ -59,7 +63,6 @@ corpusTree = NodeT Corpus (  [ LeafT Document ]
                           <> [ LeafT Classification]
                           )
 
--- | TODO add Symbolic Node / Document
 --   TODO make instances of Nodes
 data NodeType = NodeUser | Project | Corpus | Document | DocumentCopy
               | Classification
@@ -76,22 +79,20 @@ data Metrics  = Occurrences | Cooccurrences | Specclusion | Genclusion | Cvalue
 
 
 
-
-
-
-
 -- | NodePoly indicates that Node has a Polymorphism Type
-type Node json   = NodePoly NodeId NodeTypeId NodeUserId NodeParentId NodeName UTCTime json
+type Node json   = NodePoly NodeId NodeTypeId NodeUserId NodeParentId NodeName UTCTime json -- NodeVector
 -- type Node json   = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
 type NodeTypeId   = Int
 type NodeId       = Int
 type NodeParentId = Int
 type NodeUserId   = Int
 type NodeName     = Text
+--type NodeVector   = Vector
 
 --type NodeUser    = Node HyperdataUser
 
 -- | Then a Node can be either a Folder or a Corpus or a Document
+type NodeUser = Node HyperdataUser
 type Folder   = Node HyperdataFolder
 type Project  = Folder
 type Corpus   = Node HyperdataCorpus
@@ -115,34 +116,32 @@ type MapList    = List
 type GroupList  = List
 
 -- | Then a Node can be a Score which as some synonyms
---type Score = Node HyperdataScore
---type Occurrences   = Score
---type Cooccurrences = Score
---type Specclusion   = Score
---type Genclusion    = Score
---type Cvalue        = Score
---type Tficf         = Score
+type Score = Node HyperdataScore
+type Occurrences   = Score
+type Cooccurrences = Score
+type Specclusion   = Score
+type Genclusion    = Score
+type Cvalue        = Score
+type Tficf         = Score
 ---- TODO All these Tfidf* will be replaced with TFICF
---type TfidfCorpus   = Tficf
---type TfidfGlobal   = Tficf
---type TirankLocal   = Tficf
---type TirankGlobal  = Tficf
+type TfidfCorpus   = Tficf
+type TfidfGlobal   = Tficf
+type TirankLocal   = Tficf
+type TirankGlobal  = Tficf
 --
 ---- | Then a Node can be either a Graph or a Phylo or a Notebook
---type Graph    = Node HyperdataGraph
---type Phylo    = Node HyperdataPhylo
---type Notebook = Node HyperdataNotebook
-
-
---nodeTypes :: [(NodeType, NodeTypeId)]
---nodeTypes = [
---                --(NodeUser      ,  1)
-----
---             (Project       ,  2)
---            , (NodeSwap     , 19)
---            , (Corpus        ,  3)
---            , (Document      ,  4)
---------  Lists
+type Graph    = Node HyperdataGraph
+type Phylo    = Node HyperdataPhylo
+type Notebook = Node HyperdataNotebook
+
+
+nodeTypes :: [(NodeType, NodeTypeId)]
+nodeTypes = [ (NodeUser      ,  1)
+            , (Project       ,  2)
+            , (Corpus        ,  3)
+            , (Document      ,  4)
+            --, (NodeSwap      , 19)
+------  Lists
 --            , (StopList      ,  5)
 --            , (GroupList     ,  6)
 --            , (MainList      ,  7)
@@ -164,7 +163,7 @@ type GroupList  = List
 ----  Node management
 --            , (Favorites     , 15)
 --
---            ]
-----
---nodeTypeId :: NodeType -> NodeTypeId
---nodeTypeId tn = fromMaybe (error ("Typename " ++ show tn ++ " does not exist")) (lookup tn nodeTypes)
+            ]
+--
+nodeTypeId :: NodeType -> NodeTypeId
+nodeTypeId tn = fromMaybe (error ("Typename " ++ show tn ++ " does not exist")) (lookup tn nodeTypes)

src/Data/Gargantext/Types/Node.hs

@@ -12,12 +12,13 @@ import Data.Aeson.TH (deriveJSON)
 
 data NodePoly id typename userId parentId name date hyperdata = Node { node_id        :: id
                                                                      , node_typename  :: typename
-                                                                     , node_userId:: userId
+                                                                     , node_userId    :: userId
                                                                 --   , nodeHashId    :: hashId
                                                                      , node_parentId  :: parentId
                                                                      , node_name      :: name
                                                                      , node_date      :: date
                                                                      , node_hyperdata :: hyperdata
+                                                              --       , node_titleAbstract :: titleAbstract
                                                                      } deriving (Show)
 
 
@@ -71,11 +72,23 @@ data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_Action       :: Maybe T
 $(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
 
 
+
+data HyperdataUser = HyperdataUser { hyperdataUser_language       :: Maybe Text
+                                       } deriving (Show, Generic)
+$(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
+
+
 data HyperdataFolder = HyperdataFolder { hyperdataFolder_Preferences   :: Maybe Text
                                        } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
 
 
+data HyperdataProject = HyperdataProject { hyperdataProject_Preferences   :: Maybe Text
+                                       } deriving (Show, Generic)
+$(deriveJSON (unPrefix "hyperdataProject_") ''HyperdataProject)
+
+
+
 data HyperdataList = HyperdataList { hyperdataList_Preferences   :: Maybe Text
                                    } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)