src/Gargantext/API/Node/Corpus/Types.hs

   1 {-# LANGUAGE TemplateHaskell    #-}
   2
   3 module Gargantext.API.Node.Corpus.Types where
   4
   5 import Control.Lens hiding (elements, Empty)
   6 import Control.Monad.Fail (fail)
   7 import Data.Aeson
   8 import Data.Aeson.TH (deriveJSON)
   9 import Data.Monoid (mempty)
  10 import Data.Swagger
  11 import Data.Text (Text)
  12 import qualified Data.Text as T
  13 import GHC.Generics (Generic)
  14 import Text.Regex.TDFA ((=~))
  15
  16 import Protolude ((++))
  17 import Gargantext.Prelude
  18
  19 import qualified Gargantext.API.Admin.Orchestrator.Types as Types
  20 import Gargantext.Core.Utils.Prefix (unPrefix)
  21 import Gargantext.Database.Action.Flow (DataOrigin(..))
  22
  23 data Database = Empty
  24               | PubMed
  25               | Arxiv
  26               | HAL
  27               | IsTex
  28               | Isidore
  29   deriving (Eq, Show, Generic, Enum, Bounded)
  30
  31 deriveJSON (unPrefix "") ''Database
  32 instance ToSchema Database
  33
  34 database2origin :: Database -> DataOrigin
  35 database2origin Empty   = InternalOrigin Types.IsTex
  36 database2origin PubMed  = ExternalOrigin Types.PubMed
  37 database2origin Arxiv   = ExternalOrigin Types.Arxiv
  38 database2origin HAL     = ExternalOrigin Types.HAL
  39 database2origin IsTex   = ExternalOrigin Types.IsTex
  40 database2origin Isidore = ExternalOrigin Types.Isidore
  41
  42 ------------------------------------------------------------------------
  43 data Datafield = Gargantext
  44                | External (Maybe Database)
  45                | Web
  46                | Files
  47   deriving (Eq, Show, Generic)
  48
  49 instance FromJSON Datafield where
  50   parseJSON = withText "Datafield" $ \text ->
  51     case text of
  52       "Gargantext" -> pure Gargantext
  53       "Web" -> pure Web
  54       "Files" -> pure Files
  55       v ->
  56         let (preExternal, _, postExternal) = v =~ ("External " :: Text) :: (Text, Text, Text)
  57         in
  58         if preExternal == "" then do
  59           db <- parseJSON $ String postExternal
  60           pure $ External db
  61         else fail $ "Cannot match patterh 'External <db>' for string " ++ (T.unpack v)
  62 instance ToJSON Datafield where
  63   toJSON (External db) = toJSON $ "External " ++ (show db)
  64   toJSON s = toJSON $ show s
  65 instance ToSchema Datafield where
  66   declareNamedSchema _ = do
  67     return $ NamedSchema (Just "Datafield") $ mempty
  68       & type_ ?~ SwaggerObject