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