Commit 1c3ad407 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[REFACT] Hyperdatas WIP

parent 4c6a3b4c
Pipeline #951 failed with stage
......@@ -77,7 +77,7 @@ getScatter cId maybeListId tabType _maybeLimit = do
Just lid -> pure lid
Nothing -> defaultList cId
node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
let HyperdataList { hd_scatter = mChart } = node ^. node_hyperdata
let HyperdataList { _hl_scatter = mChart } = node ^. node_hyperdata
chart <- case mChart of
Just chart -> pure chart
......@@ -115,10 +115,10 @@ updateScatter' cId maybeListId tabType maybeLimit = do
Just lid -> pure lid
Nothing -> defaultList cId
node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
let HyperdataList { hd_chart = hdc
, hd_list = hdl
, hd_pie = hdp
, hd_tree = hdt } = node ^. node_hyperdata
let HyperdataList { _hl_chart = hdc
, _hl_list = hdl
, _hl_pie = hdp
, _hl_tree = hdt } = node ^. node_hyperdata
_ <- updateHyperdata listId $ HyperdataList hdc hdl hdp (Just $ Metrics metrics) hdt
pure $ Metrics metrics
......@@ -170,7 +170,7 @@ getChart cId _start _end maybeListId tabType = do
Just lid -> pure lid
Nothing -> defaultList cId
node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
let HyperdataList { hd_chart = mChart } = node ^. node_hyperdata
let HyperdataList { _hl_chart = mChart } = node ^. node_hyperdata
chart <- case mChart of
Just chart -> pure chart
......@@ -200,10 +200,10 @@ updateChart' cId maybeListId _tabType _maybeLimit = do
Just lid -> pure lid
Nothing -> defaultList cId
node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
let HyperdataList { hd_list = hdl
, hd_pie = hdp
, hd_scatter = hds
, hd_tree = hdt } = node ^. node_hyperdata
let HyperdataList { _hl_list = hdl
, _hl_pie = hdp
, _hl_scatter = hds
, _hl_tree = hdt } = node ^. node_hyperdata
h <- histoData cId
_ <- updateHyperdata listId $ HyperdataList (Just $ ChartMetrics h) hdl hdp hds hdt
......@@ -254,7 +254,7 @@ getPie cId _start _end maybeListId tabType = do
Just lid -> pure lid
Nothing -> defaultList cId
node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
let HyperdataList { hd_pie = mChart } = node ^. node_hyperdata
let HyperdataList { _hl_pie = mChart } = node ^. node_hyperdata
chart <- case mChart of
Just chart -> pure chart
......@@ -284,10 +284,10 @@ updatePie' cId maybeListId tabType _maybeLimit = do
Just lid -> pure lid
Nothing -> defaultList cId
node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
let HyperdataList { hd_chart = hdc
, hd_list = hdl
, hd_scatter = hds
, hd_tree = hdt } = node ^. node_hyperdata
let HyperdataList { _hl_chart = hdc
, _hl_list = hdl
, _hl_scatter = hds
, _hl_tree = hdt } = node ^. node_hyperdata
p <- pieData cId (ngramsTypeFromTabType tabType) MapTerm
_ <- updateHyperdata listId $ HyperdataList hdc hdl (Just $ ChartMetrics p) hds hdt
......@@ -348,7 +348,7 @@ getTree cId _start _end maybeListId tabType listType = do
Nothing -> defaultList cId
node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
let HyperdataList { hd_tree = mChart } = node ^. node_hyperdata
let HyperdataList { _hl_tree = mChart } = node ^. node_hyperdata
chart <- case mChart of
Just chart -> pure chart
......@@ -379,10 +379,10 @@ updateTree' cId maybeListId tabType listType = do
Nothing -> defaultList cId
node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
let HyperdataList { hd_chart = hdc
, hd_list = hdl
, hd_scatter = hds
, hd_pie = hdp } = node ^. node_hyperdata
let HyperdataList { _hl_chart = hdc
, _hl_list = hdl
, _hl_scatter = hds
, _hl_pie = hdp } = node ^. node_hyperdata
t <- treeData cId (ngramsTypeFromTabType tabType) listType
_ <- updateHyperdata listId $ HyperdataList hdc hdl hdp hds (Just $ ChartMetrics t)
......@@ -396,4 +396,4 @@ getTreeMD5 :: FlowCmdM env err m =>
-> m Text
getTreeMD5 cId maybeListId tabType listType = do
HashedResponse { md5 = md5' } <- getTree cId Nothing Nothing maybeListId tabType listType
pure md5'
\ No newline at end of file
pure md5'
......@@ -56,7 +56,7 @@ nodeTypeId n =
---- Lists
NodeList -> 5
NodeListCooc -> 50
NodeListModel -> 52
NodeModel -> 52
---- Scores
-- NodeOccurrences -> 10
......
......@@ -16,7 +16,9 @@ module Gargantext.Database.Admin.Types.Hyperdata
, module Gargantext.Database.Admin.Types.Hyperdata.Corpus
, module Gargantext.Database.Admin.Types.Hyperdata.Dashboard
, module Gargantext.Database.Admin.Types.Hyperdata.Document
, module Gargantext.Database.Admin.Types.Hyperdata.Folder
, module Gargantext.Database.Admin.Types.Hyperdata.List
, module Gargantext.Database.Admin.Types.Hyperdata.Model
, module Gargantext.Database.Admin.Types.Hyperdata.Prelude
, module Gargantext.Database.Admin.Types.Hyperdata.Texts
, module Gargantext.Database.Admin.Types.Hyperdata.Phylo
......@@ -27,7 +29,9 @@ import Gargantext.Database.Admin.Types.Hyperdata.Any
import Gargantext.Database.Admin.Types.Hyperdata.Corpus
import Gargantext.Database.Admin.Types.Hyperdata.Dashboard
import Gargantext.Database.Admin.Types.Hyperdata.Document
import Gargantext.Database.Admin.Types.Hyperdata.Folder
import Gargantext.Database.Admin.Types.Hyperdata.List
import Gargantext.Database.Admin.Types.Hyperdata.Model
import Gargantext.Database.Admin.Types.Hyperdata.Prelude (Hyperdata)
import Gargantext.Database.Admin.Types.Hyperdata.Texts
import Gargantext.Database.Admin.Types.Hyperdata.Phylo
......
......@@ -9,16 +9,14 @@ Portability : POSIX
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Admin.Types.Hyperdata.Any
where
......@@ -41,8 +39,8 @@ instance Arbitrary HyperdataAny where
instance ToSchema HyperdataAny where
declareNamedSchema proxy =
pure $ genericNameSchema defaultSchemaOptions proxy mempty
& schema.description ?~ "a node"
& schema.example ?~ emptyObject -- TODO
& schema.description ?~ "Hyperdata of any node (Json Value)"
& schema.example ?~ emptyObject -- TODO
instance FromField HyperdataAny where
fromField = fromField'
......
......@@ -9,16 +9,14 @@ Portability : POSIX
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Admin.Types.Hyperdata.Corpus
where
......@@ -34,28 +32,24 @@ 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]
}
data CorpusField = MarkdownField { _cf_text :: !Text }
| HaskellField { _cf_haskell :: !Text }
| JsonField { _cf_title :: !Text
, _cf_desc :: !Text
, _cf_query :: !Text
, _cf_authors :: !Text
-- , _cf_resources :: ![Resource]
}
deriving (Generic)
isField :: CodeType -> CorpusField -> Bool
isField Markdown (MarkdownField _) = True
isField JSON (JsonField _ _ _ _) = True
isField Haskell (HaskellField _) = True
isField _ _ = False
defaultCorpusField :: CorpusField
defaultCorpusField = MarkdownField "# Title"
$(deriveJSON (unPrefix "_cf_") ''CorpusField)
------------------------------------------------------------------------
-- Instances
------------------------------------------------------------------------
$(makeLenses ''CorpusField)
defaultCorpusField :: CorpusField
defaultCorpusField = MarkdownField "# title"
$(deriveJSON (unPrefix "_cf_") ''CorpusField)
instance ToSchema CorpusField where
declareNamedSchema proxy =
......@@ -63,36 +57,46 @@ instance ToSchema CorpusField where
& 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
------------------------------------------------------------------------
-- Instances
------------------------------------------------------------------------
$(makeLenses ''HyperdataField)
$(deriveJSON (unPrefix "_hf_") ''HyperdataField)
instance (Typeable a, ToSchema a) => ToSchema (HyperdataField a) where
declareNamedSchema proxy =
genericDeclareNamedSchema (unPrefixSwagger "_hf_") proxy
& mapped.schema.description ?~ "Hyperdata Field"
& mapped.schema.example ?~ toJSON defaultCorpusField
{-
declareNamedSchema =
wellNamedSchema "_hf_"
-- & mapped.schema.description ?~ "HyperdataField"
-- & mapped.schema.example ?~ toJSON defaultHyperdataField
-}
------------------------------------------------------------------------
data HyperdataCorpus =
HyperdataCorpus { _hc_fields :: ![HyperdataField CorpusField] }
deriving (Generic)
------------------------------------------------------------------------
-- Instances
------------------------------------------------------------------------
instance Hyperdata HyperdataCorpus
$(deriveJSON (unPrefix "_hc_") ''HyperdataCorpus)
$(makeLenses ''HyperdataCorpus)
instance Hyperdata HyperdataCorpus
type HyperdataFolder = HyperdataCorpus
------------------------------------------------------------------------
data HyperdataFrame =
......@@ -123,9 +127,6 @@ hyperdataCorpus = case decode corpusExample of
defaultHyperdataCorpus :: HyperdataCorpus
defaultHyperdataCorpus = defaultCorpus
defaultHyperdataFolder :: HyperdataFolder
defaultHyperdataFolder = defaultHyperdataCorpus
instance Arbitrary HyperdataCorpus where
arbitrary = pure hyperdataCorpus -- TODO
......
......@@ -9,14 +9,14 @@ Portability : POSIX
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Admin.Types.Hyperdata.Dashboard
where
......
......@@ -9,15 +9,14 @@ Portability : POSIX
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Admin.Types.Hyperdata.Document where
......@@ -31,7 +30,6 @@ data StatusV3 = StatusV3 { statusV3_error :: !(Maybe Text)
$(deriveJSON (unPrefix "statusV3_") ''StatusV3)
------------------------------------------------------------------------
data HyperdataDocumentV3 = HyperdataDocumentV3 { hyperdataDocumentV3_publication_day :: !(Maybe Int)
, hyperdataDocumentV3_language_iso2 :: !(Maybe Text)
......@@ -99,7 +97,7 @@ instance Hyperdata HyperdataDocumentV3
instance ToSchema HyperdataDocument where
declareNamedSchema proxy =
genericDeclareNamedSchema (unPrefixSwagger "_hyperdataDocument_") proxy
& mapped.schema.description ?~ "a document"
& mapped.schema.description ?~ "Document Hyperdata"
& mapped.schema.example ?~ toJSON defaultHyperdataDocument
------------------------------------------------------------------------
instance FromField HyperdataDocument
......@@ -112,6 +110,10 @@ instance FromField HyperdataDocumentV3
instance ToField HyperdataDocument where
toField = toJSONField
instance ToField HyperdataDocumentV3 where
toField = toJSONField
------------------------------------------------------------------------
instance QueryRunnerColumnDefault PGJsonb HyperdataDocument
where
......
{-|
Module : Gargantext.Database.Admin.Types.Hyperdata.Folder
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Admin.Types.Hyperdata.Folder
where
import Gargantext.Database.Admin.Types.Hyperdata.Corpus
------------------------------------------------------------------------
type HyperdataFolder = HyperdataCorpus
defaultHyperdataFolder :: HyperdataFolder
defaultHyperdataFolder = defaultHyperdataCorpus
......@@ -30,60 +30,37 @@ import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metrics)
------------------------------------------------------------------------
data HyperdataList =
HyperdataList { hd_chart :: !(Maybe (ChartMetrics Histo))
, hd_list :: !(Maybe Text)
, hd_pie :: !(Maybe (ChartMetrics Histo))
, hd_scatter :: !(Maybe Metrics)
, hd_tree :: !(Maybe (ChartMetrics [MyTree]))
HyperdataList { _hl_chart :: !(Maybe (ChartMetrics Histo))
, _hl_list :: !(Maybe Text)
, _hl_pie :: !(Maybe (ChartMetrics Histo))
, _hl_scatter :: !(Maybe Metrics)
, _hl_tree :: !(Maybe (ChartMetrics [MyTree]))
} deriving (Show, Generic)
$(deriveJSON (unPrefix "hd_") ''HyperdataList)
instance Hyperdata HyperdataList
defaultHyperdataList :: HyperdataList
defaultHyperdataList = HyperdataList Nothing Nothing Nothing Nothing Nothing
----
data HyperdataListModel =
HyperdataListModel { _hlm_params :: !(Int, Int)
, _hlm_path :: !Text
, _hlm_score :: !(Maybe Double)
} deriving (Show, Generic)
instance Hyperdata HyperdataListModel
instance Arbitrary HyperdataListModel where
arbitrary = elements [HyperdataListModel (100,100) "models/example.model" Nothing]
$(deriveJSON (unPrefix "_hlm_") ''HyperdataListModel)
$(makeLenses ''HyperdataListModel)
defaultHyperdataListModel :: HyperdataListModel
defaultHyperdataListModel = HyperdataListModel (400,500) "data/models/test.model" (Just 0.83)
------------------------------------------------------------------------
data HyperdataScore = HyperdataScore { hyperdataScore_preferences :: !(Maybe Text)
} deriving (Show, Generic)
$(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
instance Hyperdata HyperdataScore
------------------------------------------------------------------------
-- Instances
------------------------------------------------------------------------
instance Hyperdata HyperdataList
$(makeLenses ''HyperdataList)
$(deriveJSON (unPrefix "_hl_") ''HyperdataList)
instance Arbitrary HyperdataList where
arbitrary = pure defaultHyperdataList
instance FromField HyperdataList
where
fromField = fromField'
instance FromField HyperdataListModel
where
fromField = fromField'
------------------------------------------------------------------------
instance QueryRunnerColumnDefault PGJsonb HyperdataList
where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGJsonb HyperdataListModel
where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance ToSchema HyperdataList where
declareNamedSchema proxy =
genericDeclareNamedSchema (unPrefixSwagger "_hl_") proxy
& mapped.schema.description ?~ "List Hyperdata"
& mapped.schema.example ?~ toJSON defaultHyperdataList
------------------------------------------------------------------------
{-|
Module : Gargantext.Database.Admin.Types.Hyperdata.Model
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Admin.Types.Hyperdata.Model
where
import Gargantext.Prelude
import Gargantext.Database.Admin.Types.Hyperdata.Prelude
------------------------------------------------------------------------
data HyperdataModel =
HyperdataModel { _hm_params :: !(Int, Int)
, _hm_path :: !Text
, _hm_score :: !(Maybe Double)
} deriving (Show, Generic)
defaultHyperdataModel :: HyperdataModel
defaultHyperdataModel = HyperdataModel (400,500) "data/models/test.model" (Just 0.83)
------------------------------------------------------------------------
-- Instances
------------------------------------------------------------------------
instance Hyperdata HyperdataModel
$(makeLenses ''HyperdataModel)
$(deriveJSON (unPrefix "_hm_") ''HyperdataModel)
instance Arbitrary HyperdataModel where
arbitrary = pure defaultHyperdataModel
instance FromField HyperdataModel
where
fromField = fromField'
instance QueryRunnerColumnDefault PGJsonb HyperdataModel
where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance ToSchema HyperdataModel where
declareNamedSchema proxy =
genericDeclareNamedSchema (unPrefixSwagger "_hm_") proxy
& mapped.schema.description ?~ "Model Hyperdata"
& mapped.schema.example ?~ toJSON defaultHyperdataModel
......@@ -53,11 +53,9 @@ instance ToSchema HyperdataPhylo where
& mapped.schema.description ?~ "Phylo Hyperdata"
& mapped.schema.example ?~ toJSON defaultHyperdataPhylo
instance FromField HyperdataPhylo where
fromField = fromField'
instance QueryRunnerColumnDefault PGJsonb HyperdataPhylo
where
queryRunnerColumnDefault = fieldQueryRunnerColumn
......@@ -47,10 +47,9 @@ instance Arbitrary HyperdataTexts where
instance ToSchema HyperdataTexts where
declareNamedSchema proxy =
-- genericDeclareNamedSchema (unPrefixSwagger "_ht_") proxy
pure $ genericNameSchema defaultSchemaOptions proxy mempty
& schema.description ?~ "Texts Hyperdata"
& schema.example ?~ toJSON defaultHyperdataTexts
genericDeclareNamedSchema (unPrefixSwagger "_ht_") proxy
& mapped.schema.description ?~ "Texts Hyperdata"
& mapped.schema.example ?~ toJSON defaultHyperdataTexts
instance FromField HyperdataTexts where
fromField = fromField'
......
......@@ -245,7 +245,7 @@ data NodeType = NodeUser
| NodeAnnuaire | NodeContact
| NodeGraph | NodePhylo
| NodeDashboard | NodeChart | NodeNoteBook
| NodeList | NodeListModel
| NodeList | NodeModel
| NodeListCooc
{-
......
......@@ -117,8 +117,8 @@ getDocumentsV3WithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocume
getDocumentsWithParentId :: NodeId -> Cmd err [Node HyperdataDocument]
getDocumentsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocument)
getListsModelWithParentId :: NodeId -> Cmd err [Node HyperdataListModel]
getListsModelWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeListModel)
getListsModelWithParentId :: NodeId -> Cmd err [Node HyperdataModel]
getListsModelWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeModel)
getCorporaWithParentId :: NodeId -> Cmd err [Node HyperdataCorpus]
getCorporaWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeCorpus)
......@@ -195,14 +195,14 @@ nodeAnnuaireW maybeName maybeAnnuaire pId = node NodeAnnuaire name annuaire (Jus
annuaire = maybe defaultHyperdataAnnuaire identity maybeAnnuaire
------------------------------------------------------------------------
mkListModelNode :: HasNodeError err => ParentId -> UserId -> Cmd err [NodeId]
mkListModelNode p u = insertNodesR [nodeListModelW Nothing Nothing p u]
mkModelNode :: HasNodeError err => ParentId -> UserId -> Cmd err [NodeId]
mkModelNode p u = insertNodesR [nodeModelW Nothing Nothing p u]
nodeListModelW :: Maybe Name -> Maybe HyperdataListModel -> ParentId -> UserId -> NodeWrite
nodeListModelW maybeName maybeListModel pId = node NodeListModel name list (Just pId)
nodeModelW :: Maybe Name -> Maybe HyperdataModel -> ParentId -> UserId -> NodeWrite
nodeModelW maybeName maybeModel pId = node NodeModel name list (Just pId)
where
name = maybe "List Model" identity maybeName
list = maybe defaultHyperdataListModel identity maybeListModel
list = maybe defaultHyperdataModel identity maybeModel
------------------------------------------------------------------------
nodeGraphW :: Maybe Name -> Maybe HyperdataGraph -> ParentId -> UserId -> NodeWrite
......@@ -224,7 +224,7 @@ nodeDefault NodeList parentId = node NodeList "List" defaultHyperdat
nodeDefault NodeCorpus parentId = node NodeCorpus "Corpus" defaultHyperdataCorpus (Just parentId)
nodeDefault NodeDocument parentId = node NodeDocument "Doc" defaultHyperdataDocument (Just parentId)
nodeDefault NodeTexts parentId = node NodeTexts "Texts" defaultHyperdataTexts (Just parentId)
nodeDefault NodeListModel parentId = node NodeListModel "Model" defaultHyperdataListModel (Just parentId)
nodeDefault NodeModel parentId = node NodeModel "Model" defaultHyperdataModel (Just parentId)
nodeDefault nt _ = panic $ "G.D.Q.T.Node.nodeDefault " <> (cs $ show nt)
------------------------------------------------------------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment