src/Gargantext/Core/Viz/Phylo/Legacy/LegacyAPI.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.Legacy.LegacyAPI
  18   where
  19
  20 -- import Data.Maybe (fromMaybe)
  21 -- import Control.Lens ((^.))
  22 import Data.String.Conversions
  23 --import Control.Monad.Reader (ask)
  24 import qualified Data.ByteString as DB
  25 import qualified Data.ByteString.Lazy as DBL
  26 import Data.Swagger
  27 import Network.HTTP.Media ((//), (/:))
  28 import Servant
  29 import Test.QuickCheck (elements)
  30 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  31 import Web.HttpApiData (readTextData)
  32
  33 import Gargantext.API.Prelude
  34 import Gargantext.Database.Admin.Types.Hyperdata
  35 import Gargantext.Database.Admin.Types.Node -- (PhyloId, ListId, CorpusId, UserId, NodeId(..))
  36 import Gargantext.Database.Query.Table.Node (insertNodes, node)
  37 -- import Gargantext.Database.Schema.Node (node_hyperdata)
  38 import Gargantext.Prelude
  39 import Gargantext.Core.Viz.LegacyPhylo
  40 import Gargantext.Core.Viz.Phylo.Legacy.LegacyMain
  41 -- import Gargantext.Core.Viz.Phylo.Example
  42 import Gargantext.Core.Types (TODO(..))
  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
  59 instance ToSchema SVG
  60   where
  61     declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
  62
  63 instance Show SVG where
  64   show (SVG a) = show a
  65
  66 instance Accept SVG where
  67    contentType _ = "SVG" // "image/svg+xml" /: ("charset", "utf-8")
  68
  69 instance Show a => MimeRender PlainText a where
  70    mimeRender _ val = cs ("" <> show val)
  71
  72 instance MimeRender SVG SVG where
  73    mimeRender _ (SVG s) = DBL.fromStrict s
  74
  75 ------------------------------------------------------------------------
  76 type GetPhylo =  QueryParam "listId"      ListId
  77               :> QueryParam "level"       Level
  78               :> QueryParam "minSizeBranch" MinSizeBranch
  79    {-           :> QueryParam "filiation"   Filiation
  80               :> QueryParam "childs"      Bool
  81               :> QueryParam "depth"       Level
  82               :> QueryParam "metrics"    [Metric]
  83               :> QueryParam "periodsInf" Int
  84               :> QueryParam "periodsSup" Int
  85               :> QueryParam "minNodes"   Int
  86               :> QueryParam "taggers"    [Tagger]
  87               :> QueryParam "sort"       Sort
  88               :> QueryParam "order"      Order
  89               :> QueryParam "export"    ExportMode
  90               :> QueryParam "display"    DisplayMode
  91               :> QueryParam "verbose"     Bool
  92     -}
  93               :> Get '[SVG] SVG
  94
  95 -- | TODO
  96 -- Add real text processing
  97 -- Fix Filter parameters
  98 getPhylo :: PhyloId -> GargServer GetPhylo
  99 getPhylo _ _lId _ _  = undefined
 100 -- getPhylo phId _lId l msb  = do
 101   -- phNode     <- getNodeWith phId (Proxy :: Proxy HyperdataPhylo)
 102   -- let
 103   --   level = fromMaybe 2 l
 104   --   branc = fromMaybe 2 msb
 105   --   maybePhylo = phNode ^. (node_hyperdata . hp_data)
 106
 107   -- p <- liftBase $ viewPhylo2Svg
 108   --               $ viewPhylo level branc
 109   --               $ fromMaybe phyloFromQuery maybePhylo
 110   -- pure (SVG p)
 111
 112
 113 ------------------------------------------------------------------------
 114 type PostPhylo =  QueryParam "listId" ListId
 115                -- :> ReqBody '[JSON] PhyloQueryBuild
 116                :> (Post '[JSON] NodeId)
 117
 118 postPhylo :: CorpusId -> UserId -> GargServer PostPhylo
 119 postPhylo corpusId userId _lId = do
 120   -- TODO get Reader settings
 121   -- s <- ask
 122   -- let
 123     -- _vrs = Just ("1" :: Text)
 124     -- _sft = Just (Software "Gargantext" "4")
 125     -- _prm = initPhyloParam vrs sft (Just q)
 126   phy <- flowPhylo corpusId -- params
 127   phyloId <- insertNodes [node NodePhylo "Phylo" (HyperdataPhylo Nothing (Just phy)) (Just corpusId) userId]
 128   pure $ NodeId (fromIntegral phyloId)
 129
 130 ------------------------------------------------------------------------
 131 -- | DELETE Phylo == delete a node
 132 ------------------------------------------------------------------------
 133 ------------------------------------------------------------------------
 134 {-
 135 type PutPhylo = (Put '[JSON] Phylo  )
 136 --putPhylo :: PhyloId -> Maybe ListId -> PhyloQueryBuild -> Phylo
 137 putPhylo :: PhyloId -> GargServer PutPhylo
 138 putPhylo = undefined
 139 -}
 140
 141
 142 -- | Instances
 143 -- instance Arbitrary Phylo             where arbitrary     = elements [phylo]
 144 instance Arbitrary PhyloGroup        where arbitrary     = elements []
 145 -- instance Arbitrary PhyloView         where arbitrary     = elements [phyloView]
 146 instance FromHttpApiData DisplayMode where parseUrlPiece = readTextData
 147 instance FromHttpApiData ExportMode  where parseUrlPiece = readTextData
 148 instance FromHttpApiData Filiation   where parseUrlPiece = readTextData
 149 instance FromHttpApiData Metric      where parseUrlPiece = readTextData
 150 instance FromHttpApiData Order       where parseUrlPiece = readTextData
 151 instance FromHttpApiData Sort        where parseUrlPiece = readTextData
 152 instance FromHttpApiData Tagger      where parseUrlPiece = readTextData
 153 instance FromHttpApiData [Metric]    where parseUrlPiece = readTextData
 154 instance FromHttpApiData [Tagger]    where parseUrlPiece = readTextData
 155 instance ToParamSchema   DisplayMode
 156 instance ToParamSchema   ExportMode
 157 instance ToParamSchema   Filiation
 158 instance ToParamSchema   Tagger
 159 instance ToParamSchema Metric
 160 instance ToParamSchema Order
 161 instance ToParamSchema Sort
 162 instance ToSchema Order
 163
 164