[REFACT] SocialList (WIP)
[gargantext.git] / src / Gargantext / Database / Query / Tree / Root.hs
index 6e4c22e8d2bf3f6008c267fe2262906f576b18a0..0d7abbeccc2d8a2c62288c076aaaf9c3c40225c4 100644 (file)
@@ -12,42 +12,42 @@ Portability : POSIX
 {-# OPTIONS_GHC -fno-warn-orphans        #-}
 
 {-# LANGUAGE Arrows                 #-}
-{-# LANGUAGE DeriveGeneric          #-}
 {-# LANGUAGE ConstraintKinds        #-}
-{-# LANGUAGE FlexibleContexts       #-}
-{-# LANGUAGE FlexibleInstances      #-}
 {-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE MultiParamTypeClasses  #-}
-{-# LANGUAGE NoImplicitPrelude      #-}
-{-# LANGUAGE RankNTypes             #-}
 {-# LANGUAGE TemplateHaskell        #-}
 
 module Gargantext.Database.Query.Tree.Root
   where
 
-import Data.Either (Either, fromLeft, fromRight)
 import Control.Arrow (returnA)
-import Gargantext.Core.Types.Main (CorpusName)
+import Data.Either (Either, fromLeft, fromRight)
 import Gargantext.Core.Types.Individu (User(..))
+import Gargantext.Core.Types.Main (CorpusName)
+import Gargantext.Database.Action.Node
+import Gargantext.Database.Action.User (getUserId, getUsername)
 import Gargantext.Database.Admin.Config (nodeTypeId, userMaster)
-import Gargantext.Database.Query.Table.Node.Error
+import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser)
 import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Prelude (Cmd, runOpaQuery)
 import Gargantext.Database.Query.Table.Node
-import Gargantext.Database.Query.Table.Node.User (HyperdataUser)
-import Gargantext.Database.Action.Flow.Utils (getUserId)
+import Gargantext.Database.Query.Table.Node.Error
+import Gargantext.Database.Query.Table.User (queryUserTable, UserPoly(..))
 import Gargantext.Database.Schema.Node (NodePoly(..), NodeRead)
 import Gargantext.Database.Schema.Node (queryNodeTable)
-import Gargantext.Database.Action.Node
-import Gargantext.Database.Query.Table.User (queryUserTable, UserPoly(..))
-import Gargantext.Database.Admin.Types.Node (Node, NodeType(NodeUser), pgNodeId)
-import Gargantext.Database.Prelude (Cmd, runOpaQuery)
 import Gargantext.Prelude
 import Opaleye (restrict, (.==), Query)
 import Opaleye.PGTypes (pgStrictText, pgInt4)
 
 
+getRootId :: (HasNodeError err) => User -> Cmd err NodeId
+getRootId u = do
+  maybeRoot <- head <$> getRoot u
+  case maybeRoot of
+    Nothing -> nodeError $ NodeError "[G.D.Q.T.R.getRootId] No root id"
+    Just  r -> pure (_node_id r)
+
+getRoot :: User -> Cmd err [Node HyperdataUser]
+getRoot = runOpaQuery . selectRoot
 
 getOrMkRoot :: (HasNodeError err)
             => User
@@ -86,18 +86,14 @@ getOrMk_RootWithCorpus user cName c = do
                   else do
                     c' <- mk (Just $ fromLeft "Default" cName) c rootId userId
                     _tId <- case head c' of
-                              Nothing -> pure [0]
-                              Just c'' -> mkNode NodeTexts c'' userId
+                              Nothing  -> nodeError $ NodeError "[G.D.Q.T.Root.getOrMk...] mk Corpus failed"
+                              Just c'' -> insertDefaultNode NodeTexts c'' userId
                     pure c'
 
   corpusId <- maybe (nodeError NoCorpusFound) pure (head corpusId')
   pure (userId, rootId, corpusId)
 
 
-
-
-
-
 mkRoot :: HasNodeError err
        => User
        -> Cmd err [RootId]
@@ -109,7 +105,7 @@ mkRoot user = do
   uid <- getUserId user
 
   -- TODO ? Which name for user Node ?
-  let una = "username"
+  una <- getUsername user
 
   case uid > 0 of
      False -> nodeError NegativeId
@@ -117,16 +113,13 @@ mkRoot user = do
        rs <- mkNodeWithParent NodeUser Nothing uid una
        _ <- case rs of
          [r] -> do
-           _ <- mkNodeWithParent NodeFolderPrivate (Just r) uid una
-           _ <- mkNodeWithParent NodeFolderShared  (Just r) uid una
-           _ <- mkNodeWithParent NodeFolderPublic  (Just r) uid una
+           _ <- insertNode NodeFolderPrivate Nothing Nothing r uid
+           _ <- insertNode NodeFolderShared Nothing Nothing r uid
+           _ <- insertNode NodeFolderPublic Nothing Nothing r uid
            pure rs
          _   -> pure rs
        pure rs
 
-getRoot :: User -> Cmd err [Node HyperdataUser]
-getRoot = runOpaQuery . selectRoot
-
 selectRoot :: User -> Query NodeRead
 selectRoot (UserName username) = proc () -> do
     row   <- queryNodeTable -< ()
@@ -148,4 +141,4 @@ selectRoot (RootId nid) =
     restrict -< _node_typename row   .== (pgInt4 $ nodeTypeId NodeUser)
     restrict -< _node_id   row   .== (pgNodeId nid)
     returnA  -< row
-
+selectRoot UserPublic = panic {-nodeError $ NodeError-}  "[G.D.Q.T.Root.selectRoot] No root for Public"