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