Skip to content

P
purescript-gargantext
Commit 0263b04a authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

Merge branch 'dev' into dev-ngrams-refactoring

parents 6f0964ea cb5b4bf7
Hide whitespace changes
Inline Side-by-side
Showing with 351 additions and 151 deletions
package.json
View file @ 0263b04a
{
"name": "Gargantext",
"version": "0.0.0.4",
"version": "0.0.1.3.2",
"scripts": {
"rebase-set": "spago package-set-upgrade && spago psc-package-insdhall",
"rebuild-set": "spago psc-package-insdhall",
......
src/Gargantext/Components/App.purs
View file @ 0263b04a
......@@ -12,7 +12,7 @@ import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Data.Lang (LandingLang(..))
import Gargantext.Components.Lang (LandingLang(..))
import Gargantext.Components.Forest (forest)
import Gargantext.Components.GraphExplorer (explorerLayout)
import Gargantext.Components.Login (login)
......
src/Gargantext/Components/Forest/Tree/Node.purs
View file @ 0263b04a
......@@ -82,18 +82,14 @@ settingsBox NodeUser = SettingsBox {
show: true
, edit : false
, doc : Documentation NodeUser
, buttons : [ SearchBox
, Add [FolderPrivate, FolderShared, FolderPublic]
, Delete
]
, buttons : [ Delete ]
}
settingsBox FolderPrivate = SettingsBox {
show: true
, edit : false
, doc : Documentation FolderPrivate
, buttons : [ SearchBox
, Add [ Corpus
, buttons : [ Add [ Corpus
, Folder
, Annuaire
]
......@@ -104,8 +100,7 @@ settingsBox Team = SettingsBox {
show: true
, edit : true
, doc : Documentation Team
, buttons : [ SearchBox
, Add [ Corpus
, buttons : [ Add [ Corpus
, Folder
, Annuaire
]
......@@ -117,7 +112,7 @@ settingsBox FolderShared = SettingsBox {
, edit : true
, doc : Documentation FolderShared
, buttons : [ Add [Team, FolderShared]
, Delete
-- , Delete
]
}
......@@ -125,8 +120,7 @@ settingsBox FolderPublic = SettingsBox {
show: true
, edit : false
, doc : Documentation FolderPublic
, buttons : [ SearchBox
, Add [ Corpus
, buttons : [ Add [ Corpus
, Folder
]
]
......@@ -136,8 +130,7 @@ settingsBox Folder = SettingsBox {
show: true
, edit : true
, doc : Documentation Folder
, buttons : [ SearchBox
, Add [ Corpus
, buttons : [ Add [ Corpus
, Folder
, Annuaire
]
......@@ -170,7 +163,7 @@ settingsBox Texts = SettingsBox {
, doc : Documentation Texts
, buttons : [ Upload
, Download
, Delete
-- , Delete
]
}
......@@ -178,8 +171,7 @@ settingsBox Graph = SettingsBox {
show: true
, edit : false
, doc : Documentation Graph
, buttons : [ Documentation Graph
, Download
, buttons : [ Download -- TODO as GEXF or JSON
, Delete
]
}
......@@ -191,7 +183,7 @@ settingsBox NodeList = SettingsBox {
, buttons : [ Upload
, CopyFromCorpus
, Download
, Delete
-- , Delete
]
}
......@@ -199,7 +191,7 @@ settingsBox Dashboard = SettingsBox {
show: true
, edit : false
, doc : Documentation Dashboard
, buttons : [Delete]
, buttons : []
}
settingsBox Annuaire = SettingsBox {
......@@ -207,7 +199,8 @@ settingsBox Annuaire = SettingsBox {
, edit : false
, doc : Documentation Annuaire
, buttons : [ Upload
, Delete ]
, Delete
]
}
settingsBox _ = SettingsBox {
......
src/Gargantext/Components/Forest/Tree/Node/Action.purs
View file @ 0263b04a
......@@ -9,7 +9,7 @@ import Data.Newtype (class Newtype)
import Effect.Aff (Aff)
import Prelude hiding (div)
import Gargantext.Components.Data.Lang (Lang)
import Gargantext.Components.Lang (Lang)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, put, post, delete)
import Gargantext.Types as GT
......
src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs
View file @ 0263b04a
......@@ -18,7 +18,7 @@ import Web.File.FileReader.Aff (readAsText)
import Gargantext.Prelude (class Show, Unit, bind, const, discard, map, pure, show, unit, void, ($), (&&), (/=), (<>))
import Gargantext.Components.Data.Lang (readLang, Lang(..))
import Gargantext.Components.Lang (readLang, Lang(..))
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), DroppedFile(..), FTree, FileType(..), ID, LNode(..), NTree(..), UploadFile, UploadFileContents(..), readFileType)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as GR
......
src/Gargantext/Components/Forest/Tree/Node/Box.purs
View file @ 0263b04a
......@@ -18,7 +18,7 @@ import URI.Extra.QueryPairs as NQP
import URI.Query as Query
import Web.File.FileReader.Aff (readAsText)
import Gargantext.Components.Data.Lang (allLangs, Lang(EN))
import Gargantext.Components.Lang (allLangs, Lang(EN))
import Gargantext.Components.Forest.Tree.Node (NodeAction(..), SettingsBox(..), glyphiconNodeAction, settingsBox)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), DroppedFile(..), FileType(..), ID, Name, UploadFileContents(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), createNodeView)
......
src/Gargantext/Components/Lang/Data/Lang.purs → src/Gargantext/Components/Lang.purs
View file @ 0263b04a
module Gargantext.Components.Data.Lang where
module Gargantext.Components.Lang where
import Data.Argonaut (class EncodeJson, encodeJson)
import Data.Maybe (Maybe(..))
......
src/Gargantext/Components/Nodes/Home.purs
View file @ 0263b04a
......@@ -10,7 +10,7 @@ import Gargantext.Components.Lang.Landing.EnUS as En
import Gargantext.Components.Lang.Landing.FrFR as Fr
import Gargantext.Components.Data.Landing
(BlockText(..), BlockTexts(..), Button(..), LandingData(..))
import Gargantext.Components.Data.Lang (LandingLang(..))
import Gargantext.Components.Lang (LandingLang(..))
type Props = ()
......
src/Gargantext/Components/Search/SearchBar.purs
View file @ 0263b04a
......@@ -4,16 +4,14 @@ module Gargantext.Components.Search.SearchBar
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude (Unit, pure, ($))
import Gargantext.Components.Data.Lang (Lang)
import Gargantext.Components.Search.Types (allDatabases) -- (Database, SearchQuery(..), defaultSearchQuery, performSearch, Lang(..))
import Gargantext.Components.Lang (Lang)
import Gargantext.Components.Search.SearchField (Search, searchField)
import Gargantext.Components.Search.Types (allDatabases) -- (Database, SearchQuery(..), defaultSearchQuery, performSearch, Lang(..))
import Gargantext.Prelude (Unit, pure, ($))
import Gargantext.Sessions (Session)
import Gargantext.Types as GT
import Reactix as R
import Reactix.DOM.HTML as H
type Props = ( langs :: Array Lang
, onSearch :: GT.AsyncTaskWithType -> Effect Unit
......
src/Gargantext/Components/Search/SearchField.purs
View file @ 0263b04a
module Gargantext.Components.Search.SearchField
( Search, Props, defaultSearch, searchField, searchFieldComponent, isIsTex) where
import Data.Maybe (Maybe(..), maybe)
import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Data.Newtype (over)
import Data.String (length)
import Data.Set as Set
......@@ -16,8 +16,9 @@ import Reactix.DOM.HTML as H
import Gargantext.Prelude (Unit, bind, const, discard, map, pure, show, ($), (&&), (<), (<$>), (<<<), (<>), (==))
import Gargantext.Components.Data.Lang (Lang)
import Gargantext.Components.Search.Types (DataField(..), Database(..), IMT_org(..), Org(..), SearchQuery(..), allIMTorgs, allOrgs, dataFields, defaultSearchQuery, doc, performSearch, readDatabase, readOrg) -- (Database(..), readDatabase, Lang(..), readLang, Org(..), readOrg, allOrgs, allIMTorgs, HAL_Filters(..), IMT_org(..))
import Gargantext.Data.Array (catMaybes)
import Gargantext.Components.Lang (Lang)
import Gargantext.Components.Search.Types (DataOriginApi(..), DataField(..), Database(..), IMT_org(..), Org(..), SearchQuery(..), allIMTorgs, allOrgs, dataFields, defaultSearchQuery, doc, performSearch, readDatabase, readOrg, datafield2database)
import Gargantext.Sessions (Session)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
......@@ -29,7 +30,7 @@ select :: forall props.
-> R.Element
select = R.createElement "select"
type Search = { databases :: Array Database
type Search = { databases :: Database
, datafield :: Maybe DataField
, lang :: Maybe Lang
, node_id :: Maybe Int
......@@ -39,16 +40,16 @@ type Search = { databases :: Array Database
eqSearch :: Search -> Search -> Boolean
eqSearch s s' = (s.databases == s'.databases)
&& (s.datafield == s'.datafield)
&& (s.term == s'.term)
&& (s.lang == s'.lang)
&& (s.node_id == s'.node_id)
&& (s.lang == s'.lang)
&& (s.node_id == s'.node_id)
&& (s.term == s'.term)
defaultSearch :: Search
defaultSearch = { databases: []
defaultSearch = { databases: Empty
, datafield: Nothing
, node_id: Nothing
, lang: Nothing
, term: ""
, node_id : Nothing
, lang : Nothing
, term : ""
}
type Props =
......@@ -77,33 +78,36 @@ searchFieldComponent = R.hooksComponent "G.C.S.SearchField" cpt
[
H.div { className: "col-md-12" }
[ searchInput {search}
, if length s.term < 3
, if length s.term < 3 -- search with love : <3
then
H.div {}[]
else
H.div {} [ dataFieldNav search dataFields
, if isExternal s.datafield
then databaseInput search props.databases
else H.div {} []
, if isHAL s.datafield
then orgInput search allOrgs
else H.div {} []
, if isIMT s.datafield
then componentIMT search
else H.div {} []
, if isCNRS s.datafield
then componentCNRS search
else H.div {} []
]
, if isExternal s.datafield
then databaseInput search props.databases
else H.div {} []
, if isHAL s.datafield
then orgInput search allOrgs
else H.div {} []
, if isIMT s.datafield
then componentIMT search
else H.div {} []
, if isCNRS s.datafield
then componentCNRS search
else H.div {} []
]
]
]
, H.div { className : "panel-footer" }
[ if needsLang s.datafield then langNav search props.langs else H.div {} []
[ if needsLang s.datafield
then langNav search props.langs
else H.div {} []
, H.div {} []
, H.div {className: "flex-center"} [submitButton {onSearch, search, session: props.session}]
, H.div {className: "flex-center"}
[submitButton {onSearch, search, session: props.session}]
]
]
eqProps :: Record Props -> Record Props -> Boolean
......@@ -120,11 +124,10 @@ searchFieldComponent = R.hooksComponent "G.C.S.SearchField" cpt
liCpt org =
H.li {}
[ H.input { type: "checkbox"
, checked: isIn org search.datafield
, on: {
change: \_ -> (setSearch $ _ { datafield = updateFilter org search.datafield })
, checked: isIn org search.datafield
, on: { change: \_ -> ( setSearch $ _ { datafield = updateFilter org search.datafield })
}
}
}
, if org == All_IMT
then H.i {} [H.text $ " " <> show org]
else H.text $ " " <> show org
......@@ -141,30 +144,73 @@ isExternal (Just (External _)) = true
isExternal _ = false
isHAL :: Maybe DataField -> Boolean
isHAL (Just (External (Just (HAL _)))) = true
isHAL (Just
( External
( Just (HAL _ )
)
)
) = true
isHAL _ = false
isIsTex :: Maybe DataField -> Boolean
isIsTex (Just (External (Just (IsTex)))) = true
isIsTex ( Just
( External
( Just ( IsTex)
)
)
) = true
isIsTex _ = false
isIMT :: Maybe DataField -> Boolean
isIMT (Just ( External ( Just ( HAL ( Just ( IMT _)))))) = true
isIMT ( Just
( External
( Just
( HAL
( Just ( IMT _)
)
)
)
)
) = true
isIMT _ = false
isCNRS :: Maybe DataField -> Boolean
isCNRS (Just ( External ( Just ( HAL ( Just ( CNRS _)))))) = true
isCNRS ( Just
( External
( Just
( HAL
( Just ( CNRS _)
)
)
)
)
) = true
isCNRS _ = false
needsLang :: Maybe DataField -> Boolean
needsLang (Just Gargantext) = true
needsLang (Just Web) = true
needsLang (Just ( External ( Just (HAL _)))) = true
needsLang _ = false
needsLang ( Just
( External
( Just (HAL _)
)
)
) = true
needsLang _ = false
isIn :: IMT_org -> Maybe DataField -> Boolean
isIn org (Just (External (Just (HAL (Just (IMT imtOrgs)))))) = Set.member org imtOrgs
isIn org ( Just
( External
( Just
( HAL
( Just
( IMT imtOrgs )
)
)
)
)
) = Set.member org imtOrgs
isIn _ _ = false
updateFilter :: IMT_org -> Maybe DataField -> Maybe DataField
......@@ -191,33 +237,39 @@ updateFilter org _ = (Just (External (Just (HAL (Just (IMT imtOrgs'))))))
langNav :: R.State Search -> Array Lang -> R.Element
langNav ({lang} /\ setSearch) langs =
R.fragment [ H.div {className: "text-primary center"} [H.text "with lang"]
, H.div { className: "nav nav-tabs"} (liItem <$> langs)
, H.div {className: "nav nav-tabs"} (liItem <$> langs)
]
where
liItem :: Lang -> R.Element
liItem lang' =
H.div { className : "nav-item nav-link" <> if (Just lang') == lang then " active" else ""
, on: { click: \_ -> setSearch $ _ { lang = Just lang' } }
} [ H.text (show lang') ]
, on: { click: \_ -> setSearch $ _ { lang = Just lang' } }
} [ H.text (show lang') ]
------------------------------------------------------------------------
dataFieldNav :: R.State Search -> Array DataField -> R.Element
dataFieldNav ({datafield} /\ setSearch) datafields =
R.fragment [ H.div {className: "text-primary center"} [H.text "with DataField"]
, H.div { className: "nav nav-tabs"} (liItem <$> dataFields)
, H.div {className:"center"} [ H.text $ maybe "" doc datafield ]
, H.div {className: "nav nav-tabs"} (liItem <$> dataFields)
, H.div {className: "center"} [ H.text $ maybe "" doc datafield ]
]
where
liItem :: DataField -> R.Element
liItem df' =
H.div { className : "nav-item nav-link" <> if (Just df') == datafield then " active" else ""
, on: { click: \_ -> setSearch $ _ { datafield = Just df'} }
H.div { className : "nav-item nav-link"
<> if (Just df') == datafield
then " active"
else ""
, on: { click: \_ -> setSearch $ _ { datafield = Just df'
, databases = datafield2database df'
}
}
-- just one database query for now
-- a list a selected database needs more ergonomy
} [ H.text (show df') ]
------------------------------------------------------------------------
{-
databaseNav :: R.State Search
-> Array Database
-> R.Element
......@@ -237,13 +289,12 @@ databaseNav ({datafield} /\ setSearch) dbs =
H.div { className : "nav-item nav-link" <> if (Just $ External $ Just df') == datafield then " active" else ""
, on: { click: \_ -> setSearch $ _ { datafield = Just $ External $ Just df' } }
} [ H.text (show df') ]
-}
databaseInput :: R.State Search
-> Array Database
-> R.Element
databaseInput ({datafield} /\ setSearch) dbs =
databaseInput (search /\ setSearch) dbs =
H.div { className: "form-group" }
[ H.div {className: "text-primary center"} [H.text "in database"]
, R2.select { className: "form-control"
......@@ -252,7 +303,7 @@ databaseInput ({datafield} /\ setSearch) dbs =
, H.div {className:"center"} [ H.text $ maybe "" doc db ]
]
where
db = case datafield of
db = case search.datafield of
(Just (External (Just x))) -> Just x
_ -> Nothing
......@@ -260,8 +311,10 @@ databaseInput ({datafield} /\ setSearch) dbs =
liItem db' = H.option {className : "text-primary center"} [ H.text (show db') ]
onChange e = do
let value = R2.unsafeEventValue e
setSearch $ _ {datafield = Just $ External $ readDatabase value }
let value = readDatabase $ R2.unsafeEventValue e
setSearch $ _ { datafield = Just $ External value
, databases = fromMaybe Empty value
}
orgInput :: R.State Search -> Array Org -> R.Element
......@@ -279,20 +332,22 @@ orgInput ({datafield} /\ setSearch) orgs =
let value = R2.unsafeEventValue e
setSearch $ _ { datafield = Just $ External $ Just $ HAL $ readOrg value }
{-
filterInput :: R.State String -> R.Element
filterInput (term /\ setTerm) =
H.div {className: "form-group"} [ H.input { defaultValue: term
, className: "form-control"
, type: "text"
, on: { change: setTerm <<< const <<< R2.unsafeEventValue }
, "required pattern": "[[0-9]+[ ]+]*"
-- TODO ^FIXME not sure about the regex comprehension: that should match "123 2334 44545" only (Integers separated by one space)
-- form validation with CSS
-- DOC: https://developer.mozilla.org/en-US/docs/Learn/HTML/Forms/Form_validation
, placeholder : "Filter with struct_Ids as integer"
}
]
H.div { className: "form-group" }
[ H.input { defaultValue: term
, className: "form-control"
, type: "text"
, on: { change: setTerm <<< const <<< R2.unsafeEventValue }
, "required pattern": "[[0-9]+[ ]+]*"
-- TODO ^FIXME not sure about the regex comprehension: that should match "123 2334 44545" only (Integers separated by one space)
-- form validation with CSS
-- DOC: https://developer.mozilla.org/en-US/docs/Learn/HTML/Forms/Form_validation
, placeholder : "Filter with struct_Ids as integer"
}
]
-}
type SearchInputProps =
(
......@@ -312,15 +367,15 @@ searchInputComponent = R.hooksComponent "G.C.S.SearchInput" cpt
, className: "form-control"
, type: "text"
, on: { change : onChange setSearch }
, placeholder: "Your Query here" }
, placeholder: "Your Query here"
}
]
onChange setSearch e = do
let value = R2.unsafeEventValue e
setSearch $ _ { term = value }
type SubmitButtonProps =
(
onSearch :: GT.AsyncTaskWithType -> Effect Unit
( onSearch :: GT.AsyncTaskWithType -> Effect Unit
, search :: R.State Search
, session :: Session
)
......@@ -331,12 +386,12 @@ submitButton p = R.createElement submitButtonComponent p []
submitButtonComponent :: R.Component SubmitButtonProps
submitButtonComponent = R.hooksComponent "G.C.S.SubmitButton" cpt
where
cpt {onSearch, search: (search /\ _), session} _ =
cpt {onSearch, search: (mySearch /\ _), session} _ =
pure $
H.button { className: "btn btn-primary"
, type: "button"
, on: {click: doSearch onSearch session search}
, style: { width: "100%" }
, "type" : "button"
, on : {click: doSearch onSearch session mySearch}
, style : { width: "100%" }
} [ H.text "Launch Search" ]
doSearch os s q = \_ -> do
......@@ -346,14 +401,18 @@ submitButtonComponent = R.hooksComponent "G.C.S.SubmitButton" cpt
-- "" -> setSearch $ const defaultSearch
-- _ -> setSearch $ const q
triggerSearch :: (GT.AsyncTaskWithType -> Effect Unit) -> Session -> Search -> Effect Unit
triggerSearch :: (GT.AsyncTaskWithType -> Effect Unit)
-> Session
-> Search
-> Effect Unit
triggerSearch os s q =
launchAff_ $ do
liftEffect $ do
-- log2 "Searching datafield: " $ show q.database
log2 "[triggerSearch] Searching term: " q.term
log2 "[triggerSearch] Searching lang: " q.lang
let here = "[triggerSearch] Searching "
log2 (here <> "databases: ") (show q.databases)
log2 (here <> "datafield: ") (show q.datafield)
log2 (here <> "term: ") q.term
log2 (here <> "lang: ") (show q.lang)
case q.node_id of
Nothing -> liftEffect $ log "[triggerSearch] node_id is Nothing, don't know what to do"
......@@ -371,9 +430,9 @@ searchQuery :: Search -> SearchQuery
searchQuery {datafield: Nothing, term} =
over SearchQuery (_ {query=term}) defaultSearchQuery
searchQuery {databases, datafield, lang, term, node_id} =
over SearchQuery (_ { databases=databases
, datafield=datafield
, lang=lang
, query=term
, node_id=node_id
over SearchQuery (_ { databases= databases
, datafield= datafield
, lang = lang
, query = term
, node_id = node_id
}) defaultSearchQuery
src/Gargantext/Components/Search/Types.purs
View file @ 0263b04a
......@@ -14,7 +14,7 @@ import URI.Query as Q
import Gargantext.Prelude (class Eq, class Ord, class Show, bind, map, pure, show, ($), (<>))
import Gargantext.Components.Data.Lang
import Gargantext.Components.Lang
import Gargantext.Ends (class ToUrl, backendUrl)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session(..), post)
......@@ -40,9 +40,10 @@ data DataField = Gargantext
| Web
| Files
instance showDataField :: Show DataField where
show Gargantext = "Gargantext"
show (External x) = "External" -- <> show x
show (External _) = "Others" -- <> show x
show Web = "Web"
show Files = "Files"
......@@ -52,21 +53,42 @@ instance docDataField :: Doc DataField where
doc Web = "All the web crawled with meta-search-engine SearX"
doc Files = "Zip files with formats.."
derive instance eqDataField :: Eq DataField
{-
instance eqDataField :: Eq DataField where
eq Gargantext Gargantext = true
eq (External _) (External _) = true
eq Web Web = true
eq _ _ = false
-}
instance encodeJsonDataField :: EncodeJson DataField where
encodeJson Gargantext = encodeJson "Internal PubMed" -- later Internal Maybe Database
encodeJson (External (Just db)) = encodeJson $ "External " <> show db
encodeJson a = encodeJson (show a)
----------------------------------------
instance showDataOriginApi :: Show DataOriginApi where
show (InternalOrigin io) = "InternalOrigin " <> show io.api
show (ExternalOrigin io) = "ExternalOrigin " <> show io.api
derive instance eqDataOriginApi :: Eq DataOriginApi
data DataOriginApi = InternalOrigin { api :: Database }
| ExternalOrigin { api :: Database }
instance encodeJsonDataOriginApi :: EncodeJson DataOriginApi where
encodeJson (InternalOrigin dta) = "api" := dta.api ~> jsonEmptyObject
encodeJson (ExternalOrigin dta) = "api" := dta.api ~> jsonEmptyObject
datafield2dataOriginApi :: DataField -> DataOriginApi
datafield2dataOriginApi (External (Just a)) = ExternalOrigin { api : a }
datafield2dataOriginApi _ = InternalOrigin { api : IsTex } -- TOD fixme
------------------------------------------------------------------------
-- | Database search specifications
datafield2database :: DataField -> Database
datafield2database (External (Just x)) = x
datafield2database _ = Empty
allDatabases :: Array Database
allDatabases = [ PubMed
allDatabases = [ Empty
, PubMed
, HAL Nothing
, IsTex
, Isidore
......@@ -76,6 +98,7 @@ allDatabases = [ PubMed
]
data Database = All_Databases
| Empty
| PubMed
| HAL (Maybe Org)
| IsTex
......@@ -89,6 +112,7 @@ instance showDatabase :: Show Database where
show (HAL _)= "HAL"
show IsTex = "IsTex"
show Isidore= "Isidore"
show Empty = "Empty"
-- show News = "News"
-- show SocialNetworks = "Social Networks"
......@@ -98,6 +122,7 @@ instance docDatabase :: Doc Database where
doc (HAL _) = "All open science (archives ouvertes)"
doc IsTex = "All Elsevier enriched by CNRS/INIST"
doc Isidore = "All (French) Social Sciences"
doc Empty = "Empty"
-- doc News = "Web filtered by News"
-- doc SocialNetworks = "Web filtered by MicroBlogs"
......@@ -116,6 +141,7 @@ derive instance eqDatabase :: Eq Database
instance encodeJsonDatabase :: EncodeJson Database where
encodeJson a = encodeJson (show a)
------------------------------------------------------------------------
-- | Organization specifications
......@@ -279,7 +305,7 @@ instance showSearchOrder :: Show SearchOrder where
newtype SearchQuery = SearchQuery
{ query :: String
, databases :: Array Database
, databases :: Database
, datafield :: Maybe DataField
, files_id :: Array String
, lang :: Maybe Lang
......@@ -294,14 +320,14 @@ derive instance newtypeSearchQuery :: Newtype SearchQuery _
defaultSearchQuery :: SearchQuery
defaultSearchQuery = SearchQuery
{ query: ""
, databases: []
, databases: Empty
, datafield: Nothing
, files_id : []
, lang : Nothing
, limit: Nothing
, node_id : Nothing
, offset: Nothing
, order: Nothing
, lang : Nothing
, limit : Nothing
, node_id : Nothing
, offset : Nothing
, order : Nothing
}
instance toUrlSessionSearchQuery :: ToUrl Session SearchQuery where
......
src/Gargantext/Types.purs
View file @ 0263b04a
......@@ -467,12 +467,12 @@ derive instance genericAsyncTaskType :: Generic AsyncTaskType _
asyncTaskTypePath :: AsyncTaskType -> String
asyncTaskTypePath Form = "add/form/async/"
asyncTaskTypePath GraphT = "async/nobody/"
asyncTaskTypePath Query = "add/query/async/"
asyncTaskTypePath Query = "query/"
asyncTaskTypePath GraphT = "async/"
type AsyncTaskID = String
data AsyncTaskStatus = Running | Failed | Finished | Killed
data AsyncTaskStatus = Running | Pending | Received | Started | Failed | Finished | Killed
derive instance genericAsyncTaskStatus :: Generic AsyncTaskStatus _
derive instance eqAsyncTaskStatus :: Eq AsyncTaskStatus
instance decodeJsonAsyncTaskStatus :: DecodeJson AsyncTaskStatus where
......@@ -481,10 +481,13 @@ instance decodeJsonAsyncTaskStatus :: DecodeJson AsyncTaskStatus where
pure $ readAsyncTaskStatus obj
readAsyncTaskStatus :: String -> AsyncTaskStatus
readAsyncTaskStatus "failed" = Failed
readAsyncTaskStatus "finished" = Finished
readAsyncTaskStatus "killed" = Killed
readAsyncTaskStatus "running" = Running
readAsyncTaskStatus "IsFailure" = Failed
readAsyncTaskStatus "IsFinished" = Finished
readAsyncTaskStatus "IsKilled" = Killed
readAsyncTaskStatus "IsPending" = Pending
readAsyncTaskStatus "IsReceived" = Received
readAsyncTaskStatus "IsRunning" = Running
readAsyncTaskStatus "IsStarted" = Started
readAsyncTaskStatus _ = Running
newtype AsyncTask = AsyncTask {
......
src/Gargantext/Utils/Argonaut.purs 0 → 100644
View file @ 0263b04a
module Gargantext.Utils.Argonaut where
import Prelude
import Control.Alt ((<|>))
import Data.Argonaut (Json)
import Data.Argonaut as Argonaut
import Data.Either (Either)
import Data.Generic.Rep as GR
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
-- | Provide a generic sum JSON decoding for sum types deriving Generic
genericSumDecodeJson
:: forall a rep
. GR.Generic a rep
=> GenericSumDecodeJsonRep rep
=> Json
-> Either String a
genericSumDecodeJson f =
GR.to <$> genericSumDecodeJsonRep f
-- | Provide a generic sum JSON encoding for sum types deriving Generic
genericSumEncodeJson
:: forall a rep
. GR.Generic a rep
=> GenericSumEncodeJsonRep rep
=> a
-> Json
genericSumEncodeJson f =
genericSumEncodeJsonRep $ GR.from f
class GenericSumDecodeJsonRep rep where
genericSumDecodeJsonRep :: Json -> Either String rep
class GenericSumEncodeJsonRep rep where
genericSumEncodeJsonRep :: rep -> Json
instance genericSumDecodeJsonRepSum ::
( GenericSumDecodeJsonRep a
, GenericSumDecodeJsonRep b
) => GenericSumDecodeJsonRep (GR.Sum a b) where
genericSumDecodeJsonRep f
= GR.Inl <$> genericSumDecodeJsonRep f
<|> GR.Inr <$> genericSumDecodeJsonRep f
instance genericSumDecodeJsonRepConstructor ::
( GenericSumDecodeJsonRep a
, IsSymbol name
) => GenericSumDecodeJsonRep (GR.Constructor name a) where
genericSumDecodeJsonRep f = do
-- here we attempt to read the following json:
-- { "ConstructorName": argument }
let name = reflectSymbol (SProxy :: _ name)
obj <- Argonaut.decodeJson f
inner <- Argonaut.getField obj name
argument <- genericSumDecodeJsonRep inner
pure $ GR.Constructor argument
instance genericSumDecodeJsonRepArgument ::
( Argonaut.DecodeJson a
) => GenericSumDecodeJsonRep (GR.Argument a) where
genericSumDecodeJsonRep f = GR.Argument <$> Argonaut.decodeJson f
instance genericSumEncodeJsonRepSum ::
( GenericSumEncodeJsonRep a
, GenericSumEncodeJsonRep b
) => GenericSumEncodeJsonRep (GR.Sum a b) where
genericSumEncodeJsonRep (GR.Inl f) = genericSumEncodeJsonRep f
genericSumEncodeJsonRep (GR.Inr f) = genericSumEncodeJsonRep f
instance genericSumEncodeJsonRepConstructor ::
( GenericSumEncodeJsonRep a
, IsSymbol name
) => GenericSumEncodeJsonRep (GR.Constructor name a) where
genericSumEncodeJsonRep (GR.Constructor inner) = do
-- here we attempt to write the following json:
-- { "ConstructorName": argument }
let name = reflectSymbol (SProxy :: _ name)
let argument = genericSumEncodeJsonRep inner
Argonaut.jsonSingletonObject name argument
instance genericSumEncodeJsonRepArgument ::
( Argonaut.EncodeJson a
) => GenericSumEncodeJsonRep (GR.Argument a) where
genericSumEncodeJsonRep (GR.Argument f) = Argonaut.encodeJson f
test/Gargantext/Utils/Spec.purs
View file @ 0263b04a
module Gargantext.Utils.Spec where
import Prelude
import Data.Array (index)
import Data.Foldable (all)
import Data.Maybe (Maybe(..), isJust)
import Data.String (drop, stripPrefix, Pattern(..))
import Data.Tuple (Tuple(..))
import Data.Argonaut as Argonaut
import Data.Either (Either(..), isLeft)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Gargantext.Utils as GU
import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson)
import Gargantext.Utils.Crypto as GUC
import Gargantext.Utils.Math as GUM
-- import Test.QuickCheck ((===), (/==), (<?>), Result(..))
import Test.Spec (Spec, describe, it)
import Test.Spec.Assertions (shouldEqual)
import Test.Spec.QuickCheck (quickCheck')
data Fruit
= Boat { hi :: Int }
| Gravy String
| Pork Int
derive instance eqFruit :: Eq Fruit
derive instance genericFruit :: Generic Fruit _
instance showFruit :: Show Fruit where
show = genericShow
instance decodeJsonFruit :: Argonaut.DecodeJson Fruit where
decodeJson = genericSumDecodeJson
instance encodeJsonFruit :: Argonaut.EncodeJson Fruit where
encodeJson = genericSumEncodeJson
spec :: Spec Unit
spec =
......@@ -40,3 +53,26 @@ spec =
let text = "The quick brown fox jumps over the lazy dog"
let textMd5 = "9e107d9d372bb6826bd81d3542a419d6"
GUC.md5 text `shouldEqual` textMd5
it "genericSumDecodeJson works" do
let result1 = Argonaut.decodeJson =<< Argonaut.jsonParser """{"Boat":{"hi":1}}"""
result1 `shouldEqual` Right (Boat { hi: 1 })
let result2 = Argonaut.decodeJson =<< Argonaut.jsonParser """{"Gravy":"hi"}"""
result2 `shouldEqual` Right (Gravy "hi")
let result3 = Argonaut.decodeJson =<< Argonaut.jsonParser """{"Boat":123}"""
isLeft (result3 :: Either String Fruit) `shouldEqual` true
it "genericSumEncodeJson works and loops back with decode" do
let input1 = Boat { hi: 1 }
let result1 = Argonaut.encodeJson input1
let result1' = Argonaut.decodeJson result1
Argonaut.stringify result1 `shouldEqual` """{"Boat":{"hi":1}}"""
result1' `shouldEqual` Right input1
let input2 = Gravy "hi"
let result2 = Argonaut.encodeJson input2
let result2' = Argonaut.decodeJson result2
Argonaut.stringify result2 `shouldEqual` """{"Gravy":"hi"}"""
result2' `shouldEqual` Right input2
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