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 OverloadedLists #-} -- allows to write Map and HashMap as lists
15 {-# LANGUAGE TypeOperators #-}
17 module Gargantext.Viz.Phylo.API
20 import Data.String.Conversions
21 --import Control.Monad.Reader (ask)
22 import qualified Data.ByteString as DB
23 import qualified Data.ByteString.Lazy as DBL
24 import Data.Proxy (Proxy(..))
26 import Network.HTTP.Media ((//), (/:))
28 import Test.QuickCheck (elements)
29 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
30 import Web.HttpApiData (parseUrlPiece, readTextData)
32 import Gargantext.API.Prelude
33 import Gargantext.Database.Admin.Types.Hyperdata
34 import Gargantext.Database.Admin.Types.Node -- (PhyloId, ListId, CorpusId, UserId, NodeId(..))
35 import Gargantext.Database.Query.Table.Node (insertNodes, nodePhyloW, getNodeWith)
36 import Gargantext.Database.Schema.Node (_node_hyperdata)
37 import Gargantext.Prelude
38 import Gargantext.Viz.Phylo
39 import Gargantext.Viz.Phylo.Main
40 import Gargantext.Viz.Phylo.Example
41 import Gargantext.Core.Types (TODO(..))
43 ------------------------------------------------------------------------
44 type PhyloAPI = Summary "Phylo API"
50 phyloAPI :: PhyloId -> UserId -> GargServer PhyloAPI
51 phyloAPI n u = getPhylo n
56 newtype SVG = SVG DB.ByteString
60 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
62 instance Show SVG where
65 instance Accept SVG where
66 contentType _ = "SVG" // "image/svg+xml" /: ("charset", "utf-8")
68 instance Show a => MimeRender PlainText a where
69 mimeRender _ val = cs ("" <> show val)
71 instance MimeRender SVG SVG where
72 mimeRender _ (SVG s) = DBL.fromStrict s
74 ------------------------------------------------------------------------
75 type GetPhylo = QueryParam "listId" ListId
76 :> QueryParam "level" Level
77 :> QueryParam "minSizeBranch" MinSizeBranch
78 {- :> QueryParam "filiation" Filiation
79 :> QueryParam "childs" Bool
80 :> QueryParam "depth" Level
81 :> QueryParam "metrics" [Metric]
82 :> QueryParam "periodsInf" Int
83 :> QueryParam "periodsSup" Int
84 :> QueryParam "minNodes" Int
85 :> QueryParam "taggers" [Tagger]
86 :> QueryParam "sort" Sort
87 :> QueryParam "order" Order
88 :> QueryParam "export" ExportMode
89 :> QueryParam "display" DisplayMode
90 :> QueryParam "verbose" Bool
95 -- Add real text processing
96 -- Fix Filter parameters
97 getPhylo :: PhyloId -> GargServer GetPhylo
98 --getPhylo phId _lId l msb _f _b _l' _ms _x _y _z _ts _s _o _e _d _b' = do
99 getPhylo phId _lId l msb = do
100 phNode <- getNodeWith phId (Proxy :: Proxy HyperdataPhylo)
102 level = maybe 2 identity l
103 branc = maybe 2 identity msb
104 maybePhylo = hyperdataPhylo_data $ _node_hyperdata phNode
106 p <- liftBase $ viewPhylo2Svg $ viewPhylo level branc $ maybe phyloFromQuery identity maybePhylo
108 ------------------------------------------------------------------------
109 type PostPhylo = QueryParam "listId" ListId
110 -- :> ReqBody '[JSON] PhyloQueryBuild
111 :> (Post '[JSON] NodeId)
113 postPhylo :: CorpusId -> UserId -> GargServer PostPhylo
114 postPhylo n userId _lId = do
115 -- TODO get Reader settings
118 -- _vrs = Just ("1" :: Text)
119 -- _sft = Just (Software "Gargantext" "4")
120 -- _prm = initPhyloParam vrs sft (Just q)
122 pId <- insertNodes [nodePhyloW (Just "Phylo") (Just $ HyperdataPhylo Nothing (Just phy)) n userId]
123 pure $ NodeId (fromIntegral pId)
125 ------------------------------------------------------------------------
126 -- | DELETE Phylo == delete a node
127 ------------------------------------------------------------------------
128 ------------------------------------------------------------------------
130 type PutPhylo = (Put '[JSON] Phylo )
131 --putPhylo :: PhyloId -> Maybe ListId -> PhyloQueryBuild -> Phylo
132 putPhylo :: PhyloId -> GargServer PutPhylo
138 instance Arbitrary PhyloView
140 arbitrary = elements [phyloView]
142 -- | TODO add phyloGroup ex
143 instance Arbitrary PhyloGroup
145 arbitrary = elements []
147 instance Arbitrary Phylo
149 arbitrary = elements [phylo]
151 instance ToSchema Order
153 instance ToParamSchema Order
154 instance FromHttpApiData Order
156 parseUrlPiece = readTextData
159 instance ToParamSchema Metric
160 instance FromHttpApiData [Metric]
162 parseUrlPiece = readTextData
163 instance FromHttpApiData Metric
165 parseUrlPiece = readTextData
168 instance ToParamSchema DisplayMode
169 instance FromHttpApiData DisplayMode
171 parseUrlPiece = readTextData
174 instance ToParamSchema ExportMode
175 instance FromHttpApiData ExportMode
177 parseUrlPiece = readTextData
180 instance FromHttpApiData Sort
182 parseUrlPiece = readTextData
183 instance ToParamSchema Sort
185 instance FromHttpApiData [Tagger]
187 parseUrlPiece = readTextData
188 instance FromHttpApiData Tagger
190 parseUrlPiece = readTextData
191 instance ToParamSchema Tagger
193 instance FromHttpApiData Filiation
195 parseUrlPiece = readTextData
196 instance ToParamSchema Filiation