src/Gargantext/Core/Viz/Phylo/API.hs

   1 {-|
   2 Module      : Gargantext.Core.Viz.Phylo.API
   3 Description : Phylo API
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 -}
  11
  12 {-# OPTIONS_GHC -fno-warn-orphans #-}
  13
  14 {-# LANGUAGE OverloadedLists    #-}   -- allows to write Map and HashMap as lists
  15 {-# LANGUAGE TypeOperators      #-}
  16
  17 module Gargantext.Core.Viz.Phylo.API
  18   where
  19
  20 import Data.Aeson
  21 import Data.Either
  22 import Data.Maybe (fromMaybe)
  23 import Data.Swagger
  24 import Gargantext.API.Prelude
  25 import Gargantext.Core.Types (TODO(..))
  26 import Gargantext.Core.Viz.LegacyPhylo
  27 import Gargantext.Core.Viz.Phylo (defaultConfig)
  28 import Gargantext.Core.Viz.Phylo.API.Tools
  29 import Gargantext.Core.Viz.Phylo.Example (phyloExample)
  30 import Gargantext.Core.Viz.Phylo.Legacy.LegacyMain
  31 import Gargantext.Database.Admin.Types.Hyperdata
  32 import Gargantext.Database.Admin.Types.Node -- (PhyloId, ListId, CorpusId, UserId, NodeId(..))
  33 import Gargantext.Database.Query.Table.Node (insertNodes, node)
  34 import Gargantext.Prelude
  35 import Network.HTTP.Media ((//), (/:))
  36 import Servant
  37 import Test.QuickCheck (elements)
  38 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  39 import Web.HttpApiData (readTextData)
  40 import qualified Data.ByteString as DB
  41 import qualified Data.ByteString.Lazy as DBL
  42
  43 ------------------------------------------------------------------------
  44 type PhyloAPI = Summary "Phylo API"
  45               :> GetPhylo
  46         --    :<|> PutPhylo
  47             :<|> PostPhylo
  48
  49
  50 phyloAPI :: PhyloId -> UserId -> GargServer PhyloAPI
  51 phyloAPI n u = getPhylo  n
  52         :<|> postPhylo n u
  53         -- :<|> putPhylo  n
  54         -- :<|> deletePhylo  n
  55
  56 newtype SVG = SVG DB.ByteString
  57 --instance Show a => MimeRender PlainText a where mimeRender _ val = cs ("" <> show val)
  58 instance Accept SVG where contentType _ = "SVG" // "image/svg+xml" /: ("charset", "utf-8")
  59 instance MimeRender SVG SVG where mimeRender _ (SVG s) = DBL.fromStrict s
  60 instance MimeUnrender SVG SVG where mimeUnrender _ lbs = Right $ SVG (DBL.toStrict lbs)
  61 instance Show SVG where show (SVG a) = show a
  62 instance ToSchema SVG where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
  63
  64 ------------------------------------------------------------------------
  65 instance ToSchema Value where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
  66
  67 ------------------------------------------------------------------------
  68 type GetPhylo =  QueryParam "listId"      ListId
  69               :> QueryParam "level"       Level
  70               :> QueryParam "minSizeBranch" MinSizeBranch
  71    {-           :> QueryParam "filiation"   Filiation
  72               :> QueryParam "childs"      Bool
  73               :> QueryParam "depth"       Level
  74               :> QueryParam "metrics"    [Metric]
  75               :> QueryParam "periodsInf" Int
  76               :> QueryParam "periodsSup" Int
  77               :> QueryParam "minNodes"   Int
  78               :> QueryParam "taggers"    [Tagger]
  79               :> QueryParam "sort"       Sort
  80               :> QueryParam "order"      Order
  81               :> QueryParam "export"    ExportMode
  82               :> QueryParam "display"    DisplayMode
  83               :> QueryParam "verbose"     Bool
  84     -}
  85               -- :> Get '[SVG] SVG
  86               :> Get '[JSON] Value
  87
  88 -- | TODO
  89 -- Add real text processing
  90 -- Fix Filter parameters
  91 -- TODO fix parameters to default config that should be in Node
  92 getPhylo :: PhyloId -> GargServer GetPhylo
  93 getPhylo phyloId _lId _level _minSizeBranch = getPhyloDataJson phyloId
  94
  95 getPhyloDataJson :: PhyloId -> GargNoServer Value
  96 getPhyloDataJson phyloId = do
  97   maybePhyloData <- getPhyloData phyloId
  98   let phyloData = fromMaybe phyloExample maybePhyloData
  99   phyloJson <- liftBase $ phylo2dot2json phyloData
 100   pure phyloJson
 101
 102
 103
 104 -- getPhylo phId _lId l msb  = do
 105   -- let
 106   --   level = fromMaybe 2 l
 107   --   branc = fromMaybe 2 msb
 108   --   maybePhylo = phNode ^. (node_hyperdata . hp_data)
 109
 110   -- p <- liftBase $ viewPhylo2Svg
 111   --               $ viewPhylo level branc
 112   --               $ fromMaybe phyloFromQuery maybePhylo
 113   -- pure (SVG p)
 114
 115
 116 ------------------------------------------------------------------------
 117 type PostPhylo =  QueryParam "listId" ListId
 118                -- :> ReqBody '[JSON] PhyloQueryBuild
 119                :> (Post '[JSON] NodeId)
 120
 121 postPhylo :: CorpusId -> UserId -> GargServer PostPhylo
 122 postPhylo corpusId userId _lId = do
 123   -- TODO get Reader settings
 124   -- s <- ask
 125   -- let
 126     -- _vrs = Just ("1" :: Text)
 127     -- _sft = Just (Software "Gargantext" "4")
 128     -- _prm = initPhyloParam vrs sft (Just q)
 129   phy <- flowPhyloAPI defaultConfig corpusId -- params
 130   phyloId <- insertNodes [node NodePhylo "Phylo" (HyperdataPhylo Nothing (Just phy)) (Just corpusId) userId]
 131   pure $ NodeId (fromIntegral phyloId)
 132
 133 ------------------------------------------------------------------------
 134 -- | DELETE Phylo == delete a node
 135 ------------------------------------------------------------------------
 136 ------------------------------------------------------------------------
 137 {-
 138 type PutPhylo = (Put '[JSON] Phylo  )
 139 --putPhylo :: PhyloId -> Maybe ListId -> PhyloQueryBuild -> Phylo
 140 putPhylo :: PhyloId -> GargServer PutPhylo
 141 putPhylo = undefined
 142 -}
 143
 144
 145 -- | Instances
 146 -- instance Arbitrary Phylo             where arbitrary     = elements [phylo]
 147 instance Arbitrary PhyloGroup        where arbitrary     = elements []
 148 -- instance Arbitrary PhyloView         where arbitrary     = elements [phyloView]
 149 instance FromHttpApiData DisplayMode where parseUrlPiece = readTextData
 150 instance FromHttpApiData ExportMode  where parseUrlPiece = readTextData
 151 instance FromHttpApiData Filiation   where parseUrlPiece = readTextData
 152 instance FromHttpApiData Metric      where parseUrlPiece = readTextData
 153 instance FromHttpApiData Order       where parseUrlPiece = readTextData
 154 instance FromHttpApiData Sort        where parseUrlPiece = readTextData
 155 instance FromHttpApiData Tagger      where parseUrlPiece = readTextData
 156 instance FromHttpApiData [Metric]    where parseUrlPiece = readTextData
 157 instance FromHttpApiData [Tagger]    where parseUrlPiece = readTextData
 158 instance ToParamSchema   DisplayMode
 159 instance ToParamSchema   ExportMode
 160 instance ToParamSchema   Filiation
 161 instance ToParamSchema   Tagger
 162 instance ToParamSchema Metric
 163 instance ToParamSchema Order
 164 instance ToParamSchema Sort
 165 instance ToSchema Order
 166