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