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