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 import Data.Either
  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 instance MimeUnrender SVG SVG where
  76    mimeUnrender _ lbs = Right $ SVG (DBL.toStrict lbs)
  77
  78 ------------------------------------------------------------------------
  79 type GetPhylo =  QueryParam "listId"      ListId
  80               :> QueryParam "level"       Level
  81               :> QueryParam "minSizeBranch" MinSizeBranch
  82    {-           :> QueryParam "filiation"   Filiation
  83               :> QueryParam "childs"      Bool
  84               :> QueryParam "depth"       Level
  85               :> QueryParam "metrics"    [Metric]
  86               :> QueryParam "periodsInf" Int
  87               :> QueryParam "periodsSup" Int
  88               :> QueryParam "minNodes"   Int
  89               :> QueryParam "taggers"    [Tagger]
  90               :> QueryParam "sort"       Sort
  91               :> QueryParam "order"      Order
  92               :> QueryParam "export"    ExportMode
  93               :> QueryParam "display"    DisplayMode
  94               :> QueryParam "verbose"     Bool
  95     -}
  96               :> Get '[SVG] SVG
  97
  98 -- | TODO
  99 -- Add real text processing
 100 -- Fix Filter parameters
 101 getPhylo :: PhyloId -> GargServer GetPhylo
 102 getPhylo _ _lId _ _  = undefined
 103 -- getPhylo phId _lId l msb  = do
 104   -- phNode     <- getNodeWith phId (Proxy :: Proxy HyperdataPhylo)
 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 <- flowPhylo 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
 167