]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/API/Node/Corpus/New/File.hs
[phylo] filter threshold change
[gargantext.git] / src / Gargantext / API / Node / Corpus / New / File.hs
1 {-|
2 Module : Gargantext.API.Node.Corpus.New.File
3 Description : Server 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 ScopedTypeVariables #-}
15 {-# LANGUAGE TemplateHaskell #-}
16 {-# LANGUAGE TypeOperators #-}
17
18 module Gargantext.API.Node.Corpus.New.File
19 where
20
21 import Control.Lens ((.~), (?~))
22 import Control.Monad (forM)
23 import Data.Aeson
24 import Data.Maybe
25 import Data.Monoid (mempty)
26 import Data.Swagger
27 import Data.Text (Text())
28 import GHC.Generics (Generic)
29
30 import Servant
31 import Servant.Multipart
32 import Servant.Swagger (HasSwagger(toSwagger))
33 import Servant.Swagger.Internal
34 import Test.QuickCheck (elements)
35 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
36
37 import Gargantext.API.Ngrams (TODO)
38 import Gargantext.Database.Admin.Types.Node
39 import Gargantext.Database.Prelude -- (Cmd, CmdM)
40 import Gargantext.Prelude
41 import Gargantext.Prelude.Crypto.Hash (hash)
42
43 -------------------------------------------------------------
44 type Hash = Text
45 data FileType = CSV
46 | CSV_HAL
47 | PresseRIS
48 | WOS
49 deriving (Eq, Show, Generic)
50
51 instance ToSchema FileType
52 instance Arbitrary FileType
53 where
54 arbitrary = elements [CSV, PresseRIS]
55 instance ToParamSchema FileType
56
57 instance FromJSON FileType
58
59 instance ToParamSchema (MultipartData Mem) where
60 toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
61
62 instance FromHttpApiData FileType
63 where
64 parseUrlPiece "CSV" = pure CSV
65 parseUrlPiece "CSV_HAL" = pure CSV_HAL
66 parseUrlPiece "PresseRis" = pure PresseRIS
67 parseUrlPiece _ = pure CSV -- TODO error here
68
69
70 instance (ToParamSchema a, HasSwagger sub) =>
71 HasSwagger (MultipartForm tag a :> sub) where
72 -- TODO
73 toSwagger _ = toSwagger (Proxy :: Proxy sub)
74 & addParam param
75 where
76 param = mempty
77 & required ?~ True
78 & schema .~ ParamOther sch
79 sch = mempty
80 & in_ .~ ParamFormData
81 & paramSchema .~ toParamSchema (Proxy :: Proxy a)
82
83
84 type WithUpload' = Summary "Upload file(s) to a corpus"
85 :> QueryParam "fileType" FileType
86 :> MultipartForm Mem (MultipartData Mem)
87 :> Post '[JSON] [Hash]
88
89 --postUpload :: NodeId -> Maybe FileType -> GargServer UploadAPI
90 --postUpload :: NodeId -> GargServer UploadAPI
91 postUpload :: NodeId
92 -> Maybe FileType
93 -> MultipartData Mem
94 -> Cmd err [Hash]
95 postUpload _ Nothing _ = panic "fileType is a required parameter"
96 postUpload _ (Just fileType) multipartData = do
97 printDebug "File Type: " fileType
98 is <- liftBase $ do
99 printDebug "Inputs:" ()
100 forM (inputs multipartData) $ \input -> do
101 printDebug "iName " (iName input)
102 printDebug "iValue " (iValue input)
103 pure $ iName input
104
105 _ <- forM (files multipartData) $ \file -> do
106 let content = fdPayload file
107 printDebug "XXX " (fdFileName file)
108 printDebug "YYY " content
109 --pure $ cs content
110 -- is <- inputs multipartData
111
112 pure $ map hash is
113
114 -------------------------------------------------------------------