Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
158
Issues
158
List
Board
Labels
Milestones
Merge Requests
11
Merge Requests
11
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
haskell-gargantext
Commits
60b07ef4
Commit
60b07ef4
authored
Mar 29, 2018
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[TYPES] changing json data of Corpus Node.
parent
f70d635d
Changes
2
Show whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
61 additions
and
29 deletions
+61
-29
Facet.hs
src/Gargantext/Database/Facet.hs
+1
-5
Node.hs
src/Gargantext/Types/Node.hs
+60
-24
No files found.
src/Gargantext/Database/Facet.hs
View file @
60b07ef4
...
@@ -37,7 +37,7 @@ import Data.Maybe (Maybe)
...
@@ -37,7 +37,7 @@ import Data.Maybe (Maybe)
import
Data.Profunctor.Product.Default
(
Default
)
import
Data.Profunctor.Product.Default
(
Default
)
import
Data.Profunctor.Product.TH
(
makeAdaptorAndInstance
)
import
Data.Profunctor.Product.TH
(
makeAdaptorAndInstance
)
import
Data.Time
(
UTCTime
)
import
Data.Time
(
UTCTime
)
import
Data.Time.Segment
(
jour
,
timesAfter
,
Granularity
(
D
)
)
import
Data.Time.Segment
(
jour
)
import
Data.Swagger
import
Data.Swagger
import
Database.PostgreSQL.Simple
(
Connection
)
import
Database.PostgreSQL.Simple
(
Connection
)
...
@@ -110,7 +110,6 @@ type FacetDocRead = Facet (Column PGInt4 )
...
@@ -110,7 +110,6 @@ type FacetDocRead = Facet (Column PGInt4 )
(
Column
PGInt4
)
(
Column
PGInt4
)
-----------------------------------------------------------------------
-----------------------------------------------------------------------
type
UTCTime'
=
UTCTime
data
FacetChart
=
FacetChart
{
facetChart_time
::
UTCTime'
data
FacetChart
=
FacetChart
{
facetChart_time
::
UTCTime'
,
facetChart_count
::
Double
,
facetChart_count
::
Double
...
@@ -119,9 +118,6 @@ data FacetChart = FacetChart { facetChart_time :: UTCTime'
...
@@ -119,9 +118,6 @@ data FacetChart = FacetChart { facetChart_time :: UTCTime'
$
(
deriveJSON
(
unPrefix
"facetChart_"
)
''
F
acetChart
)
$
(
deriveJSON
(
unPrefix
"facetChart_"
)
''
F
acetChart
)
instance
ToSchema
FacetChart
instance
ToSchema
FacetChart
instance
Arbitrary
UTCTime'
where
arbitrary
=
elements
$
timesAfter
100
D
(
jour
2000
01
01
)
instance
Arbitrary
FacetChart
where
instance
Arbitrary
FacetChart
where
arbitrary
=
FacetChart
<$>
arbitrary
<*>
arbitrary
arbitrary
=
FacetChart
<$>
arbitrary
<*>
arbitrary
...
...
src/Gargantext/Types/Node.hs
View file @
60b07ef4
...
@@ -9,6 +9,7 @@ Portability : POSIX
...
@@ -9,6 +9,7 @@ Portability : POSIX
-}
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings #-}
...
@@ -17,10 +18,14 @@ Portability : POSIX
...
@@ -17,10 +18,14 @@ Portability : POSIX
module
Gargantext.Types.Node
where
module
Gargantext.Types.Node
where
import
Prelude
(
Enum
,
Bounded
,
minBound
,
maxBound
)
import
GHC.Generics
(
Generic
)
import
GHC.Generics
(
Generic
)
import
Control.Lens
hiding
(
elements
)
import
Control.Lens
hiding
(
elements
)
import
qualified
Control.Lens
as
L
import
qualified
Control.Lens
as
L
import
Control.Applicative
((
<*>
))
import
Data.Aeson
import
Data.Aeson
import
Data.Aeson
(
Value
(),
toJSON
)
import
Data.Aeson
(
Value
(),
toJSON
)
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Aeson.TH
(
deriveJSON
)
...
@@ -29,7 +34,7 @@ import Data.Either
...
@@ -29,7 +34,7 @@ import Data.Either
import
Data.Eq
(
Eq
)
import
Data.Eq
(
Eq
)
import
Data.Text
(
Text
,
unpack
)
import
Data.Text
(
Text
,
unpack
)
import
Data.Time
(
UTCTime
)
import
Data.Time
(
UTCTime
)
import
Data.Time.Segment
(
jour
)
import
Data.Time.Segment
(
jour
,
timesAfter
,
Granularity
(
D
)
)
import
Data.Swagger
import
Data.Swagger
import
Text.Read
(
read
)
import
Text.Read
(
read
)
...
@@ -44,17 +49,23 @@ import Gargantext.Prelude
...
@@ -44,17 +49,23 @@ import Gargantext.Prelude
import
Gargantext.Utils.Prefix
(
unPrefix
)
import
Gargantext.Utils.Prefix
(
unPrefix
)
------------------------------------------------------------------------
------------------------------------------------------------------------
data
Status
=
Status
{
status_date
::
Maybe
UTCTime
,
status_error
::
Maybe
Text
type
UTCTime'
=
UTCTime
,
status_action
::
Maybe
Text
,
status_complete
::
Maybe
Bool
instance
Arbitrary
UTCTime'
where
,
status_progress
::
Maybe
Int
arbitrary
=
elements
$
timesAfter
100
D
(
jour
2000
01
01
)
------------------------------------------------------------------------
data
Status
=
Status
{
status_failed
::
Int
,
status_succeeded
::
Int
,
status_remaining
::
Int
}
deriving
(
Show
,
Generic
)
}
deriving
(
Show
,
Generic
)
$
(
deriveJSON
(
unPrefix
"status_"
)
''
S
tatus
)
$
(
deriveJSON
(
unPrefix
"status_"
)
''
S
tatus
)
instance
Arbitrary
Status
where
instance
Arbitrary
Status
where
arbitrary
=
elements
[
Status
Nothing
Nothing
Nothing
Nothing
Nothing
]
arbitrary
=
Status
<$>
arbitrary
<*>
arbitrary
<*>
arbitrary
------------------------------------------------------------------------
------------------------------------------------------------------------
data
HyperdataDocument
=
HyperdataDocument
{
hyperdataDocument_bdd
::
Maybe
Text
data
HyperdataDocument
=
HyperdataDocument
{
hyperdataDocument_bdd
::
Maybe
Text
...
@@ -99,25 +110,50 @@ data LanguageNodes = LanguageNodes { languageNodes___unknown__ :: [Int]}
...
@@ -99,25 +110,50 @@ data LanguageNodes = LanguageNodes { languageNodes___unknown__ :: [Int]}
deriving
(
Show
,
Generic
)
deriving
(
Show
,
Generic
)
$
(
deriveJSON
(
unPrefix
"languageNodes_"
)
''
L
anguageNodes
)
$
(
deriveJSON
(
unPrefix
"languageNodes_"
)
''
L
anguageNodes
)
------------------------------------------------------------------------
-- level: debug | dev (fatal = critical)
data
EventLevel
=
CRITICAL
|
FATAL
|
ERROR
|
WARNING
|
INFO
|
DEBUG
deriving
(
Show
,
Generic
,
Enum
,
Bounded
)
instance
FromJSON
EventLevel
instance
ToJSON
EventLevel
instance
Arbitrary
EventLevel
where
arbitrary
=
elements
[
minBound
..
maxBound
]
------------------------------------------------------------------------
------------------------------------------------------------------------
data
Resource
=
Resource
{
resource_url
::
Maybe
Text
data
Event
=
Event
{
event_level
::
EventLevel
,
resource_path
::
Maybe
Text
,
event_message
::
Text
,
resource_type
::
Maybe
Int
,
event_date
::
UTCTime
,
resource_extracted
::
Maybe
Bool
}
deriving
(
Show
,
Generic
)
$
(
deriveJSON
(
unPrefix
"event_"
)
''
E
vent
)
instance
Arbitrary
Event
where
arbitrary
=
Event
<$>
arbitrary
<*>
arbitrary
<*>
arbitrary
------------------------------------------------------------------------
type
Text'
=
Text
instance
Arbitrary
Text'
where
arbitrary
=
elements
[
"ici"
,
"la"
]
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
)
}
deriving
(
Show
,
Generic
)
$
(
deriveJSON
(
unPrefix
"resource_"
)
''
R
esource
)
$
(
deriveJSON
(
unPrefix
"resource_"
)
''
R
esource
)
instance
Arbitrary
Resource
where
instance
Arbitrary
Resource
where
arbitrary
=
elements
[
Resource
Nothing
Nothing
Nothing
Nothing
]
arbitrary
=
Resource
<$>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
data
HyperdataCorpus
=
HyperdataCorpus
{
hyperdataCorpus_action
::
Maybe
Text
------------------------------------------------------------------------
,
hyperdataCorpus_statuses
::
Maybe
[
Status
]
,
hyperdataCorpus_languages
::
Maybe
LanguageNodes
data
HyperdataCorpus
=
HyperdataCorpus
{
hyperdataCorpus_resources
::
[
Resource
]
,
hyperdataCorpus_resources
::
Maybe
[
Resource
]
,
hyperdataCorpus_language_id
::
Maybe
Text
,
hyperdataCorpus_skipped_docs
::
Maybe
[
Int
]
}
deriving
(
Show
,
Generic
)
}
deriving
(
Show
,
Generic
)
$
(
deriveJSON
(
unPrefix
"hyperdataCorpus_"
)
''
H
yperdataCorpus
)
$
(
deriveJSON
(
unPrefix
"hyperdataCorpus_"
)
''
H
yperdataCorpus
)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment