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 TemplateHaskell       #-}
  23 {-# LANGUAGE TypeOperators         #-}
  24
  25 module Gargantext.API.Upload
  26   where
  27
  28
  29 import Gargantext.Prelude
  30 import Data.Text (Text)
  31 import Servant
  32 import Servant.Multipart
  33 --import Servant.Mock (HasMock(mock))
  34 import Servant.Swagger (HasSwagger(toSwagger))
  35 import qualified Data.ByteString.Lazy as LBS
  36 import Control.Monad
  37 import Control.Monad.IO.Class
  38 import Gargantext.API.Types
  39 --import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  40 --import Data.Swagger
  41 --import Gargantext.API.Ngrams (TODO)
  42
  43 -- | Upload files
  44 -- TODO Is it possible to adapt the function according to iValue input ?
  45 --type API = MultipartForm Mem (MultipartData Mem) :> Post '[JSON] Integer
  46
  47 -- instance Generic Mem
  48
  49 --instance ToSchema Mem
  50 --instance Arbitrary Mem
  51
  52 --instance ToSchema (MultipartData Mem)
  53 --instance Arbitrary ( MultipartData Mem)
  54
  55 instance HasSwagger (MultipartForm tag a :> sub) where
  56   -- TODO
  57   toSwagger _ = undefined -- toSwagger (Proxy :: Proxy (TODO :> Post '[JSON] ()))
  58 --declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
  59 --instance Arbitrary (MultipartForm Mem (MultipartData Mem))
  60
  61 {-
  62 instance (FromMultipart tag a, MultipartBackend tag, Servant.Multipart.LookupContext context (MultipartOptions tag))
  63       => HasMock (MultipartForm tag a :> sub) context where
  64   mock _ _ = undefined
  65
  66 instance HasMock (MultipartForm Mem (MultipartData Mem) :> sub) context where
  67   mock _ _ = undefined
  68 -}
  69
  70 type ApiUpload = MultipartForm Mem (MultipartData Mem) :> Post '[JSON] Integer
  71 -- MultipartData consists in textual inputs,
  72 -- accessible through its "inputs" field, as well
  73 -- as files, accessible through its "files" field.
  74 upload :: GargServer ApiUpload
  75 upload multipartData = do
  76   liftIO $ do
  77     putStrLn ("Inputs:" :: Text)
  78     forM_ (inputs multipartData) $ \input ->
  79       putStrLn $ ("  " :: Text) <> (iName input)
  80             <> (" -> " :: Text) <> (iValue input)
  81
  82     forM_ (files multipartData) $ \file -> do
  83       let content = fdPayload file
  84       putStrLn $ ("Content of " :: Text) <> (fdFileName file)
  85       LBS.putStr content
  86   return 0
  87 -------------------------------------------------------------------------------
  88