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