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   -- TODO remove phylo for real data here
  86
  87 ------------------------------------------------------------------------
  88 {-
  89 type PutPhylo = (Put '[JSON] Phylo  )
  90 --putPhylo :: PhyloId -> Maybe ListId -> PhyloQueryBuild -> Phylo
  91 putPhylo :: PhyloId -> GargServer PutPhylo
  92 putPhylo = undefined
  93 -}
  94 ------------------------------------------------------------------------
  95 type PostPhylo =  QueryParam "listId" ListId
  96                :> ReqBody '[JSON] PhyloQueryBuild
  97                :> (Post '[JSON] Phylo)
  98
  99 postPhylo :: CorpusId -> GargServer PostPhylo
 100 postPhylo _n _lId q = do
 101   -- TODO get Reader settings
 102   -- s <- ask
 103   let
 104     vrs = Just ("1" :: Text)
 105     sft = Just (Software "Gargantext" "4")
 106     prm = initPhyloParam vrs sft (Just q)
 107   pure (toPhyloBase q prm corpus actants termList)
 108
 109
 110 ------------------------------------------------------------------------
 111 -- | DELETE Phylo == delete a node
 112 ------------------------------------------------------------------------
 113
 114
 115
 116
 117 -- | Instances
 118 instance Arbitrary PhyloView
 119   where
 120     arbitrary = elements [phyloView]
 121
 122 -- | TODO add phyloGroup ex
 123 instance Arbitrary PhyloGroup
 124   where
 125     arbitrary = elements []
 126
 127 instance Arbitrary Phylo
 128   where
 129     arbitrary = elements [phylo]
 130
 131
 132 instance ToSchema Cluster
 133 instance ToSchema EdgeType
 134 instance ToSchema Filiation
 135 instance ToSchema Filter
 136 instance ToSchema FisParams
 137 instance ToSchema HammingParams
 138 instance ToSchema LouvainParams
 139 instance ToSchema Metric
 140 instance ToSchema Order
 141 instance ToSchema Phylo
 142 instance ToSchema PhyloBranch
 143 instance ToSchema PhyloEdge
 144 instance ToSchema PhyloGroup
 145 instance ToSchema PhyloLevel
 146 instance ToSchema PhyloNode
 147 instance ToSchema PhyloParam
 148 instance ToSchema PhyloFoundations
 149 instance ToSchema PhyloPeriod
 150 instance ToSchema PhyloQueryBuild
 151 instance ToSchema PhyloView
 152 instance ToSchema RCParams
 153 instance ToSchema LBParams
 154 instance ToSchema SBParams
 155 instance ToSchema Software
 156 instance ToSchema WLJParams
 157
 158
 159 instance ToParamSchema Order
 160 instance FromHttpApiData Order
 161   where
 162     parseUrlPiece = readTextData
 163
 164
 165 instance ToParamSchema Metric
 166 instance FromHttpApiData [Metric]
 167   where
 168     parseUrlPiece = readTextData
 169 instance FromHttpApiData Metric
 170   where
 171     parseUrlPiece = readTextData
 172
 173
 174 instance ToParamSchema   DisplayMode
 175 instance FromHttpApiData DisplayMode
 176   where
 177     parseUrlPiece = readTextData
 178
 179
 180 instance ToParamSchema   ExportMode
 181 instance FromHttpApiData ExportMode
 182   where
 183     parseUrlPiece = readTextData
 184
 185
 186 instance FromHttpApiData Sort
 187   where
 188     parseUrlPiece = readTextData
 189 instance ToParamSchema Sort
 190
 191
 192 instance ToSchema Proximity
 193   where
 194     declareNamedSchema = genericDeclareNamedSchemaUnrestricted
 195                        $ swaggerOptions ""
 196
 197
 198 instance FromHttpApiData [Tagger]
 199   where
 200     parseUrlPiece = readTextData
 201 instance FromHttpApiData Tagger
 202   where
 203     parseUrlPiece = readTextData
 204 instance ToParamSchema   Tagger
 205
 206 instance FromHttpApiData Filiation
 207   where
 208     parseUrlPiece = readTextData
 209 instance ToParamSchema   Filiation
 210
 211