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]) $ SmallBranch <$> (SBParams <$> 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 actantsTrees)
 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 PhyloRoots
 148 instance ToSchema PhyloPeriod
 149 instance ToSchema PhyloQueryBuild
 150 instance ToSchema PhyloView
 151 instance ToSchema RCParams
 152 instance ToSchema SBParams
 153 instance ToSchema Software
 154 instance ToSchema WLJParams
 155
 156
 157 instance ToParamSchema Order
 158 instance FromHttpApiData Order
 159   where
 160     parseUrlPiece = readTextData
 161
 162
 163 instance ToParamSchema Metric
 164 instance FromHttpApiData [Metric]
 165   where
 166     parseUrlPiece = readTextData
 167 instance FromHttpApiData Metric
 168   where
 169     parseUrlPiece = readTextData
 170
 171
 172 instance ToParamSchema   DisplayMode
 173 instance FromHttpApiData DisplayMode
 174   where
 175     parseUrlPiece = readTextData
 176
 177
 178 instance ToParamSchema   ExportMode
 179 instance FromHttpApiData ExportMode
 180   where
 181     parseUrlPiece = readTextData
 182
 183
 184 instance FromHttpApiData Sort
 185   where
 186     parseUrlPiece = readTextData
 187 instance ToParamSchema Sort
 188
 189 instance (ToSchema a) => ToSchema (Tree a)
 190   where
 191     declareNamedSchema = genericDeclareNamedSchemaUnrestricted
 192                        $ swaggerOptions ""
 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