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 import qualified Data.Text as Text
  29 import GHC.Generics (Generic)
  30 import Gargantext.Prelude
  31 import Data.Text (Text)
  32 import Data.Aeson
  33 import Servant
  34 import Servant.Multipart
  35 --import Servant.Mock (HasMock(mock))
  36 import Servant.Swagger (HasSwagger(toSwagger))
  37 -- import qualified Data.ByteString.Lazy as LBS
  38 import Control.Monad
  39 import Control.Monad.IO.Class
  40 import Gargantext.API.Types
  41 --import Servant.CSV.Cassava (CSV'(..))
  42 --import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  43 --import Data.Swagger
  44 --import Gargantext.API.Ngrams (TODO)
  45
  46 -- | Upload files
  47 -- TODO Is it possible to adapt the function according to iValue input ?
  48 --type API = MultipartForm Mem (MultipartData Mem) :> Post '[JSON] Integer
  49
  50 -- instance Generic Mem
  51
  52 --instance ToSchema Mem
  53 --instance Arbitrary Mem
  54
  55 --instance ToSchema (MultipartData Mem)
  56 --instance Arbitrary ( MultipartData Mem)
  57
  58 instance HasSwagger (MultipartForm tag a :> sub) where
  59   -- TODO
  60   toSwagger _ = undefined -- toSwagger (Proxy :: Proxy (TODO :> Post '[JSON] ()))
  61 --declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
  62 --instance Arbitrary (MultipartForm Mem (MultipartData Mem))
  63
  64 {-
  65 instance (FromMultipart tag a, MultipartBackend tag, Servant.Multipart.LookupContext context (MultipartOptions tag))
  66       => HasMock (MultipartForm tag a :> sub) context where
  67   mock _ _ = undefined
  68
  69 instance HasMock (MultipartForm Mem (MultipartData Mem) :> sub) context where
  70   mock _ _ = undefined
  71 -}
  72
  73 data Upload = Upload { up :: [Text] }
  74   deriving (Generic)
  75
  76 instance ToJSON Upload
  77
  78 type ApiUpload = MultipartForm Mem (MultipartData Mem) :> Post '[JSON] Text
  79 -- MultipartData consists in textual inputs,
  80 -- accessible through its "inputs" field, as well
  81 -- as files, accessible through its "files" field.
  82 upload :: GargServer ApiUpload
  83 upload multipartData = do
  84
  85 --{-
  86   is <- liftIO $ do
  87     putStrLn ("Inputs:" :: Text)
  88     forM (inputs multipartData) $ \input -> do
  89       putStrLn $ ("iName  " :: Text) <> (iName input)
  90             <> ("iValue " :: Text) <> (iValue input)
  91       pure $ iName input
  92
  93 --{-
  94   _ <- forM (files multipartData) $ \file -> do
  95     let content = fdPayload file
  96     putStrLn $ ("XXX " :: Text) <> (fdFileName file)
  97     putStrLn $ ("YYY " :: Text) <>  cs content
  98     --pure $ cs content
  99   -- is <- inputs multipartData
 100 --}
 101
 102   pure $ Text.concat $ map cs is
 103 -------------------------------------------------------------------------------
 104
 105