[Community] Annuaire added, ok.

package.yaml

@@ -18,9 +18,9 @@ library:
   ghc-options:
   - -Wincomplete-uni-patterns
   - -Wincomplete-record-updates
-  - -Wmissing-signatures
-  - -Wunused-binds
-  - -Wunused-imports
+    #- -Wmissing-signatures
+    #- -Wunused-binds
+    #- -Wunused-imports
     #  - -Werror
   exposed-modules:
   - Gargantext
@@ -143,18 +143,6 @@ executables:
       - optparse-generic
       - unordered-containers
       - full-text-search
-  gargantext-workflow:
-    main: Main.hs
-    source-dirs: app-workflow
-    ghc-options:
-    - -threaded
-    - -rtsopts
-    - -with-rtsopts=-N
-    - -O2
-    - -Wmissing-signatures
-    dependencies:
-    - base
-    - gargantext
 
 tests:
   garg-test:

src/Gargantext/Core/Types/Main.hs

@@ -118,9 +118,11 @@ type Notebook = Node HyperdataNotebook
 
 nodeTypes :: [(NodeType, NodeTypeId)]
 nodeTypes = [ (NodeUser      ,  1)
-            , (Project       ,  2)
-            , (Corpus        ,  3)
-            , (Document      ,  4)
+            , (Folder        ,  2)
+            , (Corpus        ,  30)
+            , (Annuaire      ,  31)
+            , (Document      ,  40)
+            , (UserPage      ,  41)
             --, (NodeSwap      , 19)
 ------  Lists
 --            , (StopList      ,  5)

src/Gargantext/Core/Types/Node.hs

@@ -236,7 +236,7 @@ type Corpus   = Node HyperdataCorpus
 type Document = Node HyperdataDocument
 
 ------------------------------------------------------------------------
-data NodeType = NodeUser | Project | Corpus | Document | DocumentCopy
+data NodeType = NodeUser | Project | Folder | Corpus | Annuaire | Document | UserPage | DocumentCopy
               | Classification
               | Lists
               | Metrics | Occurrences

src/Gargantext/Database.hs

@@ -63,6 +63,7 @@ module Gargantext.Database ( module Gargantext.Database.Utils
                            , post, post'
                            , del , del'
                            , tree, tree'
+                           , postCorpus, postAnnuaire
                            )
     where
 
@@ -72,7 +73,7 @@ import Gargantext.Database.Utils (connectGargandb)
 import Gargantext.Database.Node
 import Gargantext.Prelude
 import Database.PostgreSQL.Simple (Connection)
-import Data.Text (Text)
+import Data.Text (Text, pack)
 import Opaleye hiding (FromField)
 import Data.Aeson
 import Data.ByteString (ByteString)
@@ -160,12 +161,36 @@ post'  = do
   c   <- connectGargandb "gargantext.ini"
   pid <- last <$> home c
   let uid = 1
-  postNode c uid pid (Node' Corpus  "Premier corpus" "{}" [ Node' Document "Doc1" "{}" []
-                                                          , Node' Document "Doc2" "{}" []
-                                                          , Node' Document "Doc3" "{}" []
+  postNode c uid pid ( Node' Corpus  (pack "Premier corpus") (toJSON ("{}"::Text)) [ Node' Document (pack "Doc1") (toJSON ("{}" :: Text)) []
+                                                          , Node' Document (pack "Doc2") (toJSON (pack "{}" :: Text)) []
+                                                          , Node' Document (pack "Doc3") (toJSON ("{}" :: Text)) []
                                                           ]
                      )
 
+type CorpusName = Text
+
+postCorpus :: ToJSON a => CorpusName -> (a -> Text) -> [a] -> IO [Int]
+postCorpus corpusName title ns = do
+  c   <- connectGargandb "gargantext.ini"
+  pid <- last <$> home c
+  let uid = 1
+  postNode c uid pid ( Node' Corpus  corpusName (toJSON ("{}"::Text))
+                             (map (\n -> Node' Document (title n) (toJSON n) []) ns)
+                     )
+
+-- | 
+-- import IMTClient as C
+-- postAnnuaire "Annuaire IMT" (\n -> (maybe "" identity (C.prenom n)) <> " " <> (maybe "" identity (C.nom n))) (take 30 annuaire)
+postAnnuaire :: ToJSON a => CorpusName -> (a -> Text) -> [a] -> IO [Int]
+postAnnuaire corpusName title ns = do
+  c   <- connectGargandb "gargantext.ini"
+  pid <- last <$> home c
+  let uid = 1
+  postNode c uid pid ( Node' Annuaire  corpusName (toJSON ("{}"::Text))
+                             (map (\n -> Node' UserPage (title n) (toJSON n) []) ns)
+                     )
+
+
 
 del' :: [NodeId] -> IO Int
 del' ns = do

src/Gargantext/Database/Node.hs

@@ -45,7 +45,7 @@ import Control.Arrow (returnA)
 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
 import Data.Aeson
 import Data.Maybe (Maybe, fromMaybe)
-import Data.Text (Text)
+import Data.Text (Text, pack)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
 import Data.Typeable (Typeable)
 
@@ -288,7 +288,7 @@ post c uid pid [ Node' Corpus "name" "{}" []
 node2table :: UserId -> ParentId -> Node' -> [NodeWriteT]
 node2table uid pid (Node' nt txt v []) = [( Nothing, (pgInt4$ nodeTypeId nt), (pgInt4 uid), (pgInt4 pid)
                                          , pgStrictText txt, Nothing, pgStrictJSONB $ DB.pack $ DBL.unpack $ encode v)]
-node2table _ _ (Node' _ _ _ _) = panic "node2table: should not happen, Tree insert not implemented yet"
+node2table _ _ (Node' _ _ _ _) = panic $ pack "node2table: should not happen, Tree insert not implemented yet"
 
 
 data Node' = Node' { _n_type :: NodeType
@@ -318,7 +318,11 @@ postNode c uid pid (Node' Corpus txt v ns) = do
   [pid']  <- postNode c uid pid (Node' Corpus txt v [])
   pids    <- mkNodeR' c $ concat $ (map (\(Node' Document txt v _) -> node2table uid pid' $ Node' Document txt v []) ns)
   pure (pids)
-postNode c uid pid (Node' _ _ _ _) = panic "postNode for this type not implemented yet"
+postNode c uid pid (Node' Annuaire txt v ns) = do
+  [pid']  <- postNode c uid pid (Node' Annuaire txt v [])
+  pids    <- mkNodeR' c $ concat $ (map (\(Node' UserPage txt v _) -> node2table uid pid' $ Node' UserPage txt v []) ns)
+  pure (pids)
+postNode c uid pid (Node' _ _ _ _) = panic $ pack "postNode for this type not implemented yet"