, returnError
)
import Prelude hiding (null, id, map, sum)
-import Data.Time.Segment (jour, timesAfter, Granularity(D))
import Gargantext.Core.Types
import Gargantext.Core.Types.Node (NodeType)
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)
import Database.PostgreSQL.Simple (Connection)
import Opaleye hiding (FromField)
-import Opaleye.Internal.QueryArr (Query(..))
+import Opaleye.Internal.QueryArr (Query)
import qualified Data.Profunctor.Product as PP
-- | Types for Node Database Management
data PGTSVector
getNodesWith :: Connection -> Int -> Maybe NodeType
- -> Maybe Offset -> Maybe Limit -> IO [Node HyperdataDocument]
+ -> Maybe Offset -> Maybe Limit -> IO [Node Value]
getNodesWith conn parentId nodeType maybeOffset maybeLimit =
runQuery conn $ selectNodesWith
parentId nodeType maybeOffset maybeLimit
-- NP check type
getNodesWithParentId :: Connection -> Int
- -> Maybe Text -> IO [Node HyperdataDocument]
+ -> Maybe Text -> IO [Node Value]
getNodesWithParentId conn n _ = runQuery conn $ selectNodesWithParentID n
getNodesWithParentId' :: Connection -> Int
fromMaybe (error "TODO: 404") . headMay <$> runQuery c (limit 1 $ selectNode (pgInt4 id))
-getNode :: Connection -> Int -> IO (Node HyperdataDocument)
+getNode :: Connection -> Int -> IO (Node Value)
getNode conn id = do
fromMaybe (error "TODO: 404") . headMay <$> runQuery conn (limit 1 $ selectNode (pgInt4 id))
typeId = nodeTypeId nodeType
byteData = DB.pack $ DBL.unpack $ encode nodeData
+
+
+node2write :: (Functor f2, Functor f1) =>
+ Int
+ -> NodePoly (f1 Int) Int Int parentId Text (f2 UTCTime) ByteString
+ -> (f1 (Column PGInt4), Column PGInt4, Column PGInt4,
+ Column PGInt4, Column PGText, f2 (Column PGTimestamptz),
+ Column PGJsonb)
node2write pid (Node id tn ud _ nm dt hp) = ((pgInt4 <$> id)
,(pgInt4 tn)
,(pgInt4 ud)
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
mkNodeR' :: Connection -> [NodeWriteT] -> IO [Int]
mkNodeR' conn ns = runInsertManyReturning conn nodeTable' ns (\(i,_,_,_,_,_,_) -> i)
+-- | postNode
postNode :: Connection -> UserId -> ParentId -> Node' -> IO [Int]
postNode c uid pid (Node' nt txt v []) = mkNodeR' c (node2table uid pid (Node' nt txt v []))
-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)
+
+postNode c uid pid (Node' NodeCorpus txt v ns) = do
+ [pid'] <- postNode c uid pid (Node' NodeCorpus txt v [])
+ pids <- mkNodeR' c $ concat $ map (\n -> childWith uid pid' n) ns
+ pure (pids)
+
+postNode c uid pid (Node' Annuaire txt v ns) = do
+ [pid'] <- postNode c uid pid (Node' Annuaire txt v [])
+ pids <- mkNodeR' c $ concat $ map (\n -> childWith uid pid' n) ns
pure (pids)
-postNode c uid pid (Node' _ _ _ _) = panic "postNode for this type not implemented yet"
+postNode _ _ _ (Node' _ _ _ _) = panic $ pack "postNode for this type not implemented yet"
+childWith :: UserId -> ParentId -> Node' -> [NodeWriteT]
+childWith uId pId (Node' Document txt v []) = node2table uId pId (Node' Document txt v [])
+childWith uId pId (Node' UserPage txt v []) = node2table uId pId (Node' UserPage txt v [])
+childWith _ _ (Node' _ _ _ _) = panic $ pack "This NodeType can not be a child"