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 Data.Swagger
  28 import Gargantext.API.Types
  29 import Gargantext.Database.Types.Node (PhyloId, ListId, CorpusId)
  30 import Gargantext.Prelude
  31 import Gargantext.Viz.Phylo
  32 import Gargantext.Viz.Phylo.Example
  33 import Gargantext.Viz.Phylo.Tools
  34 import Gargantext.Viz.Phylo.View.ViewMaker
  35 import Servant
  36 import Servant.Job.Utils (swaggerOptions)
  37 import Test.QuickCheck (elements)
  38 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  39 import Web.HttpApiData (parseUrlPiece, readTextData)
  40
  41 ------------------------------------------------------------------------
  42 type PhyloAPI = Summary "Phylo API"
  43      --         :> QueryParam "param" PhyloQueryView
  44              -- :<|>
  45               :> GetPhylo
  46             :<|> PutPhylo
  47               -- :<|> Capture "id" PhyloId :> Post '[JSON] Phylo
  48               -- :<|> Capture "id" PhyloId :> Put  '[JSON] Phylo
  49
  50
  51 phyloAPI :: PhyloId -> GargServer PhyloAPI
  52 phyloAPI n = getPhylo n
  53         :<|> putPhylo n
  54            -- :<|> pure . (postPhylo n)
  55
  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 "sort"       Order
  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 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 d b'
  83   -- | TODO remove phylo for real data here
  84   pure (toPhyloView  q phylo)
  85
  86 ------------------------------------------------------------------------
  87 type PutPhylo = (Put '[JSON] Phylo  )
  88 --putPhylo :: PhyloId -> Maybe ListId -> PhyloQueryBuild -> Phylo
  89 putPhylo :: PhyloId -> GargServer PutPhylo
  90 putPhylo = undefined
  91
  92
  93 ------------------------------------------------------------------------
  94 type PostPhylo = (Post '[JSON] Phylo)
  95 --postPhylo :: CorpusId -> Maybe ListId -> PhyloQueryBuild -> Phylo
  96 postPhylo :: CorpusId -> Phylo
  97 postPhylo = undefined
  98
  99 ------------------------------------------------------------------------
 100 -- | DELETE Phylo == delete a node
 101 ------------------------------------------------------------------------
 102
 103 -- | Instances
 104 instance Arbitrary PhyloView
 105   where
 106     arbitrary = elements [phyloView]
 107
 108 -- | TODO add phyloGroup ex
 109 instance Arbitrary PhyloGroup
 110   where
 111     arbitrary = elements []
 112
 113 instance Arbitrary Phylo
 114   where
 115     arbitrary = elements [phylo]
 116
 117
 118
 119
 120 instance ToSchema Cluster
 121 instance ToSchema EdgeType
 122 instance ToSchema Filiation
 123 instance ToSchema Filter
 124 instance ToSchema FisParams
 125 instance ToSchema HammingParams
 126 instance ToSchema LouvainParams
 127 instance ToSchema Metric
 128 instance ToSchema Order
 129 instance ToSchema Phylo
 130 instance ToSchema PhyloBranch
 131 instance ToSchema PhyloEdge
 132 instance ToSchema PhyloGroup
 133 instance ToSchema PhyloLevel
 134 instance ToSchema PhyloNode
 135 instance ToSchema PhyloParam
 136 instance ToSchema PhyloPeaks
 137 instance ToSchema PhyloPeriod
 138 instance ToSchema PhyloQueryBuild
 139 instance ToSchema PhyloView
 140 instance ToSchema RCParams
 141 instance ToSchema SBParams
 142 instance ToSchema Software
 143 instance ToSchema WLJParams
 144
 145
 146 instance ToParamSchema Order
 147 instance FromHttpApiData Order
 148   where
 149     parseUrlPiece = readTextData
 150
 151
 152 instance ToParamSchema Metric
 153 instance FromHttpApiData [Metric]
 154   where
 155     parseUrlPiece = readTextData
 156 instance FromHttpApiData Metric
 157   where
 158     parseUrlPiece = readTextData
 159
 160
 161 instance ToParamSchema   DisplayMode
 162 instance FromHttpApiData DisplayMode
 163   where
 164     parseUrlPiece = readTextData
 165
 166
 167 instance FromHttpApiData Sort
 168   where
 169     parseUrlPiece = readTextData
 170 instance ToParamSchema Sort
 171
 172 instance (ToSchema a) => ToSchema (Tree a)
 173   where
 174     declareNamedSchema = genericDeclareNamedSchemaUnrestricted
 175                        $ swaggerOptions ""
 176
 177 instance ToSchema Proximity
 178   where
 179     declareNamedSchema = genericDeclareNamedSchemaUnrestricted
 180                        $ swaggerOptions ""
 181
 182
 183 instance FromHttpApiData [Tagger]
 184   where
 185     parseUrlPiece = readTextData
 186 instance FromHttpApiData Tagger
 187   where
 188     parseUrlPiece = readTextData
 189 instance ToParamSchema   Tagger
 190
 191 instance FromHttpApiData Filiation
 192   where
 193     parseUrlPiece = readTextData
 194 instance ToParamSchema   Filiation
 195
 196
 197