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 | PresseRIS
  52   deriving (Eq, Show, Generic)
  53
  54 instance ToSchema FileType
  55 instance Arbitrary FileType
  56   where
  57     arbitrary = elements [CSV, PresseRIS]
  58 instance ToParamSchema FileType
  59
  60 instance FromJSON FileType
  61
  62 instance ToParamSchema (MultipartData Mem) where
  63   toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
  64
  65 instance FromHttpApiData FileType
  66   where
  67     parseUrlPiece "CSV"       = pure CSV
  68     parseUrlPiece "PresseRis" = pure PresseRIS
  69     parseUrlPiece _           = pure CSV -- TODO error here
  70
  71
  72 instance (ToParamSchema a, HasSwagger sub) =>
  73          HasSwagger (MultipartForm tag a :> sub) where
  74   -- TODO
  75   toSwagger _ = toSwagger (Proxy :: Proxy sub)
  76               & addParam param
  77     where
  78       param = mempty
  79             & required ?~ True
  80             & schema   .~ ParamOther sch
  81       sch = mempty
  82           & in_         .~ ParamFormData
  83           & paramSchema .~ toParamSchema (Proxy :: Proxy a)
  84
  85
  86 type WithUpload' = Summary "Upload file(s) to a corpus"
  87                 :> QueryParam "fileType"  FileType
  88                 :> MultipartForm Mem (MultipartData Mem)
  89                 :> Post '[JSON] [Hash]
  90
  91 --postUpload :: NodeId -> Maybe FileType ->  GargServer UploadAPI
  92 --postUpload :: NodeId -> GargServer UploadAPI
  93 postUpload :: NodeId
  94            -> Maybe FileType
  95            -> MultipartData Mem
  96            -> Cmd err [Hash]
  97 postUpload _ Nothing _ = panic "fileType is a required parameter"
  98 postUpload _ (Just fileType) multipartData = do
  99   putStrLn $ "File Type: " <> (show fileType)
 100   is <- liftIO $ do
 101     putStrLn ("Inputs:" :: Text)
 102     forM (inputs multipartData) $ \input -> do
 103       putStrLn $ ("iName  " :: Text) <> (iName input)
 104                <> ("iValue " :: Text) <> (iValue input)
 105       pure $ iName input
 106
 107   _ <- forM (files multipartData) $ \file -> do
 108     let content = fdPayload file
 109     putStrLn $ ("XXX " :: Text) <> (fdFileName file)
 110     putStrLn $ ("YYY " :: Text) <>  cs content
 111     --pure $ cs content
 112   -- is <- inputs multipartData
 113
 114   pure $ map (sha . cs) is
 115
 116 -------------------------------------------------------------------