Skip to content

H
haskell-gargantext
Commit 41cf1ee9 authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[FLOW] Instances of HyperdataDocument + Grand Debat imports.

parent 6a45919d
Show whitespace changes
Inline Side-by-side
Showing with 184 additions and 77 deletions
package.yaml
View file @ 41cf1ee9
......@@ -59,6 +59,7 @@ library:
- Gargantext.Text.Parsers.Date
- Gargantext.Text.Parsers.Wikimedia
- Gargantext.Text.Parsers.WOS
- Gargantext.Text.Parsers.GrandDebat
- Gargantext.Text.Search
- Gargantext.Text.Terms
- Gargantext.Text.Terms.Stop
......
src/Gargantext/Database/Facet.hs
View file @ 41cf1ee9
......@@ -148,7 +148,7 @@ instance Arbitrary FacetDoc where
| id' <- [1..10]
, year <- [1990..2000]
, t <- ["title", "another title"]
, hp <- hyperdataDocuments
, hp <- arbitraryHyperdataDocuments
, fav <- [True, False]
, ngramCount <- [3..100]
]
......
src/Gargantext/Database/Flow.hs
View file @ 41cf1ee9
......@@ -80,10 +80,10 @@ flowCorpus :: FlowCmdM env ServantErr m
=> Username -> CorpusName -> TermType Lang -> FileFormat -> FilePath -> m CorpusId
flowCorpus u cn la ff fp = liftIO (parseDocs ff fp) >>= \docs -> flowCorpus' u cn la docs
flowCorpus' :: FlowCmdM env ServantErr m
=> Username -> CorpusName -> TermType Lang -> [HyperdataDocument] -> m CorpusId
flowCorpus' :: (FlowCmdM env ServantErr m, ToHyperdataDocument a)
=> Username -> CorpusName -> TermType Lang -> [a] -> m CorpusId
flowCorpus' u cn la docs = do
ids <- flowCorpusMaster la docs
ids <- flowCorpusMaster la (map toHyperdataDocument docs)
flowCorpusUser u cn ids
......
src/Gargantext/Database/Types/Node.hs
View file @ 41cf1ee9
......@@ -68,7 +68,8 @@ instance ToField NodeId where
instance FromField NodeId where
fromField field mdata = do
n <- fromField field mdata
if (n :: Int) > 0 then return $ NodeId n
if (n :: Int) > 0
then return $ NodeId n
else mzero
instance ToSchema NodeId
......@@ -106,9 +107,9 @@ instance Arbitrary UTCTime' where
arbitrary = elements $ timesAfter 100 D (jour 2000 01 01)
------------------------------------------------------------------------
data Status = Status { status_failed :: Int
, status_succeeded :: Int
, status_remaining :: Int
data Status = Status { status_failed :: !Int
, status_succeeded :: !Int
, status_remaining :: !Int
} deriving (Show, Generic)
$(deriveJSON (unPrefix "status_") ''Status)
......@@ -116,8 +117,8 @@ instance Arbitrary Status where
arbitrary = Status <$> arbitrary <*> arbitrary <*> arbitrary
------------------------------------------------------------------------
data StatusV3 = StatusV3 { statusV3_error :: Maybe Text
, statusV3_action :: Maybe Text
data StatusV3 = StatusV3 { statusV3_error :: !(Maybe Text)
, statusV3_action :: !(Maybe Text)
} deriving (Show, Generic)
$(deriveJSON (unPrefix "statusV3_") ''StatusV3)
------------------------------------------------------------------------
......@@ -147,60 +148,66 @@ data HyperdataDocumentV3 = HyperdataDocumentV3 { hyperdataDocumentV3_publication
$(deriveJSON (unPrefix "hyperdataDocumentV3_") ''HyperdataDocumentV3)
instance Hyperdata HyperdataDocumentV3
------------------------------------------------------------------------
data HyperdataDocument = HyperdataDocument { _hyperdataDocument_bdd :: Maybe Text
, _hyperdataDocument_doi :: Maybe Text
, _hyperdataDocument_url :: Maybe Text
, _hyperdataDocument_uniqId :: Maybe Text
, _hyperdataDocument_uniqIdBdd :: Maybe Text
, _hyperdataDocument_page :: Maybe Int
, _hyperdataDocument_title :: Maybe Text
, _hyperdataDocument_authors :: Maybe Text
, _hyperdataDocument_institutes :: Maybe Text
, _hyperdataDocument_source :: Maybe Text
, _hyperdataDocument_abstract :: Maybe Text
, _hyperdataDocument_publication_date :: Maybe Text
, _hyperdataDocument_publication_year :: Maybe Int
, _hyperdataDocument_publication_month :: Maybe Int
, _hyperdataDocument_publication_day :: Maybe Int
, _hyperdataDocument_publication_hour :: Maybe Int
, _hyperdataDocument_publication_minute :: Maybe Int
, _hyperdataDocument_publication_second :: Maybe Int
, _hyperdataDocument_language_iso2 :: Maybe Text
------------------------------------------------------------------------
data HyperdataDocument = HyperdataDocument { _hyperdataDocument_bdd :: !(Maybe Text)
, _hyperdataDocument_doi :: !(Maybe Text)
, _hyperdataDocument_url :: !(Maybe Text)
, _hyperdataDocument_uniqId :: !(Maybe Text)
, _hyperdataDocument_uniqIdBdd :: !(Maybe Text)
, _hyperdataDocument_page :: !(Maybe Int)
, _hyperdataDocument_title :: !(Maybe Text)
, _hyperdataDocument_authors :: !(Maybe Text)
, _hyperdataDocument_institutes :: !(Maybe Text)
, _hyperdataDocument_source :: !(Maybe Text)
, _hyperdataDocument_abstract :: !(Maybe Text)
, _hyperdataDocument_publication_date :: !(Maybe Text)
, _hyperdataDocument_publication_year :: !(Maybe Int)
, _hyperdataDocument_publication_month :: !(Maybe Int)
, _hyperdataDocument_publication_day :: !(Maybe Int)
, _hyperdataDocument_publication_hour :: !(Maybe Int)
, _hyperdataDocument_publication_minute :: !(Maybe Int)
, _hyperdataDocument_publication_second :: !(Maybe Int)
, _hyperdataDocument_language_iso2 :: !(Maybe Text)
} deriving (Show, Generic)
$(deriveJSON (unPrefix "_hyperdataDocument_") ''HyperdataDocument)
$(makeLenses ''HyperdataDocument)
class ToHyperdataDocument a where
toHyperdataDocument :: a -> HyperdataDocument
instance ToHyperdataDocument HyperdataDocument
where
toHyperdataDocument = identity
instance Eq HyperdataDocument where
(==) h1 h2 = (==) (_hyperdataDocument_uniqId h1) (_hyperdataDocument_uniqId h2)
instance Ord HyperdataDocument where
compare h1 h2 = compare (_hyperdataDocument_uniqId h1) (_hyperdataDocument_uniqId h2)
compare h1 h2 = compare (_hyperdataDocument_publication_date h1) (_hyperdataDocument_publication_date h2)
instance Hyperdata HyperdataDocument
instance ToField HyperdataDocument where
toField = toJSONField
toHyperdataDocuments :: [(Text, Text)] -> [HyperdataDocument]
toHyperdataDocuments ts = map (\(t1,t2) -> HyperdataDocument Nothing Nothing Nothing Nothing Nothing Nothing (Just t1)
Nothing Nothing (Just t2) Nothing Nothing Nothing Nothing Nothing
Nothing Nothing Nothing Nothing
) ts
instance Arbitrary HyperdataDocument where
arbitrary = elements arbitraryHyperdataDocuments
hyperdataDocuments :: [HyperdataDocument]
hyperdataDocuments = toHyperdataDocuments [ ("AI is big but less than crypto", "Troll System journal")
arbitraryHyperdataDocuments :: [HyperdataDocument]
arbitraryHyperdataDocuments =
map toHyperdataDocument' ([ ("AI is big but less than crypto", "Troll System journal")
, ("Crypto is big but less than AI", "System Troll review" )
, ("Science is magic" , "Closed Source review")
, ("Open science for all" , "No Time" )
, ("Closed science for me" , "No Space" )
]
instance Arbitrary HyperdataDocument where
arbitrary = elements hyperdataDocuments
] :: [(Text, Text)])
where
toHyperdataDocument' (t1,t2) =
HyperdataDocument Nothing Nothing Nothing Nothing Nothing Nothing (Just t1)
Nothing Nothing (Just t2) Nothing Nothing Nothing Nothing Nothing
Nothing Nothing Nothing Nothing
------------------------------------------------------------------------
data LanguageNodes = LanguageNodes { languageNodes___unknown__ :: [Int]}
......@@ -223,9 +230,9 @@ instance ToSchema EventLevel where
------------------------------------------------------------------------
data Event = Event { event_level :: EventLevel
, event_message :: Text
, event_date :: UTCTime
data Event = Event { event_level :: !EventLevel
, event_message :: !Text
, event_date :: !UTCTime
} deriving (Show, Generic)
$(deriveJSON (unPrefix "event_") ''Event)
......@@ -239,17 +246,22 @@ instance ToSchema Event where
instance Arbitrary Text where
arbitrary = elements $ map (\c -> pack [c]) ['a'..'z']
data Resource = Resource { resource_path :: Maybe Text
, resource_scraper :: Maybe Text
, resource_query :: Maybe Text
, resource_events :: [Event]
, resource_status :: Status
, resource_date :: UTCTime'
data Resource = Resource { resource_path :: !(Maybe Text)
, resource_scraper :: !(Maybe Text)
, resource_query :: !(Maybe Text)
, resource_events :: !([Event])
, resource_status :: !Status
, resource_date :: !UTCTime'
} deriving (Show, Generic)
$(deriveJSON (unPrefix "resource_") ''Resource)
instance Arbitrary Resource where
arbitrary = Resource <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
arbitrary = Resource <$> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
instance ToSchema Resource where
declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
......@@ -267,11 +279,11 @@ $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
instance Hyperdata HyperdataFolder
------------------------------------------------------------------------
data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_title :: Maybe Text
, hyperdataCorpus_desc :: Maybe Text
, hyperdataCorpus_query :: Maybe Text
, hyperdataCorpus_authors :: Maybe Text
, hyperdataCorpus_resources :: Maybe [Resource]
data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_title :: !(Maybe Text)
, hyperdataCorpus_desc :: !(Maybe Text)
, hyperdataCorpus_query :: !(Maybe Text)
, hyperdataCorpus_authors :: !(Maybe Text)
, hyperdataCorpus_resources :: !(Maybe [Resource])
} deriving (Show, Generic)
$(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
......@@ -292,8 +304,8 @@ instance Arbitrary HyperdataCorpus where
arbitrary = pure hyperdataCorpus -- TODO
------------------------------------------------------------------------
data HyperdataAnnuaire = HyperdataAnnuaire { hyperdataAnnuaire_title :: Maybe Text
, hyperdataAnnuaire_desc :: Maybe Text
data HyperdataAnnuaire = HyperdataAnnuaire { hyperdataAnnuaire_title :: !(Maybe Text)
, hyperdataAnnuaire_desc :: !(Maybe Text)
} deriving (Show, Generic)
$(deriveJSON (unPrefix "hyperdataAnnuaire_") ''HyperdataAnnuaire)
......@@ -315,7 +327,7 @@ instance Arbitrary HyperdataAny where
arbitrary = pure $ HyperdataAny mempty -- TODO produce arbitrary objects
------------------------------------------------------------------------
data HyperdataList = HyperdataList { hyperdataList_preferences :: Maybe Text
data HyperdataList = HyperdataList { hyperdataList_preferences :: !(Maybe Text)
} deriving (Show, Generic)
$(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
......@@ -325,7 +337,7 @@ instance Arbitrary HyperdataList where
arbitrary = elements [HyperdataList (Just "from list A")]
------------------------------------------------------------------------
data HyperdataScore = HyperdataScore { hyperdataScore_preferences :: Maybe Text
data HyperdataScore = HyperdataScore { hyperdataScore_preferences :: !(Maybe Text)
} deriving (Show, Generic)
$(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
......@@ -333,21 +345,21 @@ instance Hyperdata HyperdataScore
------------------------------------------------------------------------
data HyperdataResource = HyperdataResource { hyperdataResource_preferences :: Maybe Text
data HyperdataResource = HyperdataResource { hyperdataResource_preferences :: !(Maybe Text)
} deriving (Show, Generic)
$(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
instance Hyperdata HyperdataResource
------------------------------------------------------------------------
data HyperdataDashboard = HyperdataDashboard { hyperdataDashboard_preferences :: Maybe Text
data HyperdataDashboard = HyperdataDashboard { hyperdataDashboard_preferences :: !(Maybe Text)
} deriving (Show, Generic)
$(deriveJSON (unPrefix "hyperdataDashboard_") ''HyperdataDashboard)
instance Hyperdata HyperdataDashboard
-- TODO add the Graph Structure here
data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences :: Maybe Text
data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences :: !(Maybe Text)
} deriving (Show, Generic)
$(deriveJSON (unPrefix "hyperdataGraph_") ''HyperdataGraph)
......@@ -355,7 +367,7 @@ instance Hyperdata HyperdataGraph
------------------------------------------------------------------------
-- TODO add the Graph Structure here
data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences :: Maybe Text
data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences :: !(Maybe Text)
} deriving (Show, Generic)
$(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
......@@ -363,7 +375,7 @@ instance Hyperdata HyperdataPhylo
------------------------------------------------------------------------
-- | TODO FEATURE: Notebook saved in the node
data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences :: Maybe Text
data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences :: !(Maybe Text)
} deriving (Show, Generic)
$(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
......
src/Gargantext/Text/Parsers/GrandDebat.hs 0 → 100644
View file @ 41cf1ee9
{-|
Module : Gargantext.Text.Parsers.GrandDebat
Description : Grand Debat Types
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
TODO: create a separate Lib.
-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
module Gargantext.Text.Parsers.GrandDebat
where
import GHC.IO (FilePath)
import Data.Aeson (ToJSON, FromJSON, decode)
import Data.Maybe (Maybe(), maybe)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.ByteString.Lazy as DBL
import GHC.Generics (Generic)
import Gargantext.Prelude
import Gargantext.Database.Types.Node
import Gargantext.Core (Lang(..))
data GrandDebatReference = GrandDebatReference
{ id :: !(Maybe Text)
, reference :: !(Maybe Text)
, title :: !(Maybe Text)
, createdAt :: !(Maybe Text)
, publishedAt :: !(Maybe Text)
, updatedAt :: !(Maybe Text)
, trashed :: !(Maybe Bool)
, trashedStatus :: !(Maybe Text)
, authorId :: !(Maybe Text)
, authorType :: !(Maybe Text)
, authorZipCode :: !(Maybe Text)
, responses :: !(Maybe [GrandDebatResponse])
}
deriving (Show, Generic)
data GrandDebatResponse = GrandDebatResponse
{ questionId :: !(Maybe Text)
, questionTitle :: !(Maybe Text)
, value :: !(Maybe Text)
, formattedValue :: !(Maybe Text)
}
deriving (Show, Generic)
instance FromJSON GrandDebatResponse
instance FromJSON GrandDebatReference
instance ToJSON GrandDebatResponse
instance ToJSON GrandDebatReference
instance ToHyperdataDocument GrandDebatReference
where
toHyperdataDocument (GrandDebatReference id' _ref title'
_createdAt' publishedAt' _updatedAt
_trashed _trashedStatus
_authorId authorType' authorZipCode'
responses') =
HyperdataDocument (Just "GrandDebat") id'
Nothing Nothing Nothing Nothing
title' authorType' authorZipCode' authorZipCode'
(toAbstract <$> responses')
publishedAt'
Nothing Nothing Nothing Nothing Nothing Nothing
(Just $ Text.pack $ show FR)
where
toAbstract = (Text.intercalate " . ") . (map toSentence)
toSentence (GrandDebatResponse _id _qtitle _qvalue r) = case r of
Nothing -> ""
Just r' -> case Text.length r' > 10 of
True -> r'
False -> ""
class ReadFile a
where
readFile :: FilePath -> IO a
instance ReadFile [GrandDebatReference]
where
readFile fp = maybe [] identity <$> decode <$> DBL.readFile fp
src/Gargantext/Text/Parsers/WOS.hs
View file @ 41cf1ee9
......@@ -31,10 +31,6 @@ import Data.ByteString.Char8 (pack)
import Control.Applicative
-------------------------------------------------------------
-- | wosParser parses ISI format from
-- Web Of Science Database
wosParser :: Parser [[(ByteString, ByteString)]]
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment