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 (getClosestParentIdByType)
  34 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
  35 import Gargantext.Prelude
  36 import Network.HTTP.Media ((//), (/:))
  37 import Servant
  38 import Test.QuickCheck (elements)
  39 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  40 import Web.HttpApiData (readTextData)
  41 import qualified Data.ByteString as DB
  42 import qualified Data.ByteString.Lazy as DBL
  43
  44 ------------------------------------------------------------------------
  45 type PhyloAPI = Summary "Phylo API"
  46               :> GetPhylo
  47         --    :<|> PutPhylo
  48             :<|> PostPhylo
  49
  50
  51 phyloAPI :: PhyloId -> UserId -> GargServer PhyloAPI
  52 phyloAPI n u = getPhylo  n
  53         :<|> postPhylo n u
  54         -- :<|> putPhylo  n
  55         -- :<|> deletePhylo  n
  56
  57 newtype SVG = SVG DB.ByteString
  58 --instance Show a => MimeRender PlainText a where mimeRender _ val = cs ("" <> show val)
  59 instance Accept SVG where contentType _ = "SVG" // "image/svg+xml" /: ("charset", "utf-8")
  60 instance MimeRender SVG SVG where mimeRender _ (SVG s) = DBL.fromStrict s
  61 instance MimeUnrender SVG SVG where mimeUnrender _ lbs = Right $ SVG (DBL.toStrict lbs)
  62 instance Show SVG where show (SVG a) = show a
  63 instance ToSchema SVG where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
  64
  65 ------------------------------------------------------------------------
  66 instance ToSchema Value where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
  67
  68 ------------------------------------------------------------------------
  69 type GetPhylo =  QueryParam "listId"      ListId
  70               :> QueryParam "level"       Level
  71               :> QueryParam "minSizeBranch" MinSizeBranch
  72    {-           :> QueryParam "filiation"   Filiation
  73               :> QueryParam "childs"      Bool
  74               :> QueryParam "depth"       Level
  75               :> QueryParam "metrics"    [Metric]
  76               :> QueryParam "periodsInf" Int
  77               :> QueryParam "periodsSup" Int
  78               :> QueryParam "minNodes"   Int
  79               :> QueryParam "taggers"    [Tagger]
  80               :> QueryParam "sort"       Sort
  81               :> QueryParam "order"      Order
  82               :> QueryParam "export"    ExportMode
  83               :> QueryParam "display"    DisplayMode
  84               :> QueryParam "verbose"     Bool
  85     -}
  86               -- :> Get '[SVG] SVG
  87               :> Get '[JSON] Value
  88
  89 -- | TODO
  90 -- Add real text processing
  91 -- Fix Filter parameters
  92 -- TODO fix parameters to default config that should be in Node
  93 getPhylo :: PhyloId -> GargServer GetPhylo
  94 getPhylo phyloId _lId _level _minSizeBranch = do
  95   theData <- getPhyloDataJson phyloId
  96   -- printDebug "getPhylo" theData
  97   pure theData
  98
  99 getPhyloDataJson :: PhyloId -> GargNoServer Value
 100 getPhyloDataJson phyloId = do
 101   phyloData <- fromMaybe phyloExample <$> getPhyloData phyloId
 102   phyloJson <- liftBase $ phylo2dot2json phyloData
 103   pure phyloJson
 104
 105
 106 -- getPhyloDataSVG phId _lId l msb  = do
 107   -- let
 108   --   level = fromMaybe 2 l
 109   --   branc = fromMaybe 2 msb
 110   --   maybePhylo = phNode ^. (node_hyperdata . hp_data)
 111
 112   -- p <- liftBase $ viewPhylo2Svg
 113   --               $ viewPhylo level branc
 114   --               $ fromMaybe phyloFromQuery maybePhylo
 115   -- pure (SVG p)
 116
 117
 118 ------------------------------------------------------------------------
 119 type PostPhylo =  QueryParam "listId" ListId
 120                -- :> ReqBody '[JSON] PhyloQueryBuild
 121                :> (Post '[JSON] NodeId)
 122
 123 postPhylo :: PhyloId -> UserId -> GargServer PostPhylo
 124 postPhylo phyloId _userId _lId = do
 125   -- TODO get Reader settings
 126   -- s <- ask
 127   -- let
 128     -- _vrs = Just ("1" :: Text)
 129     -- _sft = Just (Software "Gargantext" "4")
 130     -- _prm = initPhyloParam vrs sft (Just q)
 131   corpusId <- getClosestParentIdByType phyloId NodeCorpus
 132   phy <- flowPhyloAPI defaultConfig (fromMaybe (panic "[G.C.V.P.API] no corpus ID found") corpusId) -- params
 133   -- phyloId <- insertNodes [node NodePhylo "Phylo" (HyperdataPhylo Nothing (Just phy)) (Just corpusId) userId]
 134   _ <- updateHyperdata phyloId (HyperdataPhylo Nothing (Just phy))
 135   pure phyloId
 136
 137 ------------------------------------------------------------------------
 138 -- | DELETE Phylo == delete a node
 139 ------------------------------------------------------------------------
 140 ------------------------------------------------------------------------
 141 {-
 142 type PutPhylo = (Put '[JSON] Phylo  )
 143 --putPhylo :: PhyloId -> Maybe ListId -> PhyloQueryBuild -> Phylo
 144 putPhylo :: PhyloId -> GargServer PutPhylo
 145 putPhylo = undefined
 146 -}
 147
 148
 149 -- | Instances
 150 -- instance Arbitrary Phylo             where arbitrary     = elements [phylo]
 151 instance Arbitrary PhyloGroup        where arbitrary     = elements []
 152 -- instance Arbitrary PhyloView         where arbitrary     = elements [phyloView]
 153 instance FromHttpApiData DisplayMode where parseUrlPiece = readTextData
 154 instance FromHttpApiData ExportMode  where parseUrlPiece = readTextData
 155 instance FromHttpApiData Filiation   where parseUrlPiece = readTextData
 156 instance FromHttpApiData Metric      where parseUrlPiece = readTextData
 157 instance FromHttpApiData Order       where parseUrlPiece = readTextData
 158 instance FromHttpApiData Sort        where parseUrlPiece = readTextData
 159 instance FromHttpApiData Tagger      where parseUrlPiece = readTextData
 160 instance FromHttpApiData [Metric]    where parseUrlPiece = readTextData
 161 instance FromHttpApiData [Tagger]    where parseUrlPiece = readTextData
 162 instance ToParamSchema   DisplayMode
 163 instance ToParamSchema   ExportMode
 164 instance ToParamSchema   Filiation
 165 instance ToParamSchema   Tagger
 166 instance ToParamSchema Metric
 167 instance ToParamSchema Order
 168 instance ToParamSchema Sort
 169 instance ToSchema Order
 170