]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Viz/Phylo/API.hs
Merge branch 'dev' into dev-doc-table-optimization
[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 {-# OPTIONS_GHC -fno-warn-orphans #-}
13
14 {-# LANGUAGE OverloadedLists #-} -- allows to write Map and HashMap as lists
15 {-# LANGUAGE TypeOperators #-}
16
17 module Gargantext.Viz.Phylo.API
18 where
19
20 import Control.Lens ((^.))
21 import Data.String.Conversions
22 --import Control.Monad.Reader (ask)
23 import qualified Data.ByteString as DB
24 import qualified Data.ByteString.Lazy as DBL
25 import Data.Proxy (Proxy(..))
26 import Data.Swagger
27 import Network.HTTP.Media ((//), (/:))
28 import Servant
29 import Test.QuickCheck (elements)
30 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
31 import Web.HttpApiData (parseUrlPiece, readTextData)
32
33 import Gargantext.API.Prelude
34 import Gargantext.Database.Admin.Types.Hyperdata
35 import Gargantext.Database.Admin.Types.Node -- (PhyloId, ListId, CorpusId, UserId, NodeId(..))
36 import Gargantext.Database.Query.Table.Node (insertNodes, node, getNodeWith)
37 import Gargantext.Database.Schema.Node (node_hyperdata)
38 import Gargantext.Prelude
39 import Gargantext.Viz.Phylo
40 import Gargantext.Viz.Phylo.Main
41 import Gargantext.Viz.Phylo.Example
42 import Gargantext.Core.Types (TODO(..))
43
44 ------------------------------------------------------------------------
45 type PhyloAPI = Summary "Phylo API"
46 :> GetPhylo
47 -- :<|> PutPhylo
48 :<|> PostPhylo
49
50
51 phyloAPI :: PhyloId -> UserId -> GargServer PhyloAPI
52 phyloAPI n u = getPhylo n
53 :<|> postPhylo n u
54 -- :<|> putPhylo n
55 -- :<|> deletePhylo n
56
57 newtype SVG = SVG DB.ByteString
58
59 instance ToSchema SVG
60 where
61 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
62
63 instance Show SVG where
64 show (SVG a) = show a
65
66 instance Accept SVG where
67 contentType _ = "SVG" // "image/svg+xml" /: ("charset", "utf-8")
68
69 instance Show a => MimeRender PlainText a where
70 mimeRender _ val = cs ("" <> show val)
71
72 instance MimeRender SVG SVG where
73 mimeRender _ (SVG s) = DBL.fromStrict s
74
75 ------------------------------------------------------------------------
76 type GetPhylo = QueryParam "listId" ListId
77 :> QueryParam "level" Level
78 :> QueryParam "minSizeBranch" MinSizeBranch
79 {- :> QueryParam "filiation" Filiation
80 :> QueryParam "childs" Bool
81 :> QueryParam "depth" Level
82 :> QueryParam "metrics" [Metric]
83 :> QueryParam "periodsInf" Int
84 :> QueryParam "periodsSup" Int
85 :> QueryParam "minNodes" Int
86 :> QueryParam "taggers" [Tagger]
87 :> QueryParam "sort" Sort
88 :> QueryParam "order" Order
89 :> QueryParam "export" ExportMode
90 :> QueryParam "display" DisplayMode
91 :> QueryParam "verbose" Bool
92 -}
93 :> Get '[SVG] SVG
94
95 -- | TODO
96 -- Add real text processing
97 -- Fix Filter parameters
98 getPhylo :: PhyloId -> GargServer GetPhylo
99 getPhylo phId _lId l msb = do
100 phNode <- getNodeWith phId (Proxy :: Proxy HyperdataPhylo)
101 let
102 level = maybe 2 identity l
103 branc = maybe 2 identity msb
104 maybePhylo = phNode ^. (node_hyperdata . hp_data)
105
106 p <- liftBase $ viewPhylo2Svg
107 $ viewPhylo level branc
108 $ maybe phyloFromQuery identity maybePhylo
109 pure (SVG p)
110 ------------------------------------------------------------------------
111 type PostPhylo = QueryParam "listId" ListId
112 -- :> ReqBody '[JSON] PhyloQueryBuild
113 :> (Post '[JSON] NodeId)
114
115 postPhylo :: CorpusId -> UserId -> GargServer PostPhylo
116 postPhylo n userId _lId = do
117 -- TODO get Reader settings
118 -- s <- ask
119 let
120 -- _vrs = Just ("1" :: Text)
121 -- _sft = Just (Software "Gargantext" "4")
122 -- _prm = initPhyloParam vrs sft (Just q)
123 phy <- flowPhylo n
124 pId <- insertNodes [node NodePhylo "Phylo" (HyperdataPhylo Nothing (Just phy)) (Just n) userId]
125 pure $ NodeId (fromIntegral pId)
126
127 ------------------------------------------------------------------------
128 -- | DELETE Phylo == delete a node
129 ------------------------------------------------------------------------
130 ------------------------------------------------------------------------
131 {-
132 type PutPhylo = (Put '[JSON] Phylo )
133 --putPhylo :: PhyloId -> Maybe ListId -> PhyloQueryBuild -> Phylo
134 putPhylo :: PhyloId -> GargServer PutPhylo
135 putPhylo = undefined
136 -}
137
138
139 -- | Instances
140 instance Arbitrary PhyloView
141 where
142 arbitrary = elements [phyloView]
143
144 -- | TODO add phyloGroup ex
145 instance Arbitrary PhyloGroup
146 where
147 arbitrary = elements []
148
149 instance Arbitrary Phylo
150 where
151 arbitrary = elements [phylo]
152
153 instance ToSchema Order
154
155 instance ToParamSchema Order
156 instance FromHttpApiData Order
157 where
158 parseUrlPiece = readTextData
159
160
161 instance ToParamSchema Metric
162 instance FromHttpApiData [Metric]
163 where
164 parseUrlPiece = readTextData
165 instance FromHttpApiData Metric
166 where
167 parseUrlPiece = readTextData
168
169
170 instance ToParamSchema DisplayMode
171 instance FromHttpApiData DisplayMode
172 where
173 parseUrlPiece = readTextData
174
175
176 instance ToParamSchema ExportMode
177 instance FromHttpApiData ExportMode
178 where
179 parseUrlPiece = readTextData
180
181
182 instance FromHttpApiData Sort
183 where
184 parseUrlPiece = readTextData
185 instance ToParamSchema Sort
186
187 instance FromHttpApiData [Tagger]
188 where
189 parseUrlPiece = readTextData
190 instance FromHttpApiData Tagger
191 where
192 parseUrlPiece = readTextData
193 instance ToParamSchema Tagger
194
195 instance FromHttpApiData Filiation
196 where
197 parseUrlPiece = readTextData
198 instance ToParamSchema Filiation
199
200