[TYPES] Node Hyperdata for Json | Markdown fields.

src/Gargantext/API/Node.hs

@@ -121,7 +121,7 @@ roots = (liftIO (putStrLn ( "/user" :: Text)) >> getNodesWithParentId 0 Nothing)
 type NodeAPI a = Get '[JSON] (Node a)
              :<|> "rename" :> RenameApi
              :<|> PostNodeApi -- TODO move to children POST
-             :<|> Put    '[JSON] Int
+             :<|> ReqBody '[JSON] a :> Put    '[JSON] Int
              :<|> Delete '[JSON] Int
              :<|> "children"  :> ChildrenApi a
 
@@ -174,14 +174,14 @@ nodeNodeAPI p uId cId nId = withAccess (Proxy :: Proxy (NodeNodeAPI a)) Proxy uI
 
 ------------------------------------------------------------------------
 -- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy.
-nodeAPI :: forall proxy a. (JSONB a, ToJSON a) => proxy a -> UserId -> NodeId -> GargServer (NodeAPI a)
+nodeAPI :: forall proxy a. (JSONB a, FromJSON a, ToJSON a) => proxy a -> UserId -> NodeId -> GargServer (NodeAPI a)
 nodeAPI p uId id = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode id) nodeAPI'
   where
     nodeAPI' :: GargServer (NodeAPI a)
     nodeAPI' =  getNodeWith   id p
            :<|> rename        id
            :<|> postNode  uId id
-           :<|> putNode       id p
+           :<|> putNode       id
            :<|> deleteNodeApi id
            :<|> getChildren   id p
 
@@ -337,11 +337,9 @@ postNode uId pId (PostNode nodeName nt) = do
   let uId' = nodeUser ^. node_userId
   mkNodeWithParent nt (Just pId) uId' nodeName
 
-putNode :: forall err proxy a. (HasNodeError err, JSONB a, ToJSON a)
+putNode :: forall err a. (HasNodeError err, JSONB a, ToJSON a)
         => NodeId
-        -> proxy a
+        -> a
         -> Cmd err Int
-putNode n h = do
-  n <- fromIntegral <$> updateHyperdata n h
-  pure n
+putNode n h = fromIntegral <$> updateHyperdata n h
 -------------------------------------------------------------

src/Gargantext/Database/Types/Node.hs

@@ -293,25 +293,70 @@ instance ToSchema Resource where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "resource_")
 
 ------------------------------------------------------------------------
-data HyperdataUser = HyperdataUser { hyperdataUser_language       :: Maybe Text
+data HyperdataUser = HyperdataUser { hyperdataUser_language       :: !(Maybe Text)
                                        } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
 
 instance Hyperdata HyperdataUser
 ------------------------------------------------------------------------
-data HyperdataFolder = HyperdataFolder { hyperdataFolder_desc    :: Maybe Text
+data HyperdataFolder = HyperdataFolder { hyperdataFolder_desc    :: !(Maybe Text)
                                        } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
 
 instance Hyperdata HyperdataFolder
 ------------------------------------------------------------------------
-data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_title        :: !(Maybe Text)
-                                       , hyperdataCorpus_desc         :: !(Maybe Text)
-                                       , hyperdataCorpus_query        :: !(Maybe Text)
-                                       , hyperdataCorpus_authors      :: !(Maybe Text)
-                                       , hyperdataCorpus_resources    :: !(Maybe [Resource])
-                                       } deriving (Show, Generic)
-$(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
+
+data CodeType = JSON | Markdown
+  deriving (Generic)
+instance ToJSON CodeType
+instance FromJSON CodeType
+instance ToSchema CodeType
+
+------------------------------------------------------------------------
+data CorpusField = MarkdownField { _cf_text :: !Text }
+                  | JsonField { _cf_title :: !Text
+                              , _cf_desc  :: !Text
+                              , _cf_query :: !Text
+                              , _cf_authors :: !Text
+                              , _cf_resources :: ![Resource]
+                              } deriving (Generic)
+
+$(deriveJSON (unPrefix "_cf_") ''CorpusField)
+$(makeLenses ''CorpusField)
+
+defaultCorpusField :: CorpusField
+defaultCorpusField = MarkdownField "#title"
+
+instance ToSchema CorpusField where
+  declareNamedSchema proxy =
+    genericDeclareNamedSchema (unPrefixSwagger "_cf_") proxy
+    & mapped.schema.description ?~ "CorpusField"
+    & mapped.schema.example ?~ toJSON defaultCorpusField
+
+------------------------------------------------------------------------
+data HyperdataField a =
+  HyperdataField { _hf_type :: !CodeType
+                 , _hf_name :: !Text
+                 , _hf_data :: !a
+                 } deriving (Generic)
+$(deriveJSON (unPrefix "_hf_") ''HyperdataField)
+$(makeLenses ''HyperdataField)
+
+defaultHyperdataField :: HyperdataField CorpusField
+defaultHyperdataField = HyperdataField Markdown "name" defaultCorpusField
+
+instance (ToSchema a) => ToSchema (HyperdataField a) where
+  declareNamedSchema =
+    genericDeclareNamedSchema (unPrefixSwagger "_hf_")
+    -- & mapped.schema.description ?~ "HyperdataField"
+    -- & mapped.schema.example ?~ toJSON defaultHyperdataField
+
+------------------------------------------------------------------------
+data HyperdataCorpus =
+  HyperdataCorpus { _hc_fields :: ![HyperdataField CorpusField] }
+    deriving (Generic)
+$(deriveJSON (unPrefix "_hc_") ''HyperdataCorpus)
+$(makeLenses ''HyperdataCorpus)
 
 instance Hyperdata HyperdataCorpus
 
@@ -319,7 +364,9 @@ corpusExample :: ByteString
 corpusExample = "" -- TODO
 
 defaultCorpus :: HyperdataCorpus
-defaultCorpus = (HyperdataCorpus (Just "Title") (Just "Descr") (Just "Bool query") (Just "Authors") Nothing)
+defaultCorpus = HyperdataCorpus [ HyperdataField JSON "Mandatory fields" (JsonField "Title" "Descr" "Bool query" "Authors" [])
+                                , HyperdataField Markdown "Optional Text" (MarkdownField "#title\n##subtitle")
+                                ]
 
 hyperdataCorpus :: HyperdataCorpus
 hyperdataCorpus = case decode corpusExample of
@@ -477,7 +524,7 @@ data NodePolySearch id        typename userId
                                       , _ns_parentId  :: parentId
                                       , _ns_name      :: name
                                       , _ns_date      :: date
-                                  
+
                                       , _ns_hyperdata :: hyperdata
                                       , _ns_search    :: search
                                       } deriving (Show, Generic)
@@ -527,8 +574,8 @@ docExample = "{\"doi\":\"sdfds\",\"publication_day\":6,\"language_iso2\":\"en\",
 
 instance ToSchema HyperdataCorpus where
   declareNamedSchema proxy =
-    genericDeclareNamedSchema (unPrefixSwagger "hyperdataCorpus_") proxy
-    & mapped.schema.description ?~ "a corpus"
+    genericDeclareNamedSchema (unPrefixSwagger "_hc_") proxy
+    & mapped.schema.description ?~ "Corpus"
     & mapped.schema.example ?~ toJSON hyperdataCorpus
 
 instance ToSchema HyperdataAnnuaire where