src/Gargantext/Viz/Phylo/API.hs

   1 {-|
   2 Module      : Gargantext.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
  13 {-# OPTIONS_GHC -fno-warn-orphans #-}
  14
  15
  16 {-# LANGUAGE RankNTypes         #-}
  17 {-# LANGUAGE DataKinds          #-}
  18 {-# LANGUAGE NoImplicitPrelude  #-}
  19 {-# LANGUAGE OverloadedStrings  #-}   -- allows to write Text literals
  20 {-# LANGUAGE OverloadedLists    #-}   -- allows to write Map and HashMap as lists
  21 {-# LANGUAGE TypeOperators      #-}
  22 {-# LANGUAGE FlexibleInstances  #-}
  23
  24 module Gargantext.Viz.Phylo.API
  25   where
  26
  27 --import Control.Monad.Reader (ask)
  28 import Data.Text (Text)
  29 import Data.Map  (empty)
  30 import Data.Swagger
  31 import Gargantext.API.Types
  32 import Gargantext.Database.Types.Node (PhyloId, ListId, CorpusId)
  33 import Gargantext.Prelude
  34 import Gargantext.Viz.Phylo
  35 import Gargantext.Viz.Phylo.Aggregates
  36 import Gargantext.Viz.Phylo.Example
  37 import Gargantext.Viz.Phylo.Tools
  38 import Gargantext.Viz.Phylo.View.ViewMaker
  39 import Gargantext.Viz.Phylo.LevelMaker
  40 import Servant
  41 import Servant.Job.Utils (swaggerOptions)
  42 import Test.QuickCheck (elements)
  43 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  44 import Web.HttpApiData (parseUrlPiece, readTextData)
  45
  46 ------------------------------------------------------------------------
  47 type PhyloAPI = Summary "Phylo API"
  48               :> GetPhylo
  49         --    :<|> PutPhylo
  50             :<|> PostPhylo
  51
  52
  53 phyloAPI :: PhyloId -> GargServer PhyloAPI
  54 phyloAPI n = getPhylo  n
  55         -- :<|> putPhylo  n
  56         :<|> postPhylo n
  57
  58 ------------------------------------------------------------------------
  59 type GetPhylo =  QueryParam "listId"      ListId
  60               :> QueryParam "level"       Level
  61               :> QueryParam "filiation"   Filiation
  62               :> QueryParam "childs"      Bool
  63               :> QueryParam "depth"       Level
  64               :> QueryParam "metrics"    [Metric]
  65               :> QueryParam "periodsInf" Int
  66               :> QueryParam "periodsSup" Int
  67               :> QueryParam "minNodes"   Int
  68               :> QueryParam "taggers"    [Tagger]
  69               :> QueryParam "sort"       Sort
  70               :> QueryParam "order"      Order
  71               :> QueryParam "export"    ExportMode
  72               :> QueryParam "display"    DisplayMode
  73               :> QueryParam "verbose"     Bool
  74               :> Get '[JSON] PhyloView
  75
  76 -- | TODO
  77 -- Add real text processing
  78 -- Fix Filter parameters
  79 getPhylo :: PhyloId -> GargServer GetPhylo
  80 getPhylo _phyloId _lId l f b l' ms x y z ts s o e d b' = do
  81   let
  82     fs' = maybe (Just []) (\p -> Just [p]) $ LonelyBranch <$> (LBParams <$> x <*> y <*> z)
  83     so  = (,) <$> s <*> o
  84     q = initPhyloQueryView l f b l' ms fs' ts so e d b'
  85   -- | TODO remove phylo for real data here
  86   pure (toPhyloView  q phylo)
  87   -- TODO remove phylo for real data here
  88
  89 ------------------------------------------------------------------------
  90 {-
  91 type PutPhylo = (Put '[JSON] Phylo  )
  92 --putPhylo :: PhyloId -> Maybe ListId -> PhyloQueryBuild -> Phylo
  93 putPhylo :: PhyloId -> GargServer PutPhylo
  94 putPhylo = undefined
  95 -}
  96 ------------------------------------------------------------------------
  97 type PostPhylo =  QueryParam "listId" ListId
  98                :> ReqBody '[JSON] PhyloQueryBuild
  99                :> (Post '[JSON] Phylo)
 100
 101 postPhylo :: CorpusId -> GargServer PostPhylo
 102 postPhylo _n _lId q = do
 103   -- TODO get Reader settings
 104   -- s <- ask
 105   let
 106     vrs = Just ("1" :: Text)
 107     sft = Just (Software "Gargantext" "4")
 108     prm = initPhyloParam vrs sft (Just q)
 109   pure (toPhyloBase q prm (parseDocs (initFoundationsRoots actants) corpus) termList empty)
 110
 111
 112 ------------------------------------------------------------------------
 113 -- | DELETE Phylo == delete a node
 114 ------------------------------------------------------------------------
 115
 116
 117
 118
 119 -- | Instances
 120 instance Arbitrary PhyloView
 121   where
 122     arbitrary = elements [phyloView]
 123
 124 -- | TODO add phyloGroup ex
 125 instance Arbitrary PhyloGroup
 126   where
 127     arbitrary = elements []
 128
 129 instance Arbitrary Phylo
 130   where
 131     arbitrary = elements [phylo]
 132
 133
 134 instance ToSchema Cluster
 135 instance ToSchema EdgeType
 136 instance ToSchema Filiation
 137 instance ToSchema Filter
 138 instance ToSchema FisParams
 139 instance ToSchema HammingParams
 140 instance ToSchema LouvainParams
 141 instance ToSchema Metric
 142 instance ToSchema Order
 143 instance ToSchema Phylo
 144 instance ToSchema PhyloFis
 145 instance ToSchema PhyloBranch
 146 instance ToSchema PhyloEdge
 147 instance ToSchema PhyloGroup
 148 instance ToSchema PhyloLevel
 149 instance ToSchema PhyloNode
 150 instance ToSchema PhyloParam
 151 instance ToSchema PhyloFoundations
 152 instance ToSchema PhyloPeriod
 153 instance ToSchema PhyloQueryBuild
 154 instance ToSchema PhyloView
 155 instance ToSchema RCParams
 156 instance ToSchema LBParams
 157 instance ToSchema SBParams
 158 instance ToSchema Software
 159 instance ToSchema WLJParams
 160
 161
 162 instance ToParamSchema Order
 163 instance FromHttpApiData Order
 164   where
 165     parseUrlPiece = readTextData
 166
 167
 168 instance ToParamSchema Metric
 169 instance FromHttpApiData [Metric]
 170   where
 171     parseUrlPiece = readTextData
 172 instance FromHttpApiData Metric
 173   where
 174     parseUrlPiece = readTextData
 175
 176
 177 instance ToParamSchema   DisplayMode
 178 instance FromHttpApiData DisplayMode
 179   where
 180     parseUrlPiece = readTextData
 181
 182
 183 instance ToParamSchema   ExportMode
 184 instance FromHttpApiData ExportMode
 185   where
 186     parseUrlPiece = readTextData
 187
 188
 189 instance FromHttpApiData Sort
 190   where
 191     parseUrlPiece = readTextData
 192 instance ToParamSchema Sort
 193
 194
 195 instance ToSchema Proximity
 196   where
 197     declareNamedSchema = genericDeclareNamedSchemaUnrestricted
 198                        $ swaggerOptions ""
 199
 200
 201 instance FromHttpApiData [Tagger]
 202   where
 203     parseUrlPiece = readTextData
 204 instance FromHttpApiData Tagger
 205   where
 206     parseUrlPiece = readTextData
 207 instance ToParamSchema   Tagger
 208
 209 instance FromHttpApiData Filiation
 210   where
 211     parseUrlPiece = readTextData
 212 instance ToParamSchema   Filiation
 213
 214