Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
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
Grégoire Locqueville
purescript-gargantext
Commits
0263b04a
Commit
0263b04a
authored
Apr 24, 2020
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'dev' into dev-ngrams-refactoring
parents
6f0964ea
cb5b4bf7
Changes
15
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
15 changed files
with
351 additions
and
151 deletions
+351
-151
package.json
package.json
+1
-1
App.purs
src/Gargantext/Components/App.purs
+1
-1
Node.purs
src/Gargantext/Components/Forest/Tree/Node.purs
+12
-19
Action.purs
src/Gargantext/Components/Forest/Tree/Node/Action.purs
+1
-1
Upload.purs
...Gargantext/Components/Forest/Tree/Node/Action/Upload.purs
+1
-1
Box.purs
src/Gargantext/Components/Forest/Tree/Node/Box.purs
+1
-1
Lang.purs
src/Gargantext/Components/Lang.purs
+1
-1
Landing.purs
src/Gargantext/Components/Lang/Landing.purs
+0
-0
Home.purs
src/Gargantext/Components/Nodes/Home.purs
+1
-1
SearchBar.purs
src/Gargantext/Components/Search/SearchBar.purs
+5
-7
SearchField.purs
src/Gargantext/Components/Search/SearchField.purs
+145
-86
Types.purs
src/Gargantext/Components/Search/Types.purs
+44
-18
Types.purs
src/Gargantext/Types.purs
+10
-7
Argonaut.purs
src/Gargantext/Utils/Argonaut.purs
+85
-0
Spec.purs
test/Gargantext/Utils/Spec.purs
+43
-7
No files found.
package.json
View file @
0263b04a
{
{
"name"
:
"Gargantext"
,
"name"
:
"Gargantext"
,
"version"
:
"0.0.
0.4
"
,
"version"
:
"0.0.
1.3.2
"
,
"scripts"
:
{
"scripts"
:
{
"rebase-set"
:
"spago package-set-upgrade && spago psc-package-insdhall"
,
"rebase-set"
:
"spago package-set-upgrade && spago psc-package-insdhall"
,
"rebuild-set"
:
"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)
...
@@ -12,7 +12,7 @@ import Effect.Class (liftEffect)
import Reactix as R
import Reactix as R
import Reactix.DOM.HTML as H
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.Forest (forest)
import Gargantext.Components.GraphExplorer (explorerLayout)
import Gargantext.Components.GraphExplorer (explorerLayout)
import Gargantext.Components.Login (login)
import Gargantext.Components.Login (login)
...
...
src/Gargantext/Components/Forest/Tree/Node.purs
View file @
0263b04a
...
@@ -82,18 +82,14 @@ settingsBox NodeUser = SettingsBox {
...
@@ -82,18 +82,14 @@ settingsBox NodeUser = SettingsBox {
show: true
show: true
, edit : false
, edit : false
, doc : Documentation NodeUser
, doc : Documentation NodeUser
, buttons : [ SearchBox
, buttons : [ Delete ]
, Add [FolderPrivate, FolderShared, FolderPublic]
, Delete
]
}
}
settingsBox FolderPrivate = SettingsBox {
settingsBox FolderPrivate = SettingsBox {
show: true
show: true
, edit : false
, edit : false
, doc : Documentation FolderPrivate
, doc : Documentation FolderPrivate
, buttons : [ SearchBox
, buttons : [ Add [ Corpus
, Add [ Corpus
, Folder
, Folder
, Annuaire
, Annuaire
]
]
...
@@ -104,8 +100,7 @@ settingsBox Team = SettingsBox {
...
@@ -104,8 +100,7 @@ settingsBox Team = SettingsBox {
show: true
show: true
, edit : true
, edit : true
, doc : Documentation Team
, doc : Documentation Team
, buttons : [ SearchBox
, buttons : [ Add [ Corpus
, Add [ Corpus
, Folder
, Folder
, Annuaire
, Annuaire
]
]
...
@@ -117,7 +112,7 @@ settingsBox FolderShared = SettingsBox {
...
@@ -117,7 +112,7 @@ settingsBox FolderShared = SettingsBox {
, edit : true
, edit : true
, doc : Documentation FolderShared
, doc : Documentation FolderShared
, buttons : [ Add [Team, FolderShared]
, buttons : [ Add [Team, FolderShared]
, Delete
--
, Delete
]
]
}
}
...
@@ -125,8 +120,7 @@ settingsBox FolderPublic = SettingsBox {
...
@@ -125,8 +120,7 @@ settingsBox FolderPublic = SettingsBox {
show: true
show: true
, edit : false
, edit : false
, doc : Documentation FolderPublic
, doc : Documentation FolderPublic
, buttons : [ SearchBox
, buttons : [ Add [ Corpus
, Add [ Corpus
, Folder
, Folder
]
]
]
]
...
@@ -136,8 +130,7 @@ settingsBox Folder = SettingsBox {
...
@@ -136,8 +130,7 @@ settingsBox Folder = SettingsBox {
show: true
show: true
, edit : true
, edit : true
, doc : Documentation Folder
, doc : Documentation Folder
, buttons : [ SearchBox
, buttons : [ Add [ Corpus
, Add [ Corpus
, Folder
, Folder
, Annuaire
, Annuaire
]
]
...
@@ -170,7 +163,7 @@ settingsBox Texts = SettingsBox {
...
@@ -170,7 +163,7 @@ settingsBox Texts = SettingsBox {
, doc : Documentation Texts
, doc : Documentation Texts
, buttons : [ Upload
, buttons : [ Upload
, Download
, Download
, Delete
--
, Delete
]
]
}
}
...
@@ -178,8 +171,7 @@ settingsBox Graph = SettingsBox {
...
@@ -178,8 +171,7 @@ settingsBox Graph = SettingsBox {
show: true
show: true
, edit : false
, edit : false
, doc : Documentation Graph
, doc : Documentation Graph
, buttons : [ Documentation Graph
, buttons : [ Download -- TODO as GEXF or JSON
, Download
, Delete
, Delete
]
]
}
}
...
@@ -191,7 +183,7 @@ settingsBox NodeList = SettingsBox {
...
@@ -191,7 +183,7 @@ settingsBox NodeList = SettingsBox {
, buttons : [ Upload
, buttons : [ Upload
, CopyFromCorpus
, CopyFromCorpus
, Download
, Download
, Delete
--
, Delete
]
]
}
}
...
@@ -199,7 +191,7 @@ settingsBox Dashboard = SettingsBox {
...
@@ -199,7 +191,7 @@ settingsBox Dashboard = SettingsBox {
show: true
show: true
, edit : false
, edit : false
, doc : Documentation Dashboard
, doc : Documentation Dashboard
, buttons : [
Delete
]
, buttons : []
}
}
settingsBox Annuaire = SettingsBox {
settingsBox Annuaire = SettingsBox {
...
@@ -207,7 +199,8 @@ settingsBox Annuaire = SettingsBox {
...
@@ -207,7 +199,8 @@ settingsBox Annuaire = SettingsBox {
, edit : false
, edit : false
, doc : Documentation Annuaire
, doc : Documentation Annuaire
, buttons : [ Upload
, buttons : [ Upload
, Delete ]
, Delete
]
}
}
settingsBox _ = SettingsBox {
settingsBox _ = SettingsBox {
...
...
src/Gargantext/Components/Forest/Tree/Node/Action.purs
View file @
0263b04a
...
@@ -9,7 +9,7 @@ import Data.Newtype (class Newtype)
...
@@ -9,7 +9,7 @@ import Data.Newtype (class Newtype)
import Effect.Aff (Aff)
import Effect.Aff (Aff)
import Prelude hiding (div)
import Prelude hiding (div)
import Gargantext.Components.
Data.
Lang (Lang)
import Gargantext.Components.Lang (Lang)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, put, post, delete)
import Gargantext.Sessions (Session, get, put, post, delete)
import Gargantext.Types as GT
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)
...
@@ -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.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.Components.Forest.Tree.Node.Action (Action(..), DroppedFile(..), FTree, FileType(..), ID, LNode(..), NTree(..), UploadFile, UploadFileContents(..), readFileType)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as GR
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
...
@@ -18,7 +18,7 @@ import URI.Extra.QueryPairs as NQP
import URI.Query as Query
import URI.Query as Query
import Web.File.FileReader.Aff (readAsText)
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 (NodeAction(..), SettingsBox(..), glyphiconNodeAction, settingsBox)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), DroppedFile(..), FileType(..), ID, Name, UploadFileContents(..))
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), DroppedFile(..), FileType(..), ID, Name, UploadFileContents(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), createNodeView)
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.Argonaut (class EncodeJson, encodeJson)
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe(..))
...
...
src/Gargantext/Components/Lang/
Data/
Landing.purs
→
src/Gargantext/Components/Lang/Landing.purs
View file @
0263b04a
File moved
src/Gargantext/Components/Nodes/Home.purs
View file @
0263b04a
...
@@ -10,7 +10,7 @@ import Gargantext.Components.Lang.Landing.EnUS as En
...
@@ -10,7 +10,7 @@ import Gargantext.Components.Lang.Landing.EnUS as En
import Gargantext.Components.Lang.Landing.FrFR as Fr
import Gargantext.Components.Lang.Landing.FrFR as Fr
import Gargantext.Components.Data.Landing
import Gargantext.Components.Data.Landing
(BlockText(..), BlockTexts(..), Button(..), LandingData(..))
(BlockText(..), BlockTexts(..), Button(..), LandingData(..))
import Gargantext.Components.
Data.
Lang (LandingLang(..))
import Gargantext.Components.Lang (LandingLang(..))
type Props = ()
type Props = ()
...
...
src/Gargantext/Components/Search/SearchBar.purs
View file @
0263b04a
...
@@ -4,16 +4,14 @@ module Gargantext.Components.Search.SearchBar
...
@@ -4,16 +4,14 @@ module Gargantext.Components.Search.SearchBar
import Data.Tuple.Nested ((/\))
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect (Effect)
import Reactix as R
import Gargantext.Components.Lang (Lang)
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.Search.SearchField (Search, searchField)
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.Sessions (Session)
import Gargantext.Types as GT
import Gargantext.Types as GT
import Reactix as R
import Reactix.DOM.HTML as H
type Props = ( langs :: Array Lang
type Props = ( langs :: Array Lang
, onSearch :: GT.AsyncTaskWithType -> Effect Unit
, onSearch :: GT.AsyncTaskWithType -> Effect Unit
...
...
src/Gargantext/Components/Search/SearchField.purs
View file @
0263b04a
This diff is collapsed.
Click to expand it.
src/Gargantext/Components/Search/Types.purs
View file @
0263b04a
...
@@ -14,7 +14,7 @@ import URI.Query as Q
...
@@ -14,7 +14,7 @@ import URI.Query as Q
import Gargantext.Prelude (class Eq, class Ord, class Show, bind, map, pure, show, ($), (<>))
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.Ends (class ToUrl, backendUrl)
import Gargantext.Routes as GR
import Gargantext.Routes as GR
import Gargantext.Sessions (Session(..), post)
import Gargantext.Sessions (Session(..), post)
...
@@ -40,9 +40,10 @@ data DataField = Gargantext
...
@@ -40,9 +40,10 @@ data DataField = Gargantext
| Web
| Web
| Files
| Files
instance showDataField :: Show DataField where
instance showDataField :: Show DataField where
show Gargantext = "Gargantext"
show Gargantext = "Gargantext"
show (External
x) = "External
" -- <> show x
show (External
_) = "Others
" -- <> show x
show Web = "Web"
show Web = "Web"
show Files = "Files"
show Files = "Files"
...
@@ -52,21 +53,42 @@ instance docDataField :: Doc DataField where
...
@@ -52,21 +53,42 @@ instance docDataField :: Doc DataField where
doc Web = "All the web crawled with meta-search-engine SearX"
doc Web = "All the web crawled with meta-search-engine SearX"
doc Files = "Zip files with formats.."
doc Files = "Zip files with formats.."
derive instance eqDataField :: Eq DataField
derive instance eqDataField :: Eq DataField
{-
instance encodeJsonDataField :: EncodeJson DataField where
instance eqDataField :: Eq DataField where
encodeJson Gargantext = encodeJson "Internal PubMed" -- later Internal Maybe Database
eq Gargantext Gargantext = true
encodeJson (External (Just db)) = encodeJson $ "External " <> show db
eq (External _) (External _) = true
encodeJson a = encodeJson (show a)
eq Web Web = true
eq _ _ = false
----------------------------------------
-}
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
-- | Database search specifications
datafield2database :: DataField -> Database
datafield2database (External (Just x)) = x
datafield2database _ = Empty
allDatabases :: Array Database
allDatabases :: Array Database
allDatabases = [ PubMed
allDatabases = [ Empty
, PubMed
, HAL Nothing
, HAL Nothing
, IsTex
, IsTex
, Isidore
, Isidore
...
@@ -76,6 +98,7 @@ allDatabases = [ PubMed
...
@@ -76,6 +98,7 @@ allDatabases = [ PubMed
]
]
data Database = All_Databases
data Database = All_Databases
| Empty
| PubMed
| PubMed
| HAL (Maybe Org)
| HAL (Maybe Org)
| IsTex
| IsTex
...
@@ -89,6 +112,7 @@ instance showDatabase :: Show Database where
...
@@ -89,6 +112,7 @@ instance showDatabase :: Show Database where
show (HAL _)= "HAL"
show (HAL _)= "HAL"
show IsTex = "IsTex"
show IsTex = "IsTex"
show Isidore= "Isidore"
show Isidore= "Isidore"
show Empty = "Empty"
-- show News = "News"
-- show News = "News"
-- show SocialNetworks = "Social Networks"
-- show SocialNetworks = "Social Networks"
...
@@ -98,6 +122,7 @@ instance docDatabase :: Doc Database where
...
@@ -98,6 +122,7 @@ instance docDatabase :: Doc Database where
doc (HAL _) = "All open science (archives ouvertes)"
doc (HAL _) = "All open science (archives ouvertes)"
doc IsTex = "All Elsevier enriched by CNRS/INIST"
doc IsTex = "All Elsevier enriched by CNRS/INIST"
doc Isidore = "All (French) Social Sciences"
doc Isidore = "All (French) Social Sciences"
doc Empty = "Empty"
-- doc News = "Web filtered by News"
-- doc News = "Web filtered by News"
-- doc SocialNetworks = "Web filtered by MicroBlogs"
-- doc SocialNetworks = "Web filtered by MicroBlogs"
...
@@ -116,6 +141,7 @@ derive instance eqDatabase :: Eq Database
...
@@ -116,6 +141,7 @@ derive instance eqDatabase :: Eq Database
instance encodeJsonDatabase :: EncodeJson Database where
instance encodeJsonDatabase :: EncodeJson Database where
encodeJson a = encodeJson (show a)
encodeJson a = encodeJson (show a)
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | Organization specifications
-- | Organization specifications
...
@@ -279,7 +305,7 @@ instance showSearchOrder :: Show SearchOrder where
...
@@ -279,7 +305,7 @@ instance showSearchOrder :: Show SearchOrder where
newtype SearchQuery = SearchQuery
newtype SearchQuery = SearchQuery
{ query :: String
{ query :: String
, databases ::
Array
Database
, databases :: Database
, datafield :: Maybe DataField
, datafield :: Maybe DataField
, files_id :: Array String
, files_id :: Array String
, lang :: Maybe Lang
, lang :: Maybe Lang
...
@@ -294,14 +320,14 @@ derive instance newtypeSearchQuery :: Newtype SearchQuery _
...
@@ -294,14 +320,14 @@ derive instance newtypeSearchQuery :: Newtype SearchQuery _
defaultSearchQuery :: SearchQuery
defaultSearchQuery :: SearchQuery
defaultSearchQuery = SearchQuery
defaultSearchQuery = SearchQuery
{ query: ""
{ query: ""
, databases:
[]
, databases:
Empty
, datafield: Nothing
, datafield: Nothing
, files_id : []
, files_id : []
, lang : Nothing
, lang
: Nothing
, limit: Nothing
, limit
: Nothing
, node_id : Nothing
, node_id
: Nothing
, offset: Nothing
, offset
: Nothing
, order: Nothing
, order
: Nothing
}
}
instance toUrlSessionSearchQuery :: ToUrl Session SearchQuery where
instance toUrlSessionSearchQuery :: ToUrl Session SearchQuery where
...
...
src/Gargantext/Types.purs
View file @
0263b04a
...
@@ -467,12 +467,12 @@ derive instance genericAsyncTaskType :: Generic AsyncTaskType _
...
@@ -467,12 +467,12 @@ derive instance genericAsyncTaskType :: Generic AsyncTaskType _
asyncTaskTypePath :: AsyncTaskType -> String
asyncTaskTypePath :: AsyncTaskType -> String
asyncTaskTypePath Form = "add/form/async/"
asyncTaskTypePath Form = "add/form/async/"
asyncTaskTypePath
GraphT = "async/nobod
y/"
asyncTaskTypePath
Query = "quer
y/"
asyncTaskTypePath
Query = "add/query/
async/"
asyncTaskTypePath
GraphT = "
async/"
type AsyncTaskID = String
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 genericAsyncTaskStatus :: Generic AsyncTaskStatus _
derive instance eqAsyncTaskStatus :: Eq AsyncTaskStatus
derive instance eqAsyncTaskStatus :: Eq AsyncTaskStatus
instance decodeJsonAsyncTaskStatus :: DecodeJson AsyncTaskStatus where
instance decodeJsonAsyncTaskStatus :: DecodeJson AsyncTaskStatus where
...
@@ -481,10 +481,13 @@ instance decodeJsonAsyncTaskStatus :: DecodeJson AsyncTaskStatus where
...
@@ -481,10 +481,13 @@ instance decodeJsonAsyncTaskStatus :: DecodeJson AsyncTaskStatus where
pure $ readAsyncTaskStatus obj
pure $ readAsyncTaskStatus obj
readAsyncTaskStatus :: String -> AsyncTaskStatus
readAsyncTaskStatus :: String -> AsyncTaskStatus
readAsyncTaskStatus "failed" = Failed
readAsyncTaskStatus "IsFailure" = Failed
readAsyncTaskStatus "finished" = Finished
readAsyncTaskStatus "IsFinished" = Finished
readAsyncTaskStatus "killed" = Killed
readAsyncTaskStatus "IsKilled" = Killed
readAsyncTaskStatus "running" = Running
readAsyncTaskStatus "IsPending" = Pending
readAsyncTaskStatus "IsReceived" = Received
readAsyncTaskStatus "IsRunning" = Running
readAsyncTaskStatus "IsStarted" = Started
readAsyncTaskStatus _ = Running
readAsyncTaskStatus _ = Running
newtype AsyncTask = AsyncTask {
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
module Gargantext.Utils.Spec where
import Prelude
import Prelude
import Data.Array (index)
import Data.
Foldable (all)
import Data.
Argonaut as Argonaut
import Data.
Maybe (Maybe(..), isJus
t)
import Data.
Either (Either(..), isLef
t)
import Data.
String (drop, stripPrefix, Pattern(..)
)
import Data.
Generic.Rep (class Generic
)
import Data.
Tuple (Tuple(..)
)
import Data.
Generic.Rep.Show (genericShow
)
import Gargantext.Utils as GU
import Gargantext.Utils as GU
import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson)
import Gargantext.Utils.Crypto as GUC
import Gargantext.Utils.Crypto as GUC
import Gargantext.Utils.Math as GUM
import Gargantext.Utils.Math as GUM
-- import Test.QuickCheck ((===), (/==), (<?>), Result(..))
import Test.Spec (Spec, describe, it)
import Test.Spec (Spec, describe, it)
import Test.Spec.Assertions (shouldEqual)
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 :: Spec Unit
spec =
spec =
...
@@ -40,3 +53,26 @@ spec =
...
@@ -40,3 +53,26 @@ spec =
let text = "The quick brown fox jumps over the lazy dog"
let text = "The quick brown fox jumps over the lazy dog"
let textMd5 = "9e107d9d372bb6826bd81d3542a419d6"
let textMd5 = "9e107d9d372bb6826bd81d3542a419d6"
GUC.md5 text `shouldEqual` textMd5
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
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