[REFACT] Hyperdatas WIP

src/Gargantext/Database/Admin/Types/Hyperdata.hs

@@ -12,17 +12,25 @@ Portability : POSIX
 
 
 module Gargantext.Database.Admin.Types.Hyperdata
-  ( module Gargantext.Database.Admin.Types.Hyperdata.Corpus
+  ( module Gargantext.Database.Admin.Types.Hyperdata.Any
+  , 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.List
   , module Gargantext.Database.Admin.Types.Hyperdata.Prelude
+  , module Gargantext.Database.Admin.Types.Hyperdata.Texts
+  , module Gargantext.Database.Admin.Types.Hyperdata.Phylo
   )
   where
 
-import Gargantext.Database.Admin.Types.Hyperdata.Prelude (Hyperdata)
+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.List
+import Gargantext.Database.Admin.Types.Hyperdata.Prelude (Hyperdata)
+import Gargantext.Database.Admin.Types.Hyperdata.Texts
+import Gargantext.Database.Admin.Types.Hyperdata.Phylo
 
 
 

src/Gargantext/Database/Admin/Types/Hyperdata/Any.hs

+{-|
+Module      : Gargantext.Database.Admin.Types.Hyperdata.Any
+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.Any
+  where
+
+import Gargantext.Prelude
+import Gargantext.Database.Admin.Types.Hyperdata.Prelude
+
+------------------------------------------------------------------------
+newtype HyperdataAny = HyperdataAny Object
+  deriving (Show, Generic, ToJSON, FromJSON)
+
+------------------------------------------------------------------------
+-- Instances
+------------------------------------------------------------------------
+instance Hyperdata HyperdataAny
+
+instance Arbitrary HyperdataAny where
+    arbitrary = pure $ HyperdataAny mempty -- TODO produce arbitrary objects
+
+instance ToSchema HyperdataAny where
+  declareNamedSchema proxy =
+    pure $ genericNameSchema defaultSchemaOptions proxy mempty
+             & schema.description ?~ "a node"
+             & schema.example ?~ emptyObject -- TODO
+
+instance FromField HyperdataAny where
+    fromField = fromField'
+
+instance QueryRunnerColumnDefault PGJsonb HyperdataAny
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+

src/Gargantext/Database/Admin/Types/Hyperdata/Corpus.hs

@@ -25,7 +25,6 @@ module Gargantext.Database.Admin.Types.Hyperdata.Corpus
 
 import Gargantext.Prelude
 import Gargantext.Database.Admin.Types.Hyperdata.Prelude
-import Gargantext.Viz.Phylo (Phylo(..))
 
 
 data CodeType = JSON | Markdown | Haskell
@@ -127,8 +126,6 @@ defaultHyperdataCorpus = defaultCorpus
 defaultHyperdataFolder :: HyperdataFolder
 defaultHyperdataFolder = defaultHyperdataCorpus
 
-
-
 instance Arbitrary HyperdataCorpus where
     arbitrary = pure hyperdataCorpus -- TODO
 
@@ -148,84 +145,15 @@ instance Arbitrary HyperdataAnnuaire where
   arbitrary = pure defaultHyperdataAnnuaire -- TODO
 
 ------------------------------------------------------------------------
-newtype HyperdataAny = HyperdataAny Object
-  deriving (Show, Generic, ToJSON, FromJSON)
-
-instance Hyperdata HyperdataAny
-
-instance Arbitrary HyperdataAny where
-    arbitrary = pure $ HyperdataAny mempty -- TODO produce arbitrary objects
-------------------------------------------------------------------------
-data HyperdataResource = HyperdataResource { hyperdataResource_preferences   :: !(Maybe Text)
-                                   } deriving (Show, Generic)
-$(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
-
-instance Hyperdata HyperdataResource
-
-------------------------------------------------------------------------
-------------------------------------------------------------------------
--- TODO add the Graph Structure here
-
 ------------------------------------------------------------------------
--- | TODO CLEAN
--- | TODO FEATURE: Notebook saved in the node
-data HyperdataTexts =
-  HyperdataTexts { ht_preferences :: !(Maybe Text)}
-  deriving (Show, Generic)
-
-instance Hyperdata HyperdataTexts
-instance ToJSON HyperdataTexts
-instance FromJSON HyperdataTexts
-
-defaultHyperdataTexts :: HyperdataTexts
-defaultHyperdataTexts = HyperdataTexts Nothing
-
-data HyperdataDashboard =
-  HyperdataDashboard { hda_preferences :: !(Maybe Text)
-                     , hda_charts      :: ![Chart]
-                     }
-  deriving (Show, Generic)
-
-instance Hyperdata HyperdataDashboard
-instance ToJSON    HyperdataDashboard
-instance FromJSON  HyperdataDashboard
-
-
-
 data HyperdataNotebook =
   HyperdataNotebook { hn_preferences :: !(Maybe Text)}
   deriving (Show, Generic)
 
-data HyperdataPhylo =
-  HyperdataPhylo    { hp_preferences :: !(Maybe Text)
-                    , hp_data        :: !(Maybe Phylo)
-                    }
-  deriving (Show, Generic)
-
-instance Hyperdata HyperdataPhylo
-instance ToJSON    HyperdataPhylo
-instance FromJSON  HyperdataPhylo
-
-defaultHyperdataPhylo :: HyperdataPhylo
-defaultHyperdataPhylo = HyperdataPhylo Nothing Nothing
-
-instance FromField HyperdataPhylo where
-    fromField = fromField'
-
-instance QueryRunnerColumnDefault PGJsonb HyperdataPhylo
-  where
-    queryRunnerColumnDefault = fieldQueryRunnerColumn
-
-instance ToSchema HyperdataPhylo where
-  declareNamedSchema proxy =
-    genericDeclareNamedSchema (unPrefixSwagger "hp_") proxy
-    & mapped.schema.description ?~ "Phylo"
-    & mapped.schema.example ?~ toJSON defaultHyperdataPhylo
 
 ------------------------------------------------------------------------
 -- Instances
 ------------------------------------------------------------------------
-
 instance ToSchema HyperdataCorpus where
   declareNamedSchema proxy =
     genericDeclareNamedSchema (unPrefixSwagger "_hc_") proxy
@@ -238,17 +166,7 @@ instance ToSchema HyperdataAnnuaire where
     & mapped.schema.description ?~ "an annuaire"
     & mapped.schema.example ?~ toJSON defaultHyperdataAnnuaire
 
-instance ToSchema HyperdataAny where
-  declareNamedSchema proxy =
-    pure $ genericNameSchema defaultSchemaOptions proxy mempty
-             & schema.description ?~ "a node"
-             & schema.example ?~ emptyObject -- TODO
-
 ------------------------------------------------------------------------
-
-instance FromField HyperdataAny where
-    fromField = fromField'
-
 instance FromField HyperdataCorpus
   where
     fromField = fromField'
@@ -258,11 +176,6 @@ instance FromField HyperdataAnnuaire
     fromField = fromField'
 
 ------------------------------------------------------------------------
-
-instance QueryRunnerColumnDefault PGJsonb HyperdataAny
-  where
-    queryRunnerColumnDefault = fieldQueryRunnerColumn
-
 instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn

src/Gargantext/Database/Admin/Types/Hyperdata/Dashboard.hs

+{-|
+Module      : Gargantext.Database.Admin.Types.Hyperdata.Dashboard
+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.Dashboard
+  where
+
+import Gargantext.Prelude
+import Gargantext.Database.Admin.Types.Hyperdata.Prelude
+
+------------------------------------------------------------------------
+
+data HyperdataDashboard =
+  HyperdataDashboard { _hd_preferences :: !(Maybe Text)
+                     , _hd_charts      :: ![Chart]
+                     }
+  deriving (Show, Generic)
+
+
+defaultHyperdataDashboard :: HyperdataDashboard
+defaultHyperdataDashboard = HyperdataDashboard Nothing []
+
+------------------------------------------------------------------------
+-- Instances
+------------------------------------------------------------------------
+instance Hyperdata HyperdataDashboard
+
+$(makeLenses ''HyperdataDashboard)
+$(deriveJSON (unPrefix "_hd_") ''HyperdataDashboard)
+
+instance Arbitrary HyperdataDashboard where
+    arbitrary = pure defaultHyperdataDashboard
+
+instance ToSchema HyperdataDashboard where
+  declareNamedSchema proxy =
+    pure $ genericNameSchema defaultSchemaOptions proxy mempty
+    -- genericDeclareNamedSchema (unPrefixSwagger "hp_") proxy
+             & schema.description ?~ "Dashboard Hyperdata"
+             & schema.example ?~ toJSON defaultHyperdataDashboard
+
+instance FromField HyperdataDashboard where
+    fromField = fromField'
+
+instance QueryRunnerColumnDefault PGJsonb HyperdataDashboard
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+

src/Gargantext/Database/Admin/Types/Hyperdata/Phylo.hs

+{-|
+Module      : Gargantext.Database.Admin.Types.Hyperdata.Phylo
+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.Phylo
+  where
+
+import Gargantext.Prelude
+import Gargantext.Database.Admin.Types.Hyperdata.Prelude
+import Gargantext.Viz.Phylo (Phylo(..))
+
+------------------------------------------------------------------------
+
+data HyperdataPhylo =
+  HyperdataPhylo    { _hp_preferences :: !(Maybe Text)
+                    , _hp_data        :: !(Maybe Phylo)
+                    }
+  deriving (Show, Generic)
+
+defaultHyperdataPhylo :: HyperdataPhylo
+defaultHyperdataPhylo = HyperdataPhylo Nothing Nothing
+
+------------------------------------------------------------------------
+-- Instances
+------------------------------------------------------------------------
+instance Hyperdata HyperdataPhylo
+
+$(makeLenses ''HyperdataPhylo)
+$(deriveJSON (unPrefix "_hp_") ''HyperdataPhylo)
+
+instance Arbitrary HyperdataPhylo where
+    arbitrary = pure defaultHyperdataPhylo
+
+instance ToSchema HyperdataPhylo where
+  declareNamedSchema proxy =
+    genericDeclareNamedSchema (unPrefixSwagger "_hp_") proxy
+    & mapped.schema.description ?~ "Phylo Hyperdata"
+    & mapped.schema.example ?~ toJSON defaultHyperdataPhylo
+
+
+instance FromField HyperdataPhylo where
+    fromField = fromField'
+
+instance QueryRunnerColumnDefault PGJsonb HyperdataPhylo
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+

src/Gargantext/Database/Admin/Types/Hyperdata/Texts.hs

+{-|
+Module      : Gargantext.Database.Admin.Types.Hyperdata.Texts
+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.Texts
+  where
+
+import Gargantext.Prelude
+import Gargantext.Database.Admin.Types.Hyperdata.Prelude
+
+------------------------------------------------------------------------
+
+data HyperdataTexts =
+  HyperdataTexts { _ht_preferences :: !(Maybe Text)
+                 }
+  deriving (Show, Generic)
+
+defaultHyperdataTexts :: HyperdataTexts
+defaultHyperdataTexts = HyperdataTexts Nothing
+
+------------------------------------------------------------------------
+-- Instances
+------------------------------------------------------------------------
+instance Hyperdata HyperdataTexts
+
+$(makeLenses ''HyperdataTexts)
+$(deriveJSON (unPrefix "_ht_") ''HyperdataTexts)
+
+instance Arbitrary HyperdataTexts where
+    arbitrary = pure defaultHyperdataTexts
+
+instance ToSchema HyperdataTexts where
+  declareNamedSchema proxy =
+    -- genericDeclareNamedSchema (unPrefixSwagger "_ht_") proxy
+    pure $ genericNameSchema defaultSchemaOptions proxy mempty
+    & schema.description ?~ "Texts Hyperdata"
+    & schema.example     ?~ toJSON defaultHyperdataTexts
+
+instance FromField HyperdataTexts where
+    fromField = fromField'
+
+instance QueryRunnerColumnDefault PGJsonb HyperdataTexts
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+

src/Gargantext/Viz/Phylo/API.hs

@@ -17,6 +17,7 @@ Portability : POSIX
 module Gargantext.Viz.Phylo.API
   where
 
+import Control.Lens ((^.))
 import Data.String.Conversions
 --import Control.Monad.Reader (ask)
 import qualified Data.ByteString as DB
@@ -33,7 +34,7 @@ import Gargantext.API.Prelude
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node -- (PhyloId, ListId, CorpusId, UserId, NodeId(..))
 import Gargantext.Database.Query.Table.Node (insertNodes, node, getNodeWith)
-import Gargantext.Database.Schema.Node (_node_hyperdata)
+import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Prelude
 import Gargantext.Viz.Phylo
 import Gargantext.Viz.Phylo.Main
@@ -100,7 +101,7 @@ getPhylo phId _lId l msb  = do
   let
     level = maybe 2 identity l
     branc = maybe 2 identity msb
-    maybePhylo = hp_data $ _node_hyperdata phNode
+    maybePhylo = phNode ^. (node_hyperdata . hp_data)
 
   p <- liftBase $ viewPhylo2Svg
                 $ viewPhylo level branc