[FIX] Order 1 and Order 2, node size ok.
[gargantext.git] / src / Gargantext / Database / Schema / Node.hs
index 724b9a4e255b53ae20b8fba8a2838eb174d4e893..8093126a4be5920c7dafe3cd4a768a96ee63e1c0 100644 (file)
@@ -8,602 +8,171 @@ Stability   : experimental
 Portability : POSIX
 -}
 
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+
 {-# 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 TemplateHaskell        #-}
+{-# LANGUAGE TypeFamilies           #-}
 
 module Gargantext.Database.Schema.Node where
 
-import Control.Applicative (Applicative)
-import Control.Arrow (returnA)
-import Control.Lens (set)
-import Control.Lens.TH (makeLensesWith, abbreviatedFields)
-import Control.Monad.IO.Class
-import Control.Monad.Reader
-import Data.Aeson
-import Data.ByteString (ByteString)
-import Data.Maybe (Maybe(..), fromMaybe)
-import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
-import Data.Text (Text, unpack, pack)
-import Data.Time (UTCTime)
-import Database.PostgreSQL.Simple (Connection)
-import Database.PostgreSQL.Simple.FromField (FromField, fromField)
-import GHC.Int (Int64)
-import Gargantext.Core (Lang(..))
-import Gargantext.Core.Types
-import Gargantext.Core.Types.Individu (Username)
-import Gargantext.Core.Types.Main (UserId)
-import Gargantext.Database.Config (nodeTypeId)
-import Gargantext.Database.Queries.Filter (limit', offset')
-import Gargantext.Database.Types.Node (NodeType, defaultCorpus, Hyperdata)
-import Gargantext.Database.Utils (fromField')
-import Gargantext.Prelude hiding (sum, head)
-import Opaleye hiding (FromField)
-import Opaleye.Internal.QueryArr (Query)
+import Control.Lens hiding (elements, (&))
+import Gargantext.Database.Schema.Prelude
 import Prelude hiding (null, id, map, sum)
-import qualified Data.ByteString      as DB
-import qualified Data.ByteString.Lazy as DBL
-import qualified Data.Profunctor.Product as PP
-
-------------------------------------------------------------------------
-------------------------------------------------------------------------
-{- | Reader Monad reinvented here:
-
-newtype Cmd a = Cmd { unCmd :: Connection -> IO a }
-
-instance Monad Cmd where
-  return a = Cmd $ \_ -> return a
-
-  m >>= f = Cmd $ \c -> do
-    a <- unCmd m c
-    unCmd (f a) c
--}
-newtype Cmd a = Cmd (ReaderT Connection IO a)
-  deriving (Functor, Applicative, Monad, MonadReader Connection, MonadIO)
-
-runCmd :: Connection -> Cmd a -> IO a
-runCmd c (Cmd f) = runReaderT f c
 
-mkCmd :: (Connection -> IO a) -> Cmd a
-mkCmd = Cmd . ReaderT
-
-------------------------------------------------------------------------
 ------------------------------------------------------------------------
-instance FromField HyperdataAny
-  where
-    fromField = fromField'
-
-instance FromField HyperdataCorpus
-  where
-    fromField = fromField'
+-- Main polymorphic Node definition
+data NodePoly id
+              hash_id
+              typename
+              user_id
+              parent_id
+              name
+              date
+              hyperdata  =
+     Node { _node_id        :: !id
+          , _node_hash_id   :: !hash_id
+          , _node_typename  :: !typename
 
-instance FromField HyperdataDocument
-  where
-    fromField = fromField'
+          , _node_user_id    :: !user_id
+          , _node_parent_id  :: !parent_id
 
-instance FromField HyperdataDocumentV3
-  where
-    fromField = fromField'
+          , _node_name      :: !name
+          , _node_date      :: !date
 
-instance FromField HyperdataUser
-  where
-    fromField = fromField'
+          , _node_hyperdata :: !hyperdata
+          } deriving (Show, Generic)
 
-instance FromField HyperdataList
-  where
-    fromField = fromField'
-
-instance FromField HyperdataAnnuaire
-  where
-    fromField = fromField'
 ------------------------------------------------------------------------
-instance QueryRunnerColumnDefault PGJsonb HyperdataAny
-  where
-    queryRunnerColumnDefault = fieldQueryRunnerColumn
-
-instance QueryRunnerColumnDefault PGJsonb HyperdataDocument
-  where
-    queryRunnerColumnDefault = fieldQueryRunnerColumn
-
-instance QueryRunnerColumnDefault PGJsonb HyperdataDocumentV3
-  where
-    queryRunnerColumnDefault = fieldQueryRunnerColumn
-
-instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus
-  where
-    queryRunnerColumnDefault = fieldQueryRunnerColumn
-
-instance QueryRunnerColumnDefault PGJsonb HyperdataUser
-  where
-    queryRunnerColumnDefault = fieldQueryRunnerColumn
-
-instance QueryRunnerColumnDefault PGJsonb HyperdataList
-  where
-    queryRunnerColumnDefault = fieldQueryRunnerColumn
+-- Automatic instances derivation
+$(deriveJSON (unPrefix "_node_") ''NodePoly)
+$(makeLenses ''NodePoly)
 
-instance QueryRunnerColumnDefault PGJsonb HyperdataAnnuaire
-  where
-    queryRunnerColumnDefault = fieldQueryRunnerColumn
-
-instance QueryRunnerColumnDefault PGTSVector (Maybe TSVector)
-  where
-    queryRunnerColumnDefault = fieldQueryRunnerColumn
-
-
-------------------------------------------------------------------------
-
--- WIP
--- TODO Classe HasDefault where
--- default NodeType = Hyperdata
-------------------------------------------------------------------------
-$(makeAdaptorAndInstance "pNode" ''NodePoly)
+$(makeAdaptorAndInstance "pNode"   ''NodePoly)
 $(makeLensesWith abbreviatedFields ''NodePoly)
-type NodeWrite' = NodePoly (Maybe Int) Int Int (Maybe ParentId) Text (Maybe UTCTime) ByteString (Maybe TSVector)
-
-
-type NodeWrite = NodePoly  (Maybe (Column  PGInt4              ))
-                                  (Column  PGInt4               )
-                                  (Column  PGInt4               )
-                                  (Column (Nullable PGInt4     ))
-                                  (Column (PGText              ))
-                                  (Maybe  (Column PGTimestamptz))
-                                  (Column  PGJsonb              )
-                                  (Maybe (Column PGTSVector))
-
-type NodeRead = NodePoly  (Column  PGInt4           )
-                          (Column  PGInt4           )
-                          (Column  PGInt4           )
-                          (Column (Nullable PGInt4 ))
-                          (Column (PGText          ))
-                          (Column PGTimestamptz     )
-                          (Column PGJsonb) 
-                          (Column PGTSVector)
-
-
-type NodeReadNull = NodePoly  (Column  (Nullable PGInt4           ))
-                              (Column  (Nullable PGInt4           ))
-                              (Column  (Nullable PGInt4           ))
-                              (Column (Nullable PGInt4 ))
-                              (Column (Nullable PGText          ))
-                              (Column (Nullable PGTimestamptz     ))
-                              (Column (Nullable PGJsonb))
-                              (Column (Nullable PGTSVector))
-
 
 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"
-                                      , _node_search     = optional "search"
-                                      }
-                            )
-{-
-nodeTableSearch :: Table NodeWriteSearch NodeReadSearch
-nodeTableSearch = 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"
-                                      , _node_search     = optional "search"
-                                      }
-                            )
---}
+nodeTable = Table "nodes" (pNode Node { _node_id         = optionalTableField "id"
+                                      , _node_hash_id    = optionalTableField "hash_id"
+                                      , _node_typename   = requiredTableField "typename"
+                                      , _node_user_id    = requiredTableField "user_id"
 
-nodeTable' :: Table (Maybe (Column PGInt4)
-                    ,       Column PGInt4
-                    ,       Column PGInt4
-                    ,Maybe (Column PGInt4)
-                    ,       Column PGText
-                    ,Maybe (Column PGTimestamptz)
-                    ,       Column PGJsonb
-                    ,Maybe (Column PGTSVector)
-                    )
-                    ((Column PGInt4)
-                    ,       Column PGInt4
-                    ,       Column PGInt4
-                    ,       Column PGInt4
-                    ,       Column PGText
-                    ,(Column PGTimestamptz)
-                    ,       Column PGJsonb
-                    ,       Column PGTSVector
-                    )
+                                      , _node_parent_id  = optionalTableField "parent_id"
+                                      , _node_name       = requiredTableField "name"
+                                      , _node_date       = optionalTableField "date"
 
-nodeTable' = Table "nodes" (PP.p8 ( optional "id"
-                               , required "typename"
-                               , required "user_id"
-                               
-                               , optional "parent_id"
-                               , required "name"
-                               , optional "date"
-                               
-                               , required "hyperdata"
-                               , optional "search"
-                               )
+                                      , _node_hyperdata  = requiredTableField "hyperdata"
+                                      -- ignoring ts_vector field here
+                                      }
                             )
 
-
 queryNodeTable :: Query NodeRead
-queryNodeTable = queryTable nodeTable
-
-{-
-queryNodeTableSearch :: Query NodeReadSearch
-queryNodeTableSearch = queryTable nodeTableSearch
--}
-
-
-selectNode :: Column PGInt4 -> Query NodeRead
-selectNode id = proc () -> do
-    row <- queryNodeTable -< ()
-    restrict -< _node_id row .== id
-    returnA -< row
-
-
-runGetNodes :: Query NodeRead -> Cmd [NodeAny]
-runGetNodes q = mkCmd $ \conn -> runQuery conn q
-
-------------------------------------------------------------------------
-------------------------------------------------------------------------
-
--- | order by publication date
--- Favorites (Bool), node_ngrams
-selectNodesWith :: ParentId     -> Maybe NodeType
-                -> Maybe Offset -> Maybe Limit   -> Query NodeRead
-selectNodesWith parentId maybeNodeType maybeOffset maybeLimit = 
-        --offset' maybeOffset $ limit' maybeLimit $ orderBy (asc (hyperdataDocument_Publication_date . node_hyperdata)) $ selectNodesWith' parentId typeId
-  limit' maybeLimit $ offset' maybeOffset
-                    $ orderBy (asc _node_id)
-                    $ selectNodesWith' parentId maybeNodeType
-
-selectNodesWith' :: ParentId -> Maybe NodeType -> Query NodeRead
-selectNodesWith' parentId maybeNodeType = proc () -> do
-    node <- (proc () -> do
-      row@(Node _ typeId _ parentId' _ _ _ _) <- queryNodeTable -< ()
-      restrict -< parentId' .== (toNullable $ pgInt4 parentId)
-
-      let typeId' = maybe 0 nodeTypeId maybeNodeType
-
-      restrict -< if typeId' > 0
-                     then typeId   .== (pgInt4 (typeId' :: Int))
-                     else (pgBool True)
-      returnA  -< row ) -< ()
-    returnA -< node
-
-
---type Cmd' a = forall m. (MonadReader env m, HasConnection env, MonadIO m) => m a
-
-
--- deleteNode :: (MonadReader Connection m, MonadIO m) => Int -> m Int
--- deleteNode :: Int -> Cmd' Int
-
-deleteNode :: Int -> Cmd Int
-deleteNode n = mkCmd $ \conn ->
-  fromIntegral <$> runDelete conn nodeTable
-                 (\(Node n_id _ _ _ _ _ _ _) -> n_id .== pgInt4 n)
-
-deleteNodes :: [Int] -> Cmd Int
-deleteNodes ns = mkCmd $ \conn ->
-  fromIntegral <$> runDelete conn nodeTable
-                   (\(Node n_id _ _ _ _ _ _ _) -> in_ ((map pgInt4 ns)) n_id)
-
-
-getNodesWith :: JSONB a => Connection -> Int -> proxy a -> Maybe NodeType
-             -> Maybe Offset -> Maybe Limit -> IO [Node a]
-getNodesWith conn parentId _ nodeType maybeOffset maybeLimit =
-    runQuery conn $ selectNodesWith parentId nodeType maybeOffset maybeLimit
-
-
--- NP check type
-getNodesWithParentId :: Int
-                     -> Maybe Text -> Connection -> IO [NodeAny]
-getNodesWithParentId n _ conn = runQuery conn $ selectNodesWithParentID n
-
-getNodesWithParentId' :: Int
-                     -> Maybe Text -> Connection -> IO [NodeAny]
-getNodesWithParentId' n _ conn = runQuery conn $ selectNodesWithParentID n
-
-
-------------------------------------------------------------------------
-getDocumentsV3WithParentId :: Connection -> Int -> IO [Node HyperdataDocumentV3]
-getDocumentsV3WithParentId conn n = runQuery conn $ selectNodesWith' n (Just NodeDocument)
-
-getDocumentsWithParentId :: Connection -> Int -> IO [Node HyperdataDocument]
-getDocumentsWithParentId conn n = runQuery conn $ selectNodesWith' n (Just NodeDocument)
-
-getListsWithParentId :: Connection -> Int -> IO [Node HyperdataList]
-getListsWithParentId conn n = runQuery conn $ selectNodesWith' n (Just NodeList)
-
-getCorporaWithParentId :: Connection -> Int -> IO [Node HyperdataCorpus]
-getCorporaWithParentId conn n = runQuery conn $ selectNodesWith' n (Just NodeCorpus)
-
-getCorporaWithParentId' :: Int -> Cmd [Node HyperdataCorpus]
-getCorporaWithParentId' n = mkCmd $ \conn -> runQuery conn $ selectNodesWith' n (Just NodeCorpus)
-
-
+queryNodeTable = selectTable nodeTable
+------------------------------------------------------------------------
+type NodeWrite = NodePoly (Maybe (Column PGInt4)      )
+                          (Maybe (Column PGText)      )
+                                 (Column PGInt4)
+                                 (Column PGInt4)
+                          (Maybe (Column PGInt4)      )
+                                 (Column PGText)
+                          (Maybe (Column PGTimestamptz))
+                                 (Column PGJsonb)
+
+type NodeRead = NodePoly (Column PGInt4        )
+                         (Column PGText        )
+                         (Column PGInt4        )
+                         (Column PGInt4        )
+                         (Column PGInt4        )
+                         (Column PGText        )
+                         (Column PGTimestamptz )
+                         (Column PGJsonb       )
+
+type NodeReadNull = NodePoly (Column (Nullable PGInt4))
+                             (Column (Nullable PGText))
+                             (Column (Nullable PGInt4))
+                             (Column (Nullable PGInt4))
+                             (Column (Nullable PGInt4))
+                             (Column (Nullable PGText))
+                             (Column (Nullable PGTimestamptz))
+                             (Column (Nullable PGJsonb))
+------------------------------------------------------------------------
+-- | Node(Read|Write)Search is slower than Node(Write|Read) use it
+-- for full text search only
+
+type NodeSearchWrite =
+  NodePolySearch
+    (Maybe  (Column  PGInt4)      )
+    (Column  PGInt4               )
+    (Column  PGInt4               )
+    (Column (Nullable PGInt4)     )
+    (Column PGText                )
+    (Maybe  (Column PGTimestamptz))
+    (Column  PGJsonb              )
+    (Maybe  (Column PGTSVector)   )
+
+type NodeSearchRead =
+  NodePolySearch
+    (Column  PGInt4           )
+    (Column  PGInt4           )
+    (Column  PGInt4           )
+    (Column (Nullable PGInt4 ))
+    (Column  PGText           )
+    (Column  PGTimestamptz    )
+    (Column  PGJsonb          )
+    (Column  PGTSVector       )
+
+type NodeSearchReadNull =
+  NodePolySearch
+    (Column (Nullable PGInt4)       )
+    (Column (Nullable PGInt4)       )
+    (Column (Nullable PGInt4)       )
+    (Column (Nullable PGInt4)       )
+    (Column (Nullable PGText)       )
+    (Column (Nullable PGTimestamptz))
+    (Column (Nullable PGJsonb)      )
+    (Column (Nullable PGTSVector)   )
+
+
+data NodePolySearch id
+                    typename
+                    user_id
+                    parent_id
+                    name
+                    date
+                    hyperdata
+                    search =
+     NodeSearch { _ns_id           :: id
+                , _ns_typename     :: typename
+                , _ns_user_id      :: user_id
+           --   , nodeUniqId       :: shaId
+                , _ns_parent_id    :: parent_id
+                , _ns_name         :: name
+                , _ns_date         :: date
+
+                , _ns_hyperdata    :: hyperdata
+                , _ns_search       :: search
+                } deriving (Show, Generic)
+
+$(makeAdaptorAndInstance "pNodeSearch" ''NodePolySearch)
+$(makeLensesWith abbreviatedFields ''NodePolySearch)
+$(deriveJSON (unPrefix "_ns_")     ''NodePolySearch)
+$(makeLenses ''NodePolySearch)
+
+nodeTableSearch :: Table NodeSearchWrite NodeSearchRead
+nodeTableSearch = Table "nodes" ( pNodeSearch
+                                   NodeSearch { _ns_id           = optionalTableField "id"
+                                              , _ns_typename     = requiredTableField "typename"
+                                              , _ns_user_id      = requiredTableField "user_id"
+
+                                              , _ns_parent_id    = requiredTableField "parent_id"
+                                              , _ns_name         = requiredTableField "name"
+                                              , _ns_date         = optionalTableField "date"
+
+                                              , _ns_hyperdata    = requiredTableField "hyperdata"
+                                              , _ns_search       = optionalTableField "search"
+                                              }
+                                )
 ------------------------------------------------------------------------
-selectNodesWithParentID :: Int -> Query NodeRead
-selectNodesWithParentID n = proc () -> do
-    row@(Node _ _ _ parent_id _ _ _ _) <- queryNodeTable -< ()
-    restrict -< if n > 0
-      then parent_id .== (toNullable $ pgInt4 n)
-      else isNull parent_id
-    returnA -< row
-
-selectNodesWithType :: Column PGInt4 -> Query NodeRead
-selectNodesWithType type_id = proc () -> do
-    row@(Node _ tn _ _ _ _ _ _) <- queryNodeTable -< ()
-    restrict -< tn .== type_id
-    returnA -< row
-
-type JSONB = QueryRunnerColumnDefault PGJsonb
-
-getNode :: JSONB a => Connection -> Int -> proxy a -> IO (Node a)
-getNode conn id _ = do
-    fromMaybe (error $ "Node does node exist: " <> show id) . headMay <$> runQuery conn (limit 1 $ selectNode (pgInt4 id))
-
-getNodesWithType :: Connection -> Column PGInt4 -> IO [Node HyperdataDocument]
-getNodesWithType conn type_id = do
-    runQuery conn $ selectNodesWithType type_id
-
-------------------------------------------------------------------------
-
-------------------------------------------------------------------------
-defaultUser :: HyperdataUser
-defaultUser = HyperdataUser (Just $ (pack . show) EN)
-
-nodeUserW :: Maybe Name -> Maybe HyperdataUser -> UserId -> NodeWrite'
-nodeUserW maybeName maybeHyperdata = node NodeUser name user Nothing
-  where
-    name = maybe "User" identity maybeName
-    user = maybe defaultUser identity maybeHyperdata
-------------------------------------------------------------------------
-defaultFolder :: HyperdataFolder
-defaultFolder = HyperdataFolder (Just "Markdown Description")
-
-nodeFolderW :: Maybe Name -> Maybe HyperdataFolder -> ParentId -> UserId -> NodeWrite'
-nodeFolderW maybeName maybeFolder pid = node NodeFolder name folder (Just pid)
-  where
-    name   = maybe "Folder" identity maybeName
-    folder = maybe defaultFolder identity maybeFolder
-------------------------------------------------------------------------
-nodeCorpusW :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> NodeWrite'
-nodeCorpusW maybeName maybeCorpus pId = node NodeCorpus name corpus (Just pId)
-  where
-    name   = maybe "Corpus" identity maybeName
-    corpus = maybe defaultCorpus identity maybeCorpus
-                   --------------------------
-defaultDocument :: HyperdataDocument
-defaultDocument = hyperdataDocument
-
-nodeDocumentW :: Maybe Name -> Maybe HyperdataDocument -> CorpusId -> UserId -> NodeWrite'
-nodeDocumentW maybeName maybeDocument cId = node NodeDocument name doc (Just cId)
-  where
-    name = maybe "Document" identity maybeName
-    doc  = maybe defaultDocument identity maybeDocument
-------------------------------------------------------------------------
-defaultAnnuaire :: HyperdataAnnuaire
-defaultAnnuaire = HyperdataAnnuaire (Just "Title") (Just "Description")
-
-nodeAnnuaireW :: Maybe Name -> Maybe HyperdataAnnuaire -> ParentId -> UserId -> NodeWrite'
-nodeAnnuaireW maybeName maybeAnnuaire pId = node NodeAnnuaire name annuaire (Just pId)
-  where
-    name     = maybe "Annuaire" identity maybeName
-    annuaire = maybe defaultAnnuaire identity maybeAnnuaire
-                   --------------------------
-
-------------------------------------------------------------------------
-arbitraryList :: HyperdataList
-arbitraryList = HyperdataList (Just "Preferences")
-
-nodeListW :: Maybe Name -> Maybe HyperdataList -> ParentId -> UserId -> NodeWrite'
-nodeListW maybeName maybeList pId = node NodeList name list (Just pId)
-  where
-    name = maybe "Listes" identity maybeName
-    list = maybe arbitraryList identity maybeList
-
-------------------------------------------------------------------------
-arbitraryGraph :: HyperdataGraph
-arbitraryGraph = HyperdataGraph (Just "Preferences")
-
-nodeGraphW :: Maybe Name -> Maybe HyperdataGraph -> ParentId -> UserId -> NodeWrite'
-nodeGraphW maybeName maybeGraph pId = node NodeGraph name graph (Just pId)
-  where
-    name = maybe "Graph" identity maybeName
-    graph = maybe arbitraryGraph identity maybeGraph
-
-------------------------------------------------------------------------
-
-arbitraryDashboard :: HyperdataDashboard
-arbitraryDashboard = HyperdataDashboard (Just "Preferences")
-
-nodeDashboardW :: Maybe Name -> Maybe HyperdataDashboard -> ParentId -> UserId -> NodeWrite'
-nodeDashboardW maybeName maybeDashboard pId = node NodeDashboard name dashboard (Just pId)
-  where
-    name = maybe "Dashboard" identity maybeName
-    dashboard = maybe arbitraryDashboard identity maybeDashboard
-
-
-
-------------------------------------------------------------------------
-node :: (ToJSON a, Hyperdata a) => NodeType -> Name -> a -> Maybe ParentId -> UserId -> NodeWrite'
-node nodeType name hyperData parentId userId = Node Nothing typeId userId parentId name Nothing byteData Nothing
-  where
-    typeId = nodeTypeId nodeType
-    byteData = DB.pack . DBL.unpack $ encode hyperData
-
-                  -------------------------------
-node2row :: (Functor maybe1, Functor maybe2, Functor maybe3, Functor maybe4) =>
-              NodePoly (maybe1 Int) Int  Int
-                       (maybe2 Int) Text (maybe3 UTCTime)
-                       ByteString   (maybe4 TSVector)
-                    -> ( maybe1 (Column PGInt4), Column PGInt4, Column PGInt4
-                       , maybe2 (Column PGInt4), Column PGText, maybe3 (Column PGTimestamptz)
-                     , Column PGJsonb, maybe4 (Column PGTSVector))
-node2row (Node id tn ud pid nm dt hp tv) = ((pgInt4       <$> id)
-                                           ,(pgInt4           tn)
-                                           ,(pgInt4           ud)
-                                           
-                                           ,(pgInt4       <$> pid)
-                                           ,(pgStrictText     nm)
-                                           ,(pgUTCTime    <$> dt)
-                                           
-                                           ,(pgStrictJSONB    hp)
-                                           ,(pgTSVector . unpack  <$> tv)
-                                           )
-------------------------------------------------------------------------
-insertNodesR' :: [NodeWrite'] -> Cmd [Int]
-insertNodesR' ns = mkCmd $ \c -> insertNodesR ns c
-
-insertNodes :: [NodeWrite'] -> Connection -> IO Int64
-insertNodes ns conn = runInsertMany conn nodeTable' (map node2row ns)
-
-insertNodesR :: [NodeWrite'] -> Connection -> IO [Int]
-insertNodesR ns conn = runInsertManyReturning conn nodeTable' (map node2row ns) (\(i,_,_,_,_,_,_,_) -> i)
-                       -------------------------
-insertNodesWithParent :: Maybe ParentId -> [NodeWrite'] -> Connection -> IO Int64
-insertNodesWithParent pid ns conn = insertNodes (map (set node_parentId pid) ns) conn
-
-insertNodesWithParentR :: Maybe ParentId -> [NodeWrite'] -> Connection -> IO [Int]
-insertNodesWithParentR pid ns conn = insertNodesR (map (set node_parentId pid) ns) conn
-------------------------------------------------------------------------
--- TODO Hierachy of Nodes
--- post and get same types Node' and update if changes
-
-{- TODO semantic to achieve
-post c uid pid [ Node' NodeCorpus "name" "{}" []
-               , Node' NodeFolder "name" "{}" [Node' NodeCorpus "test 2" "" [ Node' NodeDocument "title" "metaData" []
-                                                                    , Node' NodeDocument "title" "jsonData" []
-                                                                    ]
-                                          ]
-               ]
--}
-------------------------------------------------------------------------
-
--- TODO
--- currently this function remove the child relation
--- needs a Temporary type between Node' and NodeWriteT
-node2table :: UserId -> Maybe ParentId -> Node' -> NodeWriteT
-node2table uid pid (Node' nt txt v []) = ( Nothing, (pgInt4$ nodeTypeId nt), (pgInt4 uid), (fmap pgInt4 pid)
-                                         , pgStrictText txt, Nothing, pgStrictJSONB $ DB.pack $ DBL.unpack $ encode v, Nothing)
-node2table _ _ (Node' _ _ _ _) = panic "node2table: should not happen, Tree insert not implemented yet"
-
-
-data Node' = Node' { _n_type :: NodeType
-                   , _n_name :: Text
-                   , _n_data :: Value
-                   , _n_children :: [Node']
-                   } deriving (Show)
-
-
-type NodeWriteT =  ( Maybe (Column PGInt4)
-                   ,        Column PGInt4
-                   ,        Column PGInt4
-                   , Maybe (Column PGInt4)
-                   ,        Column PGText
-                   , Maybe (Column PGTimestamptz)
-                   ,        Column PGJsonb
-                   , Maybe (Column PGTSVector)
-                   )
-
-
-mkNode' :: [NodeWriteT] -> Cmd Int64
-mkNode' ns = mkCmd $ \conn -> runInsertMany conn nodeTable' ns
-
-mkNodeR' :: [NodeWriteT] -> Cmd [Int]
-mkNodeR' ns = mkCmd $ \conn -> runInsertManyReturning conn nodeTable' ns (\(i,_,_,_,_,_,_,_) -> i)
-
-------------------------------------------------------------------------
-
-data NewNode = NewNode { _newNodeId :: Int
-                       , _newNodeChildren :: [Int] }
-
--- | postNode
-postNode :: UserId -> Maybe ParentId -> Node' -> Cmd NewNode
-postNode uid pid (Node' nt txt v []) = do
-  pids <- mkNodeR' [node2table uid pid (Node' nt txt v [])]
-  case pids of
-    [pid] -> pure $ NewNode pid []
-    _ -> panic "postNode: only one pid expected"
-
-postNode uid pid (Node' NodeCorpus txt v ns) = do
-  NewNode pid' _ <- postNode uid pid (Node' NodeCorpus txt v [])
-  pids  <- mkNodeR' (concat $ map (\n -> [childWith uid pid' n]) ns)
-  pure $ NewNode pid' pids
-
-postNode uid pid (Node' NodeAnnuaire txt v ns) = do
-  NewNode pid' _ <- postNode uid pid (Node' NodeAnnuaire txt v [])
-  pids  <- mkNodeR' (concat $ map (\n -> [childWith uid pid' n]) ns)
-  pure $ NewNode pid' pids
-postNode _ _ (Node' _ _ _ _) = panic "TODO: postNode for this type not implemented yet"
-
-
-childWith :: UserId -> ParentId -> Node' -> NodeWriteT
-childWith uId pId (Node' NodeDocument txt v []) = node2table uId (Just pId) (Node' NodeDocument txt v [])
-childWith uId pId (Node' NodeContact  txt v []) = node2table uId (Just pId) (Node' NodeContact txt v [])
-childWith _   _   (Node' _        _   _ _) = panic "This NodeType can not be a child"
-
-
--- TODO: remove hardcoded userId (with Reader)
--- TODO: user Reader in the API and adapt this function
-userId :: Int
-userId = 1
-
-mk :: Connection -> NodeType -> Maybe ParentId -> Text -> IO [Int]
-mk c nt pId name  = mk' c nt userId pId name
-
-mk' :: Connection -> NodeType -> UserId -> Maybe ParentId -> Text -> IO [Int]
-mk' c nt uId pId name  = map fromIntegral <$> insertNodesWithParentR pId [node nt name hd pId uId] c
-  where
-    hd = HyperdataUser . Just . pack $ show EN
-
-type Name = Text
-
-mk'' :: NodeType -> Maybe ParentId -> UserId -> Name -> Cmd [Int]
-mk'' NodeUser Nothing uId name  = mkCmd $ \c -> mk' c NodeUser uId Nothing name
-mk'' NodeUser _       _   _     = panic "NodeUser do not have any parent"
-mk'' _        Nothing _   _     = panic "NodeType does   have a   parent"
-mk'' nt       pId     uId name  = mkCmd $ \c -> mk' c nt uId pId name
-
-
-mkRoot :: Username -> UserId -> Cmd [Int]
-mkRoot uname uId = case uId > 0 of
-               False -> panic "UserId <= 0"
-               True  -> mk'' NodeUser Nothing uId uname
-
-mkCorpus :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> Cmd [Int]
-mkCorpus n h p u = insertNodesR' [nodeCorpusW n h p u]
-
-mkList :: ParentId -> UserId -> Cmd [Int]
-mkList p u = insertNodesR' [nodeListW Nothing Nothing p u]
-
-mkGraph :: ParentId -> UserId -> Cmd [Int]
-mkGraph p u = insertNodesR' [nodeGraphW Nothing Nothing p u]
-
-mkDashboard :: ParentId -> UserId -> Cmd [Int]
-mkDashboard p u = insertNodesR' [nodeDashboardW Nothing Nothing p u]
-
-mkAnnuaire :: ParentId -> UserId -> Cmd [Int]
-mkAnnuaire p u = insertNodesR' [nodeAnnuaireW Nothing Nothing p u]
-
--- | Default CorpusId Master and ListId Master
-