]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Viz/Phylo/API.hs
[Date] Date of Node is date of HyperdataDocument.
[gargantext.git] / 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 "display" DisplayMode
70 :> QueryParam "verbose" Bool
71 :> Get '[JSON] PhyloView
72
73 -- | TODO
74 -- Add real text processing
75 -- Fix Filter parameters
76 getPhylo :: PhyloId -> GargServer GetPhylo
77 getPhylo _phyloId _lId l f b l' ms x y z ts s o d b' = do
78 let
79 fs' = maybe (Just []) (\p -> Just [p]) $ SmallBranch <$> (SBParams <$> x <*> y <*> z)
80 so = (,) <$> s <*> o
81 q = initPhyloQueryView l f b l' ms fs' ts so d b'
82 pure (toPhyloView q phylo)
83 -- TODO remove phylo for real data here
84
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 type PostPhylo = QueryParam "listId" ListId
94 :> ReqBody '[JSON] PhyloQueryBuild
95 :> (Post '[JSON] Phylo)
96
97 postPhylo :: CorpusId -> GargServer PostPhylo
98 postPhylo _n _lId q = do
99 -- TODO get Reader settings
100 -- s <- ask
101 let
102 vrs = Just ("1" :: Text)
103 sft = Just (Software "Gargantext" "4")
104 prm = initPhyloParam vrs sft (Just q)
105 pure (toPhyloBase q prm corpus actants actantsTrees)
106
107
108 ------------------------------------------------------------------------
109 -- | DELETE Phylo == delete a node
110 ------------------------------------------------------------------------
111
112
113
114
115 -- | Instances
116 instance Arbitrary PhyloView
117 where
118 arbitrary = elements [phyloView]
119
120 -- | TODO add phyloGroup ex
121 instance Arbitrary PhyloGroup
122 where
123 arbitrary = elements []
124
125 instance Arbitrary Phylo
126 where
127 arbitrary = elements [phylo]
128
129
130 instance ToSchema Cluster
131 instance ToSchema EdgeType
132 instance ToSchema Filiation
133 instance ToSchema Filter
134 instance ToSchema FisParams
135 instance ToSchema HammingParams
136 instance ToSchema LouvainParams
137 instance ToSchema Metric
138 instance ToSchema Order
139 instance ToSchema Phylo
140 instance ToSchema PhyloBranch
141 instance ToSchema PhyloEdge
142 instance ToSchema PhyloGroup
143 instance ToSchema PhyloLevel
144 instance ToSchema PhyloNode
145 instance ToSchema PhyloParam
146 instance ToSchema PhyloPeaks
147 instance ToSchema PhyloPeriod
148 instance ToSchema PhyloQueryBuild
149 instance ToSchema PhyloView
150 instance ToSchema RCParams
151 instance ToSchema SBParams
152 instance ToSchema Software
153 instance ToSchema WLJParams
154
155
156 instance ToParamSchema Order
157 instance FromHttpApiData Order
158 where
159 parseUrlPiece = readTextData
160
161
162 instance ToParamSchema Metric
163 instance FromHttpApiData [Metric]
164 where
165 parseUrlPiece = readTextData
166 instance FromHttpApiData Metric
167 where
168 parseUrlPiece = readTextData
169
170
171 instance ToParamSchema DisplayMode
172 instance FromHttpApiData DisplayMode
173 where
174 parseUrlPiece = readTextData
175
176
177 instance FromHttpApiData Sort
178 where
179 parseUrlPiece = readTextData
180 instance ToParamSchema Sort
181
182 instance (ToSchema a) => ToSchema (Tree a)
183 where
184 declareNamedSchema = genericDeclareNamedSchemaUnrestricted
185 $ swaggerOptions ""
186
187 instance ToSchema Proximity
188 where
189 declareNamedSchema = genericDeclareNamedSchemaUnrestricted
190 $ swaggerOptions ""
191
192
193 instance FromHttpApiData [Tagger]
194 where
195 parseUrlPiece = readTextData
196 instance FromHttpApiData Tagger
197 where
198 parseUrlPiece = readTextData
199 instance ToParamSchema Tagger
200
201 instance FromHttpApiData Filiation
202 where
203 parseUrlPiece = readTextData
204 instance ToParamSchema Filiation
205
206