src/Gargantext/API/Corpus/New/File.hs

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