src/Gargantext/API/Upload.hs

   1 {-|
   2 Module      : Gargantext.API.Upload
   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 DataKinds             #-}
  15 {-# LANGUAGE DeriveGeneric         #-}
  16 {-# LANGUAGE FlexibleContexts      #-}
  17 {-# LANGUAGE FlexibleInstances     #-}
  18 {-# LANGUAGE NoImplicitPrelude     #-}
  19 {-# LANGUAGE MultiParamTypeClasses #-}
  20 {-# LANGUAGE OverloadedStrings     #-}
  21 {-# LANGUAGE RankNTypes            #-}
  22 {-# LANGUAGE ScopedTypeVariables   #-}
  23 {-# LANGUAGE TemplateHaskell       #-}
  24 {-# LANGUAGE TypeOperators         #-}
  25
  26 module Gargantext.API.Upload
  27   where
  28
  29 import Control.Lens ((.~), (?~))
  30 import qualified Data.Text as Text
  31 import GHC.Generics (Generic)
  32 import Gargantext.Prelude
  33 import Data.Text (Text)
  34 import Data.Aeson
  35 import Data.Monoid
  36 import Servant
  37 import Servant.Multipart
  38 --import Servant.Mock (HasMock(mock))
  39 import Servant.Swagger (HasSwagger(toSwagger))
  40 import Servant.Swagger.Internal
  41 -- import qualified Data.ByteString.Lazy as LBS
  42 import Control.Monad
  43 import Control.Monad.IO.Class
  44 import Gargantext.API.Types
  45 --import Servant.CSV.Cassava (CSV'(..))
  46 --import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  47 import Data.Swagger
  48 import Gargantext.API.Ngrams (TODO)
  49
  50 -- | Upload files
  51 -- TODO Is it possible to adapt the function according to iValue input ?
  52 --type API = MultipartForm Mem (MultipartData Mem) :> Post '[JSON] Integer
  53
  54 -- instance Generic Mem
  55
  56 --instance ToSchema Mem
  57 --instance Arbitrary Mem
  58
  59 instance ToParamSchema (MultipartData Mem) where
  60   toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
  61
  62 --instance Arbitrary ( MultipartData Mem)
  63
  64 instance (ToParamSchema a, HasSwagger sub) =>
  65          HasSwagger (MultipartForm tag a :> sub) where
  66   -- TODO
  67   toSwagger _ = toSwagger (Proxy :: Proxy sub)
  68     & addParam param
  69     where
  70       param = mempty
  71         & required ?~ True
  72         & schema   .~ ParamOther sch
  73       sch = mempty
  74         & in_         .~ ParamFormData
  75         & paramSchema .~ toParamSchema (Proxy :: Proxy a)
  76 --declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
  77 --instance Arbitrary (MultipartForm Mem (MultipartData Mem))
  78
  79 {-
  80 instance (FromMultipart tag a, MultipartBackend tag, Servant.Multipart.LookupContext context (MultipartOptions tag))
  81       => HasMock (MultipartForm tag a :> sub) context where
  82   mock _ _ = undefined
  83
  84 instance HasMock (MultipartForm Mem (MultipartData Mem) :> sub) context where
  85   mock _ _ = undefined
  86 -}
  87
  88 data Upload = Upload { up :: [Text] }
  89   deriving (Generic)
  90
  91 instance ToJSON Upload
  92
  93 type ApiUpload = MultipartForm Mem (MultipartData Mem) :> Post '[JSON] Text
  94 -- MultipartData consists in textual inputs,
  95 -- accessible through its "inputs" field, as well
  96 -- as files, accessible through its "files" field.
  97 upload :: GargServer ApiUpload
  98 upload multipartData = do
  99
 100 --{-
 101   is <- liftIO $ do
 102     putStrLn ("Inputs:" :: Text)
 103     forM (inputs multipartData) $ \input -> do
 104       putStrLn $ ("iName  " :: Text) <> (iName input)
 105             <> ("iValue " :: Text) <> (iValue input)
 106       pure $ iName input
 107
 108 --{-
 109   _ <- forM (files multipartData) $ \file -> do
 110     let content = fdPayload file
 111     putStrLn $ ("XXX " :: Text) <> (fdFileName file)
 112     putStrLn $ ("YYY " :: Text) <>  cs content
 113     --pure $ cs content
 114   -- is <- inputs multipartData
 115 --}
 116
 117   pure $ Text.concat $ map cs is
 118 -------------------------------------------------------------------------------
 119
 120