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 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(..))
  25 import Data.Swagger
  26 import Network.HTTP.Media ((//), (/:))
  27 import Servant
  28 import Test.QuickCheck (elements)
  29 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  30 import Web.HttpApiData (parseUrlPiece, readTextData)
  31
  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(..))
  42
  43 ------------------------------------------------------------------------
  44 type PhyloAPI = Summary "Phylo API"
  45               :> GetPhylo
  46         --    :<|> PutPhylo
  47             :<|> PostPhylo
  48
  49
  50 phyloAPI :: PhyloId -> UserId -> GargServer PhyloAPI
  51 phyloAPI n u = getPhylo  n
  52         :<|> postPhylo n u
  53         -- :<|> putPhylo  n
  54         -- :<|> deletePhylo  n
  55
  56 newtype SVG = SVG DB.ByteString
  57
  58 instance ToSchema SVG
  59   where
  60     declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
  61
  62 instance Show SVG where
  63   show (SVG a) = show a
  64
  65 instance Accept SVG where
  66    contentType _ = "SVG" // "image/svg+xml" /: ("charset", "utf-8")
  67
  68 instance Show a => MimeRender PlainText a where
  69    mimeRender _ val = cs ("" <> show val)
  70
  71 instance MimeRender SVG SVG where
  72    mimeRender _ (SVG s) = DBL.fromStrict s
  73
  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
  91     -}
  92               :> Get '[SVG] SVG
  93
  94 -- | TODO
  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)
 101   let
 102     level = maybe 2 identity l
 103     branc = maybe 2 identity msb
 104     maybePhylo = hyperdataPhylo_data $ _node_hyperdata phNode
 105
 106   p <- liftBase $ viewPhylo2Svg $ viewPhylo level branc  $ maybe phyloFromQuery identity maybePhylo
 107   pure (SVG p)
 108 ------------------------------------------------------------------------
 109 type PostPhylo =  QueryParam "listId" ListId
 110                -- :> ReqBody '[JSON] PhyloQueryBuild
 111                :> (Post '[JSON] NodeId)
 112
 113 postPhylo :: CorpusId -> UserId -> GargServer PostPhylo
 114 postPhylo n userId _lId = do
 115   -- TODO get Reader settings
 116   -- s <- ask
 117   let
 118     -- _vrs = Just ("1" :: Text)
 119     -- _sft = Just (Software "Gargantext" "4")
 120     -- _prm = initPhyloParam vrs sft (Just q)
 121   phy  <- flowPhylo n
 122   pId <- insertNodes [nodePhyloW (Just "Phylo") (Just $ HyperdataPhylo Nothing (Just phy)) n userId]
 123   pure $ NodeId (fromIntegral pId)
 124
 125 ------------------------------------------------------------------------
 126 -- | DELETE Phylo == delete a node
 127 ------------------------------------------------------------------------
 128 ------------------------------------------------------------------------
 129 {-
 130 type PutPhylo = (Put '[JSON] Phylo  )
 131 --putPhylo :: PhyloId -> Maybe ListId -> PhyloQueryBuild -> Phylo
 132 putPhylo :: PhyloId -> GargServer PutPhylo
 133 putPhylo = undefined
 134 -}
 135
 136
 137 -- | Instances
 138 instance Arbitrary PhyloView
 139   where
 140     arbitrary = elements [phyloView]
 141
 142 -- | TODO add phyloGroup ex
 143 instance Arbitrary PhyloGroup
 144   where
 145     arbitrary = elements []
 146
 147 instance Arbitrary Phylo
 148   where
 149     arbitrary = elements [phylo]
 150
 151 instance ToSchema Order
 152
 153 instance ToParamSchema Order
 154 instance FromHttpApiData Order
 155   where
 156     parseUrlPiece = readTextData
 157
 158
 159 instance ToParamSchema Metric
 160 instance FromHttpApiData [Metric]
 161   where
 162     parseUrlPiece = readTextData
 163 instance FromHttpApiData Metric
 164   where
 165     parseUrlPiece = readTextData
 166
 167
 168 instance ToParamSchema   DisplayMode
 169 instance FromHttpApiData DisplayMode
 170   where
 171     parseUrlPiece = readTextData
 172
 173
 174 instance ToParamSchema   ExportMode
 175 instance FromHttpApiData ExportMode
 176   where
 177     parseUrlPiece = readTextData
 178
 179
 180 instance FromHttpApiData Sort
 181   where
 182     parseUrlPiece = readTextData
 183 instance ToParamSchema Sort
 184
 185 instance FromHttpApiData [Tagger]
 186   where
 187     parseUrlPiece = readTextData
 188 instance FromHttpApiData Tagger
 189   where
 190     parseUrlPiece = readTextData
 191 instance ToParamSchema   Tagger
 192
 193 instance FromHttpApiData Filiation
 194   where
 195     parseUrlPiece = readTextData
 196 instance ToParamSchema   Filiation
 197
 198