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
12 {-# OPTIONS_GHC -fno-warn-orphans #-}
14 {-# LANGUAGE RankNTypes #-}
15 {-# LANGUAGE DataKinds #-}
16 {-# LANGUAGE NoImplicitPrelude #-}
17 {-# LANGUAGE OverloadedStrings #-} -- allows to write Text literals
18 {-# LANGUAGE OverloadedLists #-} -- allows to write Map and HashMap as lists
19 {-# LANGUAGE TypeOperators #-}
20 {-# LANGUAGE FlexibleInstances #-}
21 {-# LANGUAGE MultiParamTypeClasses #-}
23 module Gargantext.Viz.Phylo.API
26 import Data.String.Conversions
27 --import Control.Monad.Reader (ask)
28 import qualified Data.ByteString as DB
29 import qualified Data.ByteString.Lazy as DBL
30 import Data.Text (Text)
31 import Data.Map (empty)
33 import Gargantext.API.Types
34 import Gargantext.Database.Types.Node (PhyloId, ListId, CorpusId)
35 import Gargantext.Prelude
36 import Gargantext.Viz.Phylo
37 import Gargantext.Viz.Phylo.Main
38 import Gargantext.Viz.Phylo.Aggregates
39 import Gargantext.Viz.Phylo.Example
40 import Gargantext.Viz.Phylo.Tools
41 import Gargantext.API.Ngrams (TODO(..))
42 --import Gargantext.Viz.Phylo.View.ViewMaker
43 import Gargantext.Viz.Phylo.LevelMaker
45 import Servant.Job.Utils (swaggerOptions)
46 import Test.QuickCheck (elements)
47 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
48 import Web.HttpApiData (parseUrlPiece, readTextData)
49 import Control.Monad.IO.Class (liftIO)
50 import Network.HTTP.Media ((//), (/:))
52 ------------------------------------------------------------------------
53 type PhyloAPI = Summary "Phylo API"
59 phyloAPI :: PhyloId -> GargServer PhyloAPI
60 phyloAPI n = getPhylo' n
64 newtype SVG = SVG DB.ByteString
68 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
70 instance Show SVG where
73 instance Accept SVG where
74 contentType _ = "SVG" // "image/svg+xml" /: ("charset", "utf-8")
76 instance Show a => MimeRender PlainText a where
77 mimeRender _ val = cs ("" <> show val)
79 instance MimeRender SVG SVG where
80 mimeRender _ (SVG s) = DBL.fromStrict s
82 ------------------------------------------------------------------------
83 type GetPhylo = QueryParam "listId" ListId
84 :> QueryParam "level" Level
85 :> QueryParam "filiation" Filiation
86 :> QueryParam "childs" Bool
87 :> QueryParam "depth" Level
88 :> QueryParam "metrics" [Metric]
89 :> QueryParam "periodsInf" Int
90 :> QueryParam "periodsSup" Int
91 :> QueryParam "minNodes" Int
92 :> QueryParam "taggers" [Tagger]
93 :> QueryParam "sort" Sort
94 :> QueryParam "order" Order
95 :> QueryParam "export" ExportMode
96 :> QueryParam "display" DisplayMode
97 :> QueryParam "verbose" Bool
101 -- Add real text processing
102 -- Fix Filter parameters
104 getPhylo :: PhyloId -> GargServer GetPhylo
105 getPhylo _phyloId _lId l f b l' ms x y z ts s o e d b' = do
107 fs' = maybe (Just []) (\p -> Just [p]) $ LonelyBranch <$> (LBParams <$> x <*> y <*> z)
109 q = initPhyloQueryView l f b l' ms fs' ts so e d b'
110 -- | TODO remove phylo for real data here
111 pure (toPhyloView q phylo)
112 -- TODO remove phylo for real data here
115 getPhylo' :: PhyloId -> GargServer GetPhylo
116 getPhylo' _phyloId _lId _l _f _b _l' _ms _x _y _z _ts _s _o _e _d _b' = do
117 p <- liftIO $ viewPhylo2Svg phyloView
119 ------------------------------------------------------------------------
121 type PutPhylo = (Put '[JSON] Phylo )
122 --putPhylo :: PhyloId -> Maybe ListId -> PhyloQueryBuild -> Phylo
123 putPhylo :: PhyloId -> GargServer PutPhylo
126 ------------------------------------------------------------------------
127 type PostPhylo = QueryParam "listId" ListId
128 :> ReqBody '[JSON] PhyloQueryBuild
129 :> (Post '[JSON] Phylo)
131 postPhylo :: CorpusId -> GargServer PostPhylo
132 postPhylo _n _lId q = do
133 -- TODO get Reader settings
136 vrs = Just ("1" :: Text)
137 sft = Just (Software "Gargantext" "4")
138 prm = initPhyloParam vrs sft (Just q)
139 pure (toPhyloBase q prm (parseDocs (initFoundationsRoots actants) corpus) termList empty)
142 ------------------------------------------------------------------------
143 -- | DELETE Phylo == delete a node
144 ------------------------------------------------------------------------
150 instance Arbitrary PhyloView
152 arbitrary = elements [phyloView]
154 -- | TODO add phyloGroup ex
155 instance Arbitrary PhyloGroup
157 arbitrary = elements []
159 instance Arbitrary Phylo
161 arbitrary = elements [phylo]
164 instance ToSchema Cluster
165 instance ToSchema EdgeType
166 instance ToSchema Filiation
167 instance ToSchema Filter
168 instance ToSchema FisParams
169 instance ToSchema HammingParams
170 instance ToSchema LouvainParams
171 instance ToSchema Metric
172 instance ToSchema Order
173 instance ToSchema Phylo
174 instance ToSchema PhyloFis
175 instance ToSchema PhyloBranch
176 instance ToSchema PhyloEdge
177 instance ToSchema PhyloGroup
178 instance ToSchema PhyloLevel
179 instance ToSchema PhyloNode
180 instance ToSchema PhyloParam
181 instance ToSchema PhyloFoundations
182 instance ToSchema PhyloPeriod
183 instance ToSchema PhyloQueryBuild
184 instance ToSchema PhyloView
185 instance ToSchema RCParams
186 instance ToSchema LBParams
187 instance ToSchema SBParams
188 instance ToSchema Software
189 instance ToSchema WLJParams
192 instance ToParamSchema Order
193 instance FromHttpApiData Order
195 parseUrlPiece = readTextData
198 instance ToParamSchema Metric
199 instance FromHttpApiData [Metric]
201 parseUrlPiece = readTextData
202 instance FromHttpApiData Metric
204 parseUrlPiece = readTextData
207 instance ToParamSchema DisplayMode
208 instance FromHttpApiData DisplayMode
210 parseUrlPiece = readTextData
213 instance ToParamSchema ExportMode
214 instance FromHttpApiData ExportMode
216 parseUrlPiece = readTextData
219 instance FromHttpApiData Sort
221 parseUrlPiece = readTextData
222 instance ToParamSchema Sort
225 instance ToSchema Proximity
227 declareNamedSchema = genericDeclareNamedSchemaUnrestricted
231 instance FromHttpApiData [Tagger]
233 parseUrlPiece = readTextData
234 instance FromHttpApiData Tagger
236 parseUrlPiece = readTextData
237 instance ToParamSchema Tagger
239 instance FromHttpApiData Filiation
241 parseUrlPiece = readTextData
242 instance ToParamSchema Filiation