Commit afcab72f authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[simple-json] lots of rewrites for Simple.JSON

Also, spago build used now.
parent 8d5bcec1
...@@ -3587,7 +3587,7 @@ ...@@ -3587,7 +3587,7 @@
"newtype" "newtype"
], ],
"repo": "https://github.com/hdgarrood/purescript-sequences.git", "repo": "https://github.com/hdgarrood/purescript-sequences.git",
"version": "v2.1.0" "version": "v3.0.2"
}, },
"server-sent-events": { "server-sent-events": {
"dependencies": [ "dependencies": [
...@@ -3662,6 +3662,13 @@ ...@@ -3662,6 +3662,13 @@
"repo": "https://github.com/justinwoo/purescript-simple-json.git", "repo": "https://github.com/justinwoo/purescript-simple-json.git",
"version": "v8.0.0" "version": "v8.0.0"
}, },
"simple-json-generics": {
"dependencies": [
"simple-json"
],
"repo": "https://github.com/justinwoo/purescript-simple-json-generics",
"version": "v0.1.0"
},
"simple-jwt": { "simple-jwt": {
"dependencies": [ "dependencies": [
"crypto", "crypto",
...@@ -4159,8 +4166,8 @@ ...@@ -4159,8 +4166,8 @@
"typelevel", "typelevel",
"unsafe-coerce" "unsafe-coerce"
], ],
"repo": "https://github.com/athanclark/purescript-tuples-native", "repo": "https://github.com/poorscript/purescript-tuples-native",
"version": "v2.0.1" "version": "v2.2.0"
}, },
"turf": { "turf": {
"dependencies": [ "dependencies": [
......
...@@ -508,7 +508,7 @@ referring to both the `Read` and `Write` classes: ...@@ -508,7 +508,7 @@ referring to both the `Read` and `Write` classes:
```purescript ```purescript
class (Read box val, Write box val) <= ReadWrite box val | box -> val class (Read box val, Write box val) <= ReadWrite box val | box -> val
instance readWrite :: (Read box val, Write box val) => ReadWrite box val instance (Read box val, Write box val) => ReadWrite box val
``` ```
When you don't care about the current value, you can use `write`, the When you don't care about the current value, you can use `write`, the
......
...@@ -822,11 +822,29 @@ ...@@ -822,11 +822,29 @@
}; };
"sequences" = { "sequences" = {
name = "sequences"; name = "sequences";
version = "v2.1.0"; version = "v3.0.2";
src = pkgs.fetchgit { src = pkgs.fetchgit {
url = "https://github.com/hdgarrood/purescript-sequences.git"; url = "https://github.com/hdgarrood/purescript-sequences.git";
rev = "v2.1.0"; rev = "v3.0.2";
sha256 = "10fkkmmb7qh4p5gmgb6xpxh9g8hy06ddy8cyfrs3py8a5b8h46hw"; sha256 = "0mc0jjs1119c2nyd08yhdmliq3s47lhrdknhziga3lnbzja889k4";
};
};
"simple-json" = {
name = "simple-json";
version = "v8.0.0";
src = pkgs.fetchgit {
url = "https://github.com/justinwoo/purescript-simple-json.git";
rev = "v8.0.0";
sha256 = "0q5hb324m1r5njnxq9wxgy99i0x8sd9mj2drq72i64xxr1k0m8qc";
};
};
"simple-json-generics" = {
name = "simple-json-generics";
version = "v0.1.0";
src = pkgs.fetchgit {
url = "https://github.com/justinwoo/purescript-simple-json-generics";
rev = "v0.1.0";
sha256 = "1izbrh9614yi0lzpnqbn9q7hbllhvvhrgyziganj7rzgphwn3ywx";
}; };
}; };
"simplecrypto" = { "simplecrypto" = {
...@@ -966,11 +984,11 @@ ...@@ -966,11 +984,11 @@
}; };
"tuples-native" = { "tuples-native" = {
name = "tuples-native"; name = "tuples-native";
version = "v2.0.1"; version = "v2.2.0";
src = pkgs.fetchgit { src = pkgs.fetchgit {
url = "https://github.com/athanclark/purescript-tuples-native"; url = "https://github.com/poorscript/purescript-tuples-native";
rev = "v2.0.1"; rev = "v2.2.0";
sha256 = "1c8065krignnphiwnws9d5ingfx8k83wqnmd1zadyjlakfdg2b4h"; sha256 = "0hplpqc2sbcjin084jqzhzqhprlc1achbqmsn9czpnf6ylgkqhaz";
}; };
}; };
"type-equality" = { "type-equality" = {
...@@ -1063,6 +1081,15 @@ ...@@ -1063,6 +1081,15 @@
sha256 = "0yfb97nk7179hp0r2iylj74wl7rnl1y2x6dh5hlipxg1kpq9yydk"; sha256 = "0yfb97nk7179hp0r2iylj74wl7rnl1y2x6dh5hlipxg1kpq9yydk";
}; };
}; };
"variant" = {
name = "variant";
version = "v7.0.2";
src = pkgs.fetchgit {
url = "https://github.com/natefaubion/purescript-variant.git";
rev = "v7.0.2";
sha256 = "0a555fa2d8kd6rzfv9w64aphr7n6x0cizfp7n71wh5jw07b7hn5y";
};
};
"versions" = { "versions" = {
name = "versions"; name = "versions";
version = "v6.0.0"; version = "v6.0.0";
......
...@@ -38,7 +38,7 @@ let additions = ...@@ -38,7 +38,7 @@ let additions =
, "newtype" , "newtype"
] ]
, repo = "https://github.com/hdgarrood/purescript-sequences.git" , repo = "https://github.com/hdgarrood/purescript-sequences.git"
, version = "v2.1.0" , version = "v3.0.2"
} }
, spec-discovery = , spec-discovery =
{ dependencies = [ "prelude", "effect", "arrays", "spec", "node-fs" ] { dependencies = [ "prelude", "effect", "arrays", "spec", "node-fs" ]
...@@ -115,10 +115,16 @@ let additions = ...@@ -115,10 +115,16 @@ let additions =
, repo = "https://github.com/irresponsible/purescript-reactix" , repo = "https://github.com/irresponsible/purescript-reactix"
, version = "v0.4.11" , version = "v0.4.11"
} }
, simple-json-generics =
{ dependencies =
[ "simple-json" ]
, repo = "https://github.com/justinwoo/purescript-simple-json-generics"
, version = "v0.1.0"
}
, toestand = , toestand =
{ dependencies = [ "effect", "reactix", "prelude", "record", "tuples", "typelevel-prelude", "typisch" ] { dependencies = [ "effect", "reactix", "prelude", "record", "tuples", "typelevel-prelude", "typisch" ]
, repo = "https://github.com/poorscript/purescript-toestand" , repo = "https://github.com/poorscript/purescript-toestand"
, version = "v0.6.1" , version = "v0.6.2"
} }
, typisch = , typisch =
{ dependencies = [ "prelude" ] { dependencies = [ "prelude" ]
...@@ -128,8 +134,8 @@ let additions = ...@@ -128,8 +134,8 @@ let additions =
, tuples-native = , tuples-native =
{ dependencies = { dependencies =
[ "prelude", "typelevel", "unsafe-coerce" ] [ "prelude", "typelevel", "unsafe-coerce" ]
, repo = "https://github.com/athanclark/purescript-tuples-native" , repo = "https://github.com/poorscript/purescript-tuples-native"
, version = "v2.0.1" , version = "v2.2.0"
} }
, uint = , uint =
{ dependencies = [ "maybe", "math" ] { dependencies = [ "maybe", "math" ]
......
This diff is collapsed.
...@@ -36,6 +36,7 @@ ...@@ -36,6 +36,7 @@
"routing", "routing",
"sequences", "sequences",
"simple-json", "simple-json",
"simple-json-generics",
"simplecrypto", "simplecrypto",
"smolder", "smolder",
"spec-discovery", "spec-discovery",
......
...@@ -16,9 +16,10 @@ let ...@@ -16,9 +16,10 @@ let
set -e set -e
echo "Compiling" echo "Compiling"
build-purs #build-purs
echo "Bundling" echo "Bundling"
yarn pulp browserify --skip-compile -t dist/bundle.js --src-path output #yarn pulp browserify --skip-compile -t dist/bundle.js --src-path output
yarn spago bundle-app --to dist/bundle.js
''; '';
repl = pkgs.writeShellScriptBin "repl" '' repl = pkgs.writeShellScriptBin "repl" ''
......
{-
Welcome to a Spago project!
You can edit this file as you like.
Need help? See the following resources:
- Spago documentation: https://github.com/purescript/spago
- Dhall language tour: https://docs.dhall-lang.org/tutorials/Language-Tour.html
When creating a new Spago project, you can use
`spago init --no-comments` or `spago init -C`
to generate this file without the comments in this block.
-}
{ name = "gargantext"
, dependencies =
[ "aff-promise"
, "affjax"
, "argonaut"
, "console"
, "css"
, "datetime"
, "debug"
, "dom-filereader"
, "dom-simple"
, "effect"
, "foreign-generic"
, "foreign-object"
, "formula"
, "globals"
, "integers"
, "js-timers"
, "markdown-smolder"
, "math"
, "maybe"
, "milkis"
, "nonempty"
, "now"
, "numbers"
, "prelude"
, "psci-support"
, "random"
, "react"
, "reactix"
, "read"
, "record-extra"
, "routing"
, "sequences"
, "simple-json"
, "simple-json-generics"
, "simplecrypto"
, "smolder"
, "spec-discovery"
, "spec-quickcheck"
, "string-parsers"
, "strings"
, "stringutils"
, "toestand"
, "tuples-native"
, "typisch"
, "uint"
, "uri"
, "versions"
, "web-html"
]
, packages = ./packages.dhall
, sources = [ "src/**/*.purs", "test/**/*.purs" ]
}
...@@ -8,15 +8,17 @@ import Data.Map as Map ...@@ -8,15 +8,17 @@ import Data.Map as Map
import Data.Maybe (Maybe(..), maybe, fromMaybe) import Data.Maybe (Maybe(..), maybe, fromMaybe)
import DOM.Simple.Console (log2) import DOM.Simple.Console (log2)
import Effect (Effect) import Effect (Effect)
import Gargantext.Types as GT
import Gargantext.Utils as GU
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R import Reactix as R
import Simple.JSON as JSON import Simple.JSON as JSON
import Toestand as T import Toestand as T
import Web.Storage.Storage as WSS import Web.Storage.Storage as WSS
import Gargantext.Types as GT
import Gargantext.Utils as GU
import Gargantext.Utils.JSON as GUJ
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
localStorageKey :: String localStorageKey :: String
localStorageKey = "garg-async-tasks" localStorageKey = "garg-async-tasks"
...@@ -24,6 +26,8 @@ localStorageKey = "garg-async-tasks" ...@@ -24,6 +26,8 @@ localStorageKey = "garg-async-tasks"
type TaskList = Array GT.AsyncTaskWithType type TaskList = Array GT.AsyncTaskWithType
type Storage = Map.Map GT.NodeID TaskList type Storage = Map.Map GT.NodeID TaskList
instance JSON.ReadForeign Storage where readImpl = GUJ.readMap
empty :: Storage empty :: Storage
empty = Map.empty empty = Map.empty
......
...@@ -24,8 +24,8 @@ here :: R2.Here ...@@ -24,8 +24,8 @@ here :: R2.Here
here = R2.here "Gargantext.Components.Annotation.Menu" here = R2.here "Gargantext.Components.Annotation.Menu"
data MenuType = NewNgram | SetTermListItem data MenuType = NewNgram | SetTermListItem
derive instance genericMenuType :: Generic MenuType _ derive instance Generic MenuType _
instance eqMenuType :: Eq MenuType where instance Eq MenuType where
eq = genericEq eq = genericEq
type Props = type Props =
......
-- TODO: this module should be replaced by FacetsTable -- TODO: this module should be replaced by FacetsTable
module Gargantext.Components.Category where module Gargantext.Components.Category where
import Gargantext.Prelude (discard, map, pure, void, ($), (-), (<), (<>), (==))
import Data.Argonaut (class EncodeJson, encodeJson, jsonEmptyObject, (:=), (~>))
import Data.Array as A import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff, launchAff)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Gargantext.Prelude
import Gargantext.Components.Category.Types import Gargantext.Components.Category.Types
( Category(..), Star(..), cat2score, categories, clickAgain, star2score, stars ) ( Category(..), Star(..), cat2score, categories, clickAgain, star2score, stars )
...@@ -56,12 +58,10 @@ newtype RatingQuery = ...@@ -56,12 +58,10 @@ newtype RatingQuery =
RatingQuery { nodeIds :: Array Int RatingQuery { nodeIds :: Array Int
, rating :: Star , rating :: Star
} }
derive instance Generic RatingQuery _
instance encodeJsonRatingQuery :: EncodeJson RatingQuery where instance JSON.WriteForeign RatingQuery where
encodeJson (RatingQuery post) = writeImpl (RatingQuery post) = JSON.writeImpl { ntc_nodesId: post.nodeIds
"ntc_nodesId" := post.nodeIds , ntc_category: post.rating }
~> "ntc_category" := encodeJson post.rating
~> jsonEmptyObject
putRating :: Session -> Int -> RatingQuery -> Aff (Array Int) putRating :: Session -> Int -> RatingQuery -> Aff (Array Int)
putRating session nodeId = put session $ ratingRoute where putRating session nodeId = put session $ ratingRoute where
...@@ -139,12 +139,10 @@ newtype CategoryQuery = CategoryQuery { ...@@ -139,12 +139,10 @@ newtype CategoryQuery = CategoryQuery {
nodeIds :: Array Int nodeIds :: Array Int
, category :: Category , category :: Category
} }
derive instance Generic CategoryQuery _
instance encodeJsonCategoryQuery :: EncodeJson CategoryQuery where instance JSON.WriteForeign CategoryQuery where
encodeJson (CategoryQuery post) = writeImpl (CategoryQuery post) = JSON.writeImpl { ntc_nodesId: post.nodeIds
"ntc_nodesId" := post.nodeIds , ntc_category: post.category }
~> "ntc_category" := encodeJson post.category
~> jsonEmptyObject
categoryRoute :: Int -> SessionRoute categoryRoute :: Int -> SessionRoute
categoryRoute nodeId = NodeAPI Node (Just nodeId) "category" categoryRoute nodeId = NodeAPI Node (Just nodeId) "category"
......
module Gargantext.Components.Category.Types where module Gargantext.Components.Category.Types where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq) import Data.Eq.Generic (genericEq)
import Data.Show.Generic (genericShow) import Data.Show.Generic (genericShow)
import Simple.JSON as JSON
import Gargantext.Prelude import Gargantext.Prelude
...@@ -13,18 +13,14 @@ data Star = Star_0 | Star_1 | Star_2 | Star_3 | Star_4 ...@@ -13,18 +13,14 @@ data Star = Star_0 | Star_1 | Star_2 | Star_3 | Star_4
stars :: Array Star stars :: Array Star
stars = [Star_0, Star_1, Star_2, Star_3, Star_4] stars = [Star_0, Star_1, Star_2, Star_3, Star_4]
derive instance genericStar :: Generic Star _ derive instance Generic Star _
instance Show Star where show = genericShow
instance showStar :: Show Star where instance Eq Star where eq = genericEq
show = genericShow instance JSON.ReadForeign Star where
instance eqStar :: Eq Star where readImpl f = do
eq = genericEq inst <- JSON.readImpl f
instance decodeJsonStar :: DecodeJson Star where pure $ decodeStar inst
decodeJson json = do instance JSON.WriteForeign Star where writeImpl = JSON.writeImpl <<< star2score
obj <- decodeJson json
pure $ decodeStar obj
instance encodeJsonStar :: EncodeJson Star where
encodeJson x = encodeJson (star2score x)
decodeStar :: Int -> Star decodeStar :: Int -> Star
decodeStar 0 = Star_0 decodeStar 0 = Star_0
...@@ -53,17 +49,14 @@ data Category = Trash | UnRead | Checked | Topic | Favorite ...@@ -53,17 +49,14 @@ data Category = Trash | UnRead | Checked | Topic | Favorite
categories :: Array Category categories :: Array Category
categories = [Trash, UnRead, Checked, Topic, Favorite] categories = [Trash, UnRead, Checked, Topic, Favorite]
derive instance genericFavorite :: Generic Category _ derive instance Generic Category _
instance showCategory :: Show Category where instance Show Category where show = genericShow
show = genericShow instance Eq Category where eq = genericEq
instance eqCategory :: Eq Category where instance JSON.ReadForeign Category where
eq = genericEq readImpl f = do
instance decodeJsonCategory :: DecodeJson Category where inst <- JSON.readImpl f
decodeJson json = do pure $ decodeCategory inst
obj <- decodeJson json instance JSON.WriteForeign Category where writeImpl = JSON.writeImpl <<< cat2score
pure $ decodeCategory obj
instance encodeJsonCategory :: EncodeJson Category where
encodeJson cat = encodeJson (cat2score cat)
favCategory :: Category -> Category favCategory :: Category -> Category
favCategory Favorite = Topic favCategory Favorite = Topic
......
...@@ -2,8 +2,8 @@ module Gargantext.Components.Charts.Options.ECharts where ...@@ -2,8 +2,8 @@ module Gargantext.Components.Charts.Options.ECharts where
import Prelude import Prelude
import CSS (italic)
import CSS.Common (normal) import CSS.Common (normal)
import CSS.FontStyle (FontStyle(..))
import Gargantext.Components.Charts.Options.Color (transparent, violet, black) import Gargantext.Components.Charts.Options.Color (transparent, violet, black)
import Gargantext.Components.Charts.Options.Data (DataLegend, dataSerie) import Gargantext.Components.Charts.Options.Data (DataLegend, dataSerie)
import Gargantext.Components.Charts.Options.Font (IconOptions(..), Shape(..), TextStyle, chartFontStyle, chartFontWeight, icon, mkTooltip, Tooltip, mkToolBox) import Gargantext.Components.Charts.Options.Font (IconOptions(..), Shape(..), TextStyle, chartFontStyle, chartFontWeight, icon, mkTooltip, Tooltip, mkToolBox)
...@@ -183,7 +183,7 @@ opts (Options { mainTitle ...@@ -183,7 +183,7 @@ opts (Options { mainTitle
data Zoom = Slider | Inside data Zoom = Slider | Inside
instance showZoom :: Show Zoom where instance Show Zoom where
show Slider = "slider" show Slider = "slider"
show Inside = "inside" show Inside = "inside"
...@@ -211,7 +211,7 @@ seriesPie = seriesPieD1 ...@@ -211,7 +211,7 @@ seriesPie = seriesPieD1
textStyle2 :: TextStyle textStyle2 :: TextStyle
textStyle2 = textStyle2 =
{ color: black { color: black
, fontStyle: chartFontStyle italic , fontStyle: chartFontStyle Italic
, fontWeight: chartFontWeight normal , fontWeight: chartFontWeight normal
, fontFamily: "sans-serif" , fontFamily: "sans-serif"
, fontSize: 11 , fontSize: 11
......
...@@ -31,7 +31,8 @@ import Prelude (Unit, ($), (<<<), (<>)) ...@@ -31,7 +31,8 @@ import Prelude (Unit, ($), (<<<), (<>))
import Data.Generic.Rep import Data.Generic.Rep
import Data.Show.Generic (genericShow) import Data.Show.Generic (genericShow)
import CSS (FontStyle(..), FontWeight(..), Prefixed(..), Value(..)) import CSS (FontWeight(..), Prefixed(..), Value(..))
import CSS.FontStyle (FontStyle(..))
import Data.String (toLower) import Data.String (toLower)
import Gargantext.Components.Charts.Options.Color (Color) import Gargantext.Components.Charts.Options.Color (Color)
import Gargantext.Components.Charts.Options.Position (LeftRelativePosition, Position, TopRelativePosition) import Gargantext.Components.Charts.Options.Position (LeftRelativePosition, Position, TopRelativePosition)
...@@ -62,8 +63,8 @@ type TextStyle = ...@@ -62,8 +63,8 @@ type TextStyle =
newtype ChartFontStyle = ChartFontStyle String newtype ChartFontStyle = ChartFontStyle String
chartFontStyle :: FontStyle -> ChartFontStyle chartFontStyle :: FontStyle -> ChartFontStyle
chartFontStyle (FontStyle (Value (Plain "italic"))) = ChartFontStyle "italic" chartFontStyle Italic = ChartFontStyle "italic"
chartFontStyle (FontStyle (Value (Plain "oblique"))) = ChartFontStyle "oblique" chartFontStyle (Oblique _) = ChartFontStyle "oblique"
chartFontStyle _ = ChartFontStyle "normal" chartFontStyle _ = ChartFontStyle "normal"
...@@ -81,7 +82,7 @@ newtype Icon = Icon String ...@@ -81,7 +82,7 @@ newtype Icon = Icon String
newtype ImageURL = ImageURL String newtype ImageURL = ImageURL String
data Shape = Circle | Rect | RoundRect | Triangle | Diamond | Pin | Arrow data Shape = Circle | Rect | RoundRect | Triangle | Diamond | Pin | Arrow
derive instance genericShape :: Generic Shape _ derive instance Generic Shape _
data IconOptions = Shape Shape | Image ImageURL data IconOptions = Shape Shape | Image ImageURL
......
...@@ -21,7 +21,7 @@ import Unsafe.Coerce (unsafeCoerce) ...@@ -21,7 +21,7 @@ import Unsafe.Coerce (unsafeCoerce)
newtype LegendType = LegendType String newtype LegendType = LegendType String
data PlainOrScroll = Plain | Scroll data PlainOrScroll = Plain | Scroll
instance showPlainOrScroll :: Show PlainOrScroll where instance Show PlainOrScroll where
show (Plain) = "plain" show (Plain) = "plain"
show (Scroll) = "scroll" show (Scroll) = "scroll"
...@@ -32,7 +32,7 @@ legendType = LegendType <<< toLower <<< show ...@@ -32,7 +32,7 @@ legendType = LegendType <<< toLower <<< show
newtype Orient = Orient String newtype Orient = Orient String
data Orientation = Horizontal | Vertical data Orientation = Horizontal | Vertical
derive instance genericOrientation :: Generic Orientation _ derive instance Generic Orientation _
orient :: Orientation -> Orient orient :: Orientation -> Orient
orient = Orient <<< toLower <<< genericShow orient = Orient <<< toLower <<< genericShow
...@@ -41,7 +41,7 @@ orient = Orient <<< toLower <<< genericShow ...@@ -41,7 +41,7 @@ orient = Orient <<< toLower <<< genericShow
foreign import data SelectedMode :: Type foreign import data SelectedMode :: Type
data LegendMode = Bool Boolean | Single | Multiple data LegendMode = Bool Boolean | Single | Multiple
derive instance genericLegendMode :: Generic LegendMode _ derive instance Generic LegendMode _
selectedMode :: LegendMode -> SelectedMode selectedMode :: LegendMode -> SelectedMode
selectedMode (Bool b) = unsafeCoerce b selectedMode (Bool b) = unsafeCoerce b
......
...@@ -34,13 +34,13 @@ relativePosition (Relative r) = unsafeCoerce $ show r ...@@ -34,13 +34,13 @@ relativePosition (Relative r) = unsafeCoerce $ show r
data Align p = Auto | Relative p data Align p = Auto | Relative p
data TopRelativePosition = Top | Middle | Bottom data TopRelativePosition = Top | Middle | Bottom
instance showTopRelativePosition :: Show TopRelativePosition instance Show TopRelativePosition
where show (Top) = "top" where show (Top) = "top"
show (Middle) = "middle" show (Middle) = "middle"
show (Bottom) = "bottom" show (Bottom) = "bottom"
data LeftRelativePosition = LeftPos | Center | RightPos data LeftRelativePosition = LeftPos | Center | RightPos
instance showLeftRelativePosition :: Show LeftRelativePosition instance Show LeftRelativePosition
where show (LeftPos) = "left" where show (LeftPos) = "left"
show (Center) = "center" show (Center) = "center"
show (RightPos) = "right" show (RightPos) = "right"
...@@ -39,7 +39,7 @@ data Chart = Line ...@@ -39,7 +39,7 @@ data Chart = Line
| ThemeRiver | ThemeRiver
-- Trees -- Trees
instance showChart :: Show Chart where instance Show Chart where
show Bar = "bar" show Bar = "bar"
show EffectScatter = "effectScatter" -- ^ https://ecomfe.github.io/echarts-examples/public/editor.html?c=scatter-effect show EffectScatter = "effectScatter" -- ^ https://ecomfe.github.io/echarts-examples/public/editor.html?c=scatter-effect
show Funnel = "funnel" show Funnel = "funnel"
...@@ -131,7 +131,7 @@ seriesSankey o = unsafeSeries ((unsafeCoerce o) { "type" = seriesType Sankey }) ...@@ -131,7 +131,7 @@ seriesSankey o = unsafeSeries ((unsafeCoerce o) { "type" = seriesType Sankey })
-- Tree types -- Tree types
data Trees = TreeLine | TreeRadial | TreeMap data Trees = TreeLine | TreeRadial | TreeMap
instance showTrees :: Show Trees where instance Show Trees where
show TreeLine = "tree" -- ^ https://ecomfe.github.io/echarts-examples/public/editor.html?c=tree-radial show TreeLine = "tree" -- ^ https://ecomfe.github.io/echarts-examples/public/editor.html?c=tree-radial
show TreeRadial = "tree" -- ^ https://ecomfe.github.io/echarts-examples/public/editor.html?c=scatter-simple show TreeRadial = "tree" -- ^ https://ecomfe.github.io/echarts-examples/public/editor.html?c=scatter-simple
show TreeMap = "treemap" -- ^ https://ecomfe.github.io/echarts-examples/public/editor.html?c=treemap-simple show TreeMap = "treemap" -- ^ https://ecomfe.github.io/echarts-examples/public/editor.html?c=treemap-simple
...@@ -192,17 +192,17 @@ data TreeNode = TreeNode { ...@@ -192,17 +192,17 @@ data TreeNode = TreeNode {
, value :: Int , value :: Int
} }
derive instance genericTreeNode :: Generic TreeNode _ derive instance Generic TreeNode _
instance eqTreeNode :: Eq TreeNode where instance Eq TreeNode where
eq (TreeNode n1) (TreeNode n2) = eq n1 n2 eq (TreeNode n1) (TreeNode n2) = eq n1 n2
instance decodeTreeNode :: DecodeJson TreeNode where instance DecodeJson TreeNode where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
children <- obj .: "children" children <- obj .: "children"
name <- obj .: "label" name <- obj .: "label"
value <- obj .: "value" value <- obj .: "value"
pure $ TreeNode { children, name, value } pure $ TreeNode { children, name, value }
instance encodeTreeNode :: EncodeJson TreeNode where instance EncodeJson TreeNode where
encodeJson (TreeNode { children, name, value }) = encodeJson (TreeNode { children, name, value }) =
"children" := encodeJson children "children" := encodeJson children
~> "label" := encodeJson name ~> "label" := encodeJson name
......
...@@ -36,17 +36,17 @@ type ElRef = R.Ref (Nullable Element) ...@@ -36,17 +36,17 @@ type ElRef = R.Ref (Nullable Element)
data CodeType = Haskell | JSON | Markdown | Python data CodeType = Haskell | JSON | Markdown | Python
derive instance genericCodeType :: Generic CodeType _ derive instance Generic CodeType _
instance eqCodeType :: Eq CodeType where instance Eq CodeType where
eq = genericEq eq = genericEq
instance showCodeType :: Show CodeType where instance Show CodeType where
show = genericShow show = genericShow
data ViewType = Code | Preview | Both data ViewType = Code | Preview | Both
derive instance genericViewType :: Generic ViewType _ derive instance Generic ViewType _
instance eqViewType :: Eq ViewType where instance Eq ViewType where
eq = genericEq eq = genericEq
instance showViewType :: Show ViewType where instance Show ViewType where
show = genericShow show = genericShow
type Props = type Props =
......
...@@ -507,7 +507,7 @@ newtype SearchQuery = SearchQuery { ...@@ -507,7 +507,7 @@ newtype SearchQuery = SearchQuery {
} }
instance encodeJsonSQuery :: EncodeJson SearchQuery where instance EncodeJson SearchQuery where
encodeJson (SearchQuery {query, parent_id}) encodeJson (SearchQuery {query, parent_id})
= "query" := query = "query" := query
~> "parent_id" := parent_id ~> "parent_id" := parent_id
......
module Gargantext.Components.DocsTable.Types where module Gargantext.Components.DocsTable.Types where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq) import Data.Eq.Generic (genericEq)
import Data.Map (Map) import Data.Map (Map)
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Simple.JSON as JSON
import Gargantext.Prelude import Gargantext.Prelude
...@@ -15,92 +15,94 @@ import Gargantext.Components.Category.Types (Category(..), decodeCategory, Star( ...@@ -15,92 +15,94 @@ import Gargantext.Components.Category.Types (Category(..), decodeCategory, Star(
data Action data Action
= MarkCategory Int Category = MarkCategory Int Category
newtype DocumentsView type DocumentsViewT =
= DocumentsView ( category :: Star
{ _id :: Int
, category :: Star
, date :: Int , date :: Int
, ngramCount :: Maybe Int , ngramCount :: Maybe Int
, score :: Maybe Int , score :: Maybe Int
, source :: String , source :: String
, title :: String , title :: String
, url :: String , url :: String
)
newtype DocumentsView
= DocumentsView
{ _id :: Int
| DocumentsViewT
} }
derive instance genericDocumentsView :: Generic DocumentsView _ derive instance Generic DocumentsView _
instance eqDocumentsView :: Eq DocumentsView where instance Eq DocumentsView where
eq = genericEq eq = genericEq
{- {-
derive instance genericDocumentsView :: Generic DocumentsView _ derive instance Generic DocumentsView _
instance showDocumentsView :: Show DocumentsView where instance Show DocumentsView where
show = genericShow show = genericShow
instance decodeJsonSearchType :: Argonaut.DecodeJson SearchType where instance Argonaut.DecodeJson SearchType where
decodeJson = genericSumDecodeJson decodeJson = genericSumDecodeJson
instance encodeJsonSearchType :: Argonaut.EncodeJson SearchType where instance Argonaut.EncodeJson SearchType where
encodeJson = genericSumEncodeJson encodeJson = genericSumEncodeJson
-} -}
instance decodeDocumentsView :: DecodeJson DocumentsView where instance JSON.ReadForeign DocumentsView where
decodeJson json = do readImpl f = do
obj <- decodeJson json { id, category, date, ngramCount, score, source, title, url } :: { id :: Int | DocumentsViewT } <- JSON.readImpl f
_id <- obj .: "id" pure $ DocumentsView { _id: id
category <- obj .: "category" , category
date <- obj .: "date" , date
ngramCount <- obj .: "ngramCount" , ngramCount
score <- obj .: "score" , score
source <- obj .: "source" , source
title <- obj .: "title" , title
url <- obj .: "url" , url }
pure $ DocumentsView { _id, category, date, ngramCount, score, source, title, url } instance JSON.WriteForeign DocumentsView where
instance encodeDocumentsView :: EncodeJson DocumentsView where writeImpl (DocumentsView { _id, category, date, ngramCount, score, source, title, url }) =
encodeJson (DocumentsView dv) = JSON.writeImpl { id: _id
"id" := dv._id , category
~> "category" := dv.category , date
~> "date" := dv.date , ngramCount
~> "ngramCount" := dv.ngramCount , score
~> "score" := dv.score , source
~> "source" := dv.source , title
~> "title" := dv.title , url }
~> "url" := dv.url
~> jsonEmptyObject type ResponseT =
( hyperdata :: Hyperdata
, ngramCount :: Maybe Int
, score :: Maybe Int
, title :: String )
newtype Response = Response newtype Response = Response
{ cid :: Int { cid :: Int
, hyperdata :: Hyperdata
, category :: Star , category :: Star
, ngramCount :: Maybe Int | ResponseT
, score :: Maybe Int
, title :: String
} }
instance JSON.ReadForeign Response where
readImpl f = do
{ category, id, hyperdata, ngramCount, score, title } :: { category :: Int, id :: Int | ResponseT } <- JSON.readImpl f
--pure $ Response { category: decodeCategory category, cid, hyperdata, ngramCount, score, title }
pure $ Response { category: decodeStar category
, cid: id
, hyperdata
, ngramCount
, score
, title }
type HyperdataT =
( title :: String
, source :: String )
newtype Hyperdata = Hyperdata newtype Hyperdata = Hyperdata
{ title :: String { pub_year :: Int
, source :: String | HyperdataT
, pub_year :: Int
} }
derive instance Generic Hyperdata _
instance decodeHyperdata :: DecodeJson Hyperdata where instance JSON.ReadForeign Hyperdata where
decodeJson json = do readImpl f = do
obj <- decodeJson json { publication_year, source, title} :: { publication_year :: Int | HyperdataT } <- JSON.readImpl f
pub_year <- obj .: "publication_year" pure $ Hyperdata { pub_year: publication_year
source <- obj .: "source" , title
title <- obj .: "title" , source }
pure $ Hyperdata { title,source, pub_year}
instance decodeResponse :: DecodeJson Response where
decodeJson json = do
obj <- decodeJson json
category <- obj .: "category"
cid <- obj .: "id"
hyperdata <- obj .: "hyperdata"
ngramCount <- obj .: "ngramCount"
score <- obj .: "score"
title <- obj .: "title"
--pure $ Response { category: decodeCategory category, cid, hyperdata, ngramCount, score, title }
pure $ Response { category: decodeStar category, cid, hyperdata, ngramCount, score, title }
type LocalCategories = Map Int Category type LocalCategories = Map Int Category
type LocalUserScore = Map Int Star type LocalUserScore = Map Int Star
......
...@@ -67,10 +67,10 @@ newtype Pair = ...@@ -67,10 +67,10 @@ newtype Pair =
, label :: String , label :: String
} }
derive instance genericPair :: Generic Pair _ derive instance Generic Pair _
instance eqPair :: Eq Pair where instance Eq Pair where
eq = genericEq eq = genericEq
instance showPair :: Show Pair where instance Show Pair where
show = genericShow show = genericShow
---------------------------------------------------------------------- ----------------------------------------------------------------------
...@@ -90,10 +90,10 @@ newtype DocumentsView = ...@@ -90,10 +90,10 @@ newtype DocumentsView =
, publication_day :: Int , publication_day :: Int
} }
derive instance genericDocumentsView :: Generic DocumentsView _ derive instance Generic DocumentsView _
instance eqDocumentsView :: Eq DocumentsView where instance Eq DocumentsView where
eq = genericEq eq = genericEq
instance showDocumentsView :: Show DocumentsView where instance Show DocumentsView where
show = genericShow show = genericShow
---------------------------------------------------------------------- ----------------------------------------------------------------------
...@@ -105,17 +105,17 @@ newtype ContactsView = ...@@ -105,17 +105,17 @@ newtype ContactsView =
, annuaireId :: Int , annuaireId :: Int
, delete :: Boolean , delete :: Boolean
} }
derive instance genericContactsView :: Generic ContactsView _ derive instance Generic ContactsView _
instance eqContactsView :: Eq ContactsView where instance Eq ContactsView where
eq = genericEq eq = genericEq
instance showContactsView :: Show ContactsView where instance Show ContactsView where
show = genericShow show = genericShow
---------------------------------------------------------------------- ----------------------------------------------------------------------
data Rows = Docs { docs :: Seq DocumentsView } data Rows = Docs { docs :: Seq DocumentsView }
| Contacts { contacts :: Seq ContactsView } | Contacts { contacts :: Seq ContactsView }
derive instance genericRows :: Generic Rows _ derive instance Generic Rows _
instance eqRows :: Eq Rows where instance Eq Rows where
eq = genericEq eq = genericEq
---------------------------------------------------------------------- ----------------------------------------------------------------------
...@@ -413,7 +413,7 @@ publicationDate (DocumentsView {publication_year, publication_month, publication ...@@ -413,7 +413,7 @@ publicationDate (DocumentsView {publication_year, publication_month, publication
newtype DeleteDocumentQuery = DeleteDocumentQuery { documents :: Array Int } newtype DeleteDocumentQuery = DeleteDocumentQuery { documents :: Array Int }
instance encodeJsonDDQuery :: EncodeJson DeleteDocumentQuery where instance EncodeJson DeleteDocumentQuery where
encodeJson (DeleteDocumentQuery {documents}) = encodeJson (DeleteDocumentQuery {documents}) =
"documents" := documents ~> jsonEmptyObject "documents" := documents ~> jsonEmptyObject
......
...@@ -58,9 +58,9 @@ setTreeOut (LinkNode {nodeType, params:_}) p = LinkNode {nodeType, params: p} ...@@ -58,9 +58,9 @@ setTreeOut (LinkNode {nodeType, params:_}) p = LinkNode {nodeType, params: p}
setTreeOut (SharePublic {params:_}) p = SharePublic {params: p} setTreeOut (SharePublic {params:_}) p = SharePublic {params: p}
setTreeOut a _ = a setTreeOut a _ = a
derive instance genericAction :: Generic Action _ derive instance Generic Action _
instance eqAction :: Eq Action where instance Eq Action where
eq (AddNode s1 nt1) (AddNode s2 nt2) = (eq s1 s2) && (eq nt1 nt2) eq (AddNode s1 nt1) (AddNode s2 nt2) = (eq s1 s2) && (eq nt1 nt2)
eq (DeleteNode nt1) (DeleteNode nt2) = eq nt1 nt2 eq (DeleteNode nt1) (DeleteNode nt2) = eq nt1 nt2
eq (RenameNode s1) (RenameNode s2) = eq s1 s2 eq (RenameNode s1) (RenameNode s2) = eq s1 s2
...@@ -80,7 +80,7 @@ instance eqAction :: Eq Action where ...@@ -80,7 +80,7 @@ instance eqAction :: Eq Action where
eq NoAction NoAction = true eq NoAction NoAction = true
eq _ _ = false eq _ _ = false
instance showAction :: Show Action where instance Show Action where
show (AddNode _ _ ) = "AddNode" show (AddNode _ _ ) = "AddNode"
show (DeleteNode _ ) = "DeleteNode" show (DeleteNode _ ) = "DeleteNode"
show (RenameNode _ ) = "RenameNode" show (RenameNode _ ) = "RenameNode"
......
module Gargantext.Components.Forest.Tree.Node.Action.Add where module Gargantext.Components.Forest.Tree.Node.Action.Add where
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Data.Array (head, length) import Data.Array (head, length)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Newtype (class Newtype)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, launchAff_)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T import Toestand as T
import Gargantext.Prelude import Gargantext.Prelude
...@@ -42,12 +44,11 @@ newtype AddNodeValue = AddNodeValue ...@@ -42,12 +44,11 @@ newtype AddNodeValue = AddNodeValue
{ name :: GT.Name { name :: GT.Name
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
} }
derive instance Generic AddNodeValue _
instance encodeJsonAddNodeValue :: EncodeJson AddNodeValue where derive instance Newtype AddNodeValue _
encodeJson (AddNodeValue {name, nodeType}) instance JSON.WriteForeign AddNodeValue where
= "pn_name" := name writeImpl (AddNodeValue {name, nodeType}) = JSON.writeImpl { pn_name: name
~> "pn_typename" := nodeType , pn_typename: nodeType }
~> jsonEmptyObject
---------------------------------------------------------------------- ----------------------------------------------------------------------
data NodePopup = CreatePopup | NodePopup data NodePopup = CreatePopup | NodePopup
......
...@@ -5,6 +5,10 @@ import Prelude ...@@ -5,6 +5,10 @@ import Prelude
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff, launchAff)
import Formula as F import Formula as F
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Components.Forest.Tree.Node.Action (Action(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Contact.Types (AddContactParams(..)) import Gargantext.Components.Forest.Tree.Node.Action.Contact.Types (AddContactParams(..))
import Gargantext.Routes as GR import Gargantext.Routes as GR
...@@ -12,9 +16,6 @@ import Gargantext.Sessions (Session, post) ...@@ -12,9 +16,6 @@ import Gargantext.Sessions (Session, post)
import Gargantext.Types (ID) import Gargantext.Types (ID)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Contact" here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Contact"
......
module Gargantext.Components.Forest.Tree.Node.Action.Contact.Types where module Gargantext.Components.Forest.Tree.Node.Action.Contact.Types where
import Gargantext.Prelude (class Eq, class Show)
import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson)
import Data.Argonaut (class DecodeJson, class EncodeJson)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Newtype (class Newtype)
import Data.Show.Generic (genericShow) import Data.Show.Generic (genericShow)
import Simple.JSON as JSON
data AddContactParams = import Gargantext.Prelude (class Eq, class Show)
AddContactParams { firstname :: String, lastname :: String } import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson)
derive instance eqAddContactParams :: Eq AddContactParams
derive instance genericAddContactParams :: Generic AddContactParams _
instance showAddContactParams :: Show AddContactParams where
show = genericShow
instance decodeJsonAddContactParams :: DecodeJson AddContactParams where newtype AddContactParams =
decodeJson = genericSumDecodeJson AddContactParams { firstname :: String, lastname :: String }
derive instance Eq AddContactParams
derive instance Generic AddContactParams _
derive instance Newtype AddContactParams _
instance Show AddContactParams where show = genericShow
derive newtype instance JSON.ReadForeign AddContactParams
derive newtype instance JSON.WriteForeign AddContactParams
instance encodeJsonAddContactParams :: EncodeJson AddContactParams where
encodeJson = genericSumEncodeJson
module Gargantext.Components.Forest.Tree.Node.Action.Link where module Gargantext.Components.Forest.Tree.Node.Action.Link where
import Data.Argonaut as Argonaut
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Show.Generic (genericShow) import Data.Show.Generic (genericShow)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T import Toestand as T
import Gargantext.Components.Forest.Tree.Node.Action (Action(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
...@@ -23,16 +24,12 @@ import Gargantext.Utils.Reactix as R2 ...@@ -23,16 +24,12 @@ import Gargantext.Utils.Reactix as R2
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Link" here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Link"
data LinkNodeReq = LinkNodeReq { nodeType :: GT.NodeType, id :: GT.ID } newtype LinkNodeReq = LinkNodeReq { nodeType :: GT.NodeType, id :: GT.ID }
derive instance Eq LinkNodeReq
derive instance eqLinkNodeReq :: Eq LinkNodeReq derive instance Generic LinkNodeReq _
derive instance genericLinkNodeReq :: Generic LinkNodeReq _ instance Show LinkNodeReq where show = genericShow
instance showLinkNodeReq :: Show LinkNodeReq where derive newtype instance JSON.ReadForeign LinkNodeReq
show = genericShow derive newtype instance JSON.WriteForeign LinkNodeReq
instance decodeJsonLinkNodeReq :: Argonaut.DecodeJson LinkNodeReq where
decodeJson = genericSumDecodeJson
instance encodeJsonLinkNodeReq :: Argonaut.EncodeJson LinkNodeReq where
encodeJson = genericSumEncodeJson
linkNodeReq :: Session -> Maybe GT.NodeType -> GT.ID -> GT.ID -> Aff GT.AsyncTaskWithType linkNodeReq :: Session -> Maybe GT.NodeType -> GT.ID -> GT.ID -> Aff GT.AsyncTaskWithType
......
module Gargantext.Components.Forest.Tree.Node.Action.Rename where module Gargantext.Components.Forest.Tree.Node.Action.Rename where
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>)) import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Prelude (($)) import Simple.JSON as JSON
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action import Gargantext.Components.Forest.Tree.Node.Action
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Types (ID) import Gargantext.Types (ID)
...@@ -21,10 +25,9 @@ renameAction newName = RenameNode newName ...@@ -21,10 +25,9 @@ renameAction newName = RenameNode newName
------------------------------------------------------------------------ ------------------------------------------------------------------------
newtype RenameValue = RenameValue newtype RenameValue = RenameValue
{ text :: String } { text :: String }
derive instance Generic RenameValue _
instance encodeJsonRenameValue :: EncodeJson RenameValue where derive instance Newtype RenameValue _
encodeJson (RenameValue {text}) instance JSON.WriteForeign RenameValue where
= "name" := text writeImpl (RenameValue {text}) = JSON.writeImpl { name: text }
~> jsonEmptyObject
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -29,9 +29,9 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Search.Frame" ...@@ -29,9 +29,9 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Search.Frame"
data FrameSource = Istex | Searx data FrameSource = Istex | Searx
derive instance genericFrameSource :: Generic FrameSource _ derive instance Generic FrameSource _
instance showFrameSource :: Show FrameSource where instance Show FrameSource where
show = genericShow show = genericShow
-------------------- --------------------
......
module Gargantext.Components.Forest.Tree.Node.Action.Search.Types where module Gargantext.Components.Forest.Tree.Node.Action.Search.Types where
import Data.Argonaut (class EncodeJson, encodeJson, jsonEmptyObject, (:=), (~>))
import Data.Array (concat) import Data.Array (concat)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), fromMaybe, maybe) import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Data.Set (Set) import Data.Set (Set)
import Data.Set as Set import Data.Set as Set
import Data.String as String
import Data.Tuple (Tuple) import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Simple.JSON as JSON
import Simple.JSON.Generics as JSONG
import URI.Extra.QueryPairs as QP
import URI.Query as Q
import Gargantext.Prelude
import Gargantext.Components.Lang import Gargantext.Components.Lang
import Gargantext.Ends (class ToUrl, backendUrl) import Gargantext.Ends (class ToUrl, backendUrl)
import Gargantext.Prelude (id, class Eq, class Ord, class Show, bind, map, pure, show, ($), (<>), class Read)
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session(..), post) import Gargantext.Sessions (Session(..), post)
import Gargantext.Types as GT import Gargantext.Types as GT
import URI.Extra.QueryPairs as QP
import URI.Query as Q
import Data.String as String
type Search = { databases :: Database type Search = { databases :: Database
, datafield :: Maybe DataField , datafield :: Maybe DataField
...@@ -56,40 +60,34 @@ data DataField = Gargantext ...@@ -56,40 +60,34 @@ data DataField = Gargantext
| Web | Web
| Files | Files
derive instance Generic DataField _
instance showDataField :: Show DataField where instance Show DataField where
show Gargantext = "Gargantext" show Gargantext = "Gargantext"
show (External _) = "Databases (APIs)" -- <> show x show (External _) = "Databases (APIs)" -- <> show x
show Web = "Soon: web" show Web = "Soon: web"
show Files = "Files" show Files = "Files"
instance Doc DataField where
instance docDataField :: Doc DataField where
doc Gargantext = "All Gargantext Database" doc Gargantext = "All Gargantext Database"
doc (External _) = "External (scientific) databases" doc (External _) = "External (scientific) databases"
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 Eq DataField
derive instance eqDataField :: Eq DataField instance JSON.WriteForeign DataField where
writeImpl Gargantext = JSON.writeImpl "Internal PubMed"
instance encodeJsonDataField :: EncodeJson DataField where writeImpl (External (Just db)) = JSON.writeImpl $ "External " <> show db
encodeJson Gargantext = encodeJson "Internal PubMed" -- later Internal Maybe Database writeImpl f = JSON.writeImpl $ show f
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 } data DataOriginApi = InternalOrigin { api :: Database }
| ExternalOrigin { api :: Database } | ExternalOrigin { api :: Database }
derive instance Generic DataOriginApi _
instance Show DataOriginApi where
instance encodeJsonDataOriginApi :: EncodeJson DataOriginApi where show (InternalOrigin io) = "InternalOrigin " <> show io.api
encodeJson (InternalOrigin dta) = "api" := dta.api ~> jsonEmptyObject show (ExternalOrigin io) = "ExternalOrigin " <> show io.api
encodeJson (ExternalOrigin dta) = "api" := dta.api ~> jsonEmptyObject derive instance Eq DataOriginApi
instance JSON.WriteForeign DataOriginApi where
writeImpl (InternalOrigin { api }) = JSON.writeImpl { api }
writeImpl (ExternalOrigin { api }) = JSON.writeImpl { api }
datafield2dataOriginApi :: DataField -> DataOriginApi datafield2dataOriginApi :: DataField -> DataOriginApi
datafield2dataOriginApi (External (Just a)) = ExternalOrigin { api : a } datafield2dataOriginApi (External (Just a)) = ExternalOrigin { api : a }
...@@ -123,8 +121,8 @@ data Database = All_Databases ...@@ -123,8 +121,8 @@ data Database = All_Databases
| Isidore | Isidore
-- | News -- | News
-- | SocialNetworks -- | SocialNetworks
derive instance Generic Database _
instance showDatabase :: Show Database where instance Show Database where
show All_Databases= "All Databases" show All_Databases= "All Databases"
show PubMed = "PubMed" show PubMed = "PubMed"
show (HAL _)= "HAL" show (HAL _)= "HAL"
...@@ -135,7 +133,7 @@ instance showDatabase :: Show Database where ...@@ -135,7 +133,7 @@ instance showDatabase :: Show Database where
-- show News = "News" -- show News = "News"
-- show SocialNetworks = "Social Networks" -- show SocialNetworks = "Social Networks"
instance docDatabase :: Doc Database where instance Doc Database where
doc All_Databases = "All databases" doc All_Databases = "All databases"
doc PubMed = "All Medical publications" doc PubMed = "All Medical publications"
doc (HAL _) = "All open science (archives ouvertes)" doc (HAL _) = "All open science (archives ouvertes)"
...@@ -146,7 +144,7 @@ instance docDatabase :: Doc Database where ...@@ -146,7 +144,7 @@ instance docDatabase :: Doc Database where
-- doc News = "Web filtered by News" -- doc News = "Web filtered by News"
-- doc SocialNetworks = "Web filtered by MicroBlogs" -- doc SocialNetworks = "Web filtered by MicroBlogs"
instance readDatabase :: Read Database where instance Read Database where
read :: String -> Maybe Database read :: String -> Maybe Database
read "All Databases" = Just All_Databases read "All Databases" = Just All_Databases
read "PubMed" = Just PubMed read "PubMed" = Just PubMed
...@@ -159,10 +157,8 @@ instance readDatabase :: Read Database where ...@@ -159,10 +157,8 @@ instance readDatabase :: Read Database where
-- read "Social Networks" = Just SocialNetworks -- read "Social Networks" = Just SocialNetworks
read _ = Nothing read _ = Nothing
derive instance eqDatabase :: Eq Database derive instance Eq Database
instance JSON.WriteForeign Database where writeImpl = JSON.writeImpl <<< show
instance encodeJsonDatabase :: EncodeJson Database where
encodeJson a = encodeJson (show a)
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | Organization specifications -- | Organization specifications
...@@ -179,24 +175,21 @@ data Org = All_Orgs ...@@ -179,24 +175,21 @@ data Org = All_Orgs
| IMT (Set IMT_org) | IMT (Set IMT_org)
type StructId = Int type StructId = Int
derive instance Generic Org _
instance showOrg :: Show Org where instance Show Org where
show All_Orgs = "All_Orgs" show All_Orgs = "All_Orgs"
show (CNRS _) = "CNRS" show (CNRS _) = "CNRS"
show (IMT _) = "IMT" show (IMT _) = "IMT"
show (Others _) = "Others" show (Others _) = "Others"
instance readOrg :: Read Org where instance Read Org where
read "All_Orgs" = Just $ All_Orgs read "All_Orgs" = Just $ All_Orgs
read "CNRS" = Just $ CNRS $ Set.fromFoldable [] read "CNRS" = Just $ CNRS $ Set.fromFoldable []
read "IMT" = Just $ IMT $ Set.fromFoldable [] read "IMT" = Just $ IMT $ Set.fromFoldable []
read "Others" = Just $ Others $ Set.fromFoldable [] read "Others" = Just $ Others $ Set.fromFoldable []
read _ = Nothing read _ = Nothing
derive instance Eq Org
derive instance eqOrg :: Eq Org instance JSON.WriteForeign Org where writeImpl = JSON.writeImpl <<< show
instance encodeJsonOrg :: EncodeJson Org where
encodeJson a = encodeJson (show a)
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -242,10 +235,10 @@ data IMT_org = All_IMT ...@@ -242,10 +235,10 @@ data IMT_org = All_IMT
| Telecom_ParisTech | Telecom_ParisTech
| Telecom_SudParis | Telecom_SudParis
derive instance ordIMT_org :: Ord IMT_org derive instance Ord IMT_org
derive instance eqIMT_org :: Eq IMT_org derive instance Eq IMT_org
instance showIMT_org :: Show IMT_org where instance Show IMT_org where
show All_IMT = "All_IMT" show All_IMT = "All_IMT"
show ARMINES = "ARMINES" show ARMINES = "ARMINES"
show Eurecom = "Eurecom" show Eurecom = "Eurecom"
...@@ -265,7 +258,7 @@ instance showIMT_org :: Show IMT_org where ...@@ -265,7 +258,7 @@ instance showIMT_org :: Show IMT_org where
show Telecom_ParisTech = "Telecom_ParisTech" show Telecom_ParisTech = "Telecom_ParisTech"
show Telecom_SudParis = "Telecom_SudParis" show Telecom_SudParis = "Telecom_SudParis"
instance readIMT_org :: Read IMT_org where instance Read IMT_org where
read "All_IMT" = Just All_IMT read "All_IMT" = Just All_IMT
read "ARMINES" = Just ARMINES read "ARMINES" = Just ARMINES
read "Eurecom" = Just Eurecom read "Eurecom" = Just Eurecom
...@@ -315,7 +308,7 @@ data SearchOrder ...@@ -315,7 +308,7 @@ data SearchOrder
| ScoreAsc | ScoreAsc
| ScoreDesc | ScoreDesc
instance showSearchOrder :: Show SearchOrder where instance Show SearchOrder where
show DateAsc = "DateAsc" show DateAsc = "DateAsc"
show DateDesc = "DateDesc" show DateDesc = "DateDesc"
show TitleAsc = "TitleAsc" show TitleAsc = "TitleAsc"
...@@ -336,8 +329,8 @@ newtype SearchQuery = SearchQuery ...@@ -336,8 +329,8 @@ newtype SearchQuery = SearchQuery
, offset :: Maybe Int , offset :: Maybe Int
, order :: Maybe SearchOrder , order :: Maybe SearchOrder
} }
derive instance Generic SearchQuery _
derive instance newtypeSearchQuery :: Newtype SearchQuery _ derive instance Newtype SearchQuery _
defaultSearchQuery :: SearchQuery defaultSearchQuery :: SearchQuery
defaultSearchQuery = SearchQuery defaultSearchQuery = SearchQuery
...@@ -352,11 +345,11 @@ defaultSearchQuery = SearchQuery ...@@ -352,11 +345,11 @@ defaultSearchQuery = SearchQuery
, order : Nothing , order : Nothing
} }
instance toUrlSessionSearchQuery :: ToUrl Session SearchQuery where instance ToUrl Session SearchQuery where
toUrl (Session {backend}) q = backendUrl backend q2 toUrl (Session {backend}) q = backendUrl backend q2
where q2 = "new" <> Q.print (GT.toQuery q) where q2 = "new" <> Q.print (GT.toQuery q)
instance searchQueryToQuery :: GT.ToQuery SearchQuery where instance GT.ToQuery SearchQuery where
toQuery (SearchQuery {offset, limit, order}) = toQuery (SearchQuery {offset, limit, order}) =
QP.print id id $ QP.QueryPairs QP.print id id $ QP.QueryPairs
$ pair "offset" offset $ pair "offset" offset
...@@ -365,16 +358,13 @@ instance searchQueryToQuery :: GT.ToQuery SearchQuery where ...@@ -365,16 +358,13 @@ instance searchQueryToQuery :: GT.ToQuery SearchQuery where
where pair :: forall a. Show a => String -> Maybe a -> Array (Tuple QP.Key (Maybe QP.Value)) where pair :: forall a. Show a => String -> Maybe a -> Array (Tuple QP.Key (Maybe QP.Value))
pair k = maybe [] $ \v -> pair k = maybe [] $ \v ->
[ QP.keyFromString k /\ Just (QP.valueFromString $ show v) ] [ QP.keyFromString k /\ Just (QP.valueFromString $ show v) ]
instance JSON.WriteForeign SearchQuery where
instance encodeJsonSearchQuery :: EncodeJson SearchQuery where writeImpl (SearchQuery { datafield, databases, lang, node_id, query }) =
encodeJson (SearchQuery {query, databases, datafield, node_id, lang}) JSON.writeImpl { query: String.replace (String.Pattern "\"") (String.Replacement "\\\"") query
= "query" := (String.replace (String.Pattern "\"") (String.Replacement "\\\"") query) , databases: databases
-- ~> "datafield" := "" -- fromMaybe "" datafield , lang: maybe "EN" show lang
~> "databases" := databases , node_id: fromMaybe 0 node_id
~> "lang" := maybe "EN" show lang }
~> "node_id" := fromMaybe 0 node_id
-- ~> "files_id" := files_id
~> jsonEmptyObject
performSearch :: Session -> Int -> SearchQuery -> Aff GT.AsyncTaskWithType performSearch :: Session -> Int -> SearchQuery -> Aff GT.AsyncTaskWithType
performSearch session nodeId q = do performSearch session nodeId q = do
......
module Gargantext.Components.Forest.Tree.Node.Action.Share where module Gargantext.Components.Forest.Tree.Node.Action.Share where
import Data.Argonaut as Argonaut
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Show.Generic (genericShow) import Data.Show.Generic (genericShow)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Prelude (($))
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Simple.JSON.Generics as JSONG
import Toestand as T import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action (Action) import Gargantext.Components.Forest.Tree.Node.Action (Action)
import Gargantext.Components.Forest.Tree.Node.Action as Action import Gargantext.Components.Forest.Tree.Node.Action as Action
import Gargantext.Components.Forest.Tree.Node.Tools as Tools import Gargantext.Components.Forest.Tree.Node.Tools as Tools
...@@ -37,20 +39,11 @@ shareAction username = Action.ShareTeam username ...@@ -37,20 +39,11 @@ shareAction username = Action.ShareTeam username
------------------------------------------------------------------------ ------------------------------------------------------------------------
data ShareNodeParams = ShareTeamParams { username :: String } data ShareNodeParams = ShareTeamParams { username :: String }
| SharePublicParams { node_id :: Int } | SharePublicParams { node_id :: Int }
derive instance Eq ShareNodeParams
derive instance eqShareNodeParams :: Eq ShareNodeParams derive instance Generic ShareNodeParams _
instance JSON.ReadForeign ShareNodeParams where readImpl = JSONG.untaggedSumRep
derive instance genericShareNodeParams :: Generic ShareNodeParams _ instance JSON.WriteForeign ShareNodeParams where writeImpl = JSON.writeImpl <<< show
instance Show ShareNodeParams where show = genericShow
instance showShareNodeParams :: Show ShareNodeParams where
show = genericShow
instance decodeJsonShareNodeParams :: Argonaut.DecodeJson ShareNodeParams where
decodeJson = genericSumDecodeJson
instance encodeJsonShareNodeParams :: Argonaut.EncodeJson ShareNodeParams where
encodeJson = genericSumEncodeJson
------------------------------------------------------------------------ ------------------------------------------------------------------------
type ShareNode = type ShareNode =
......
module Gargantext.Components.Forest.Tree.Node.Action.Update.Types where module Gargantext.Components.Forest.Tree.Node.Action.Update.Types where
import Data.Argonaut as Argonaut
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Show.Generic (genericShow) import Data.Show.Generic (genericShow)
import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson, genericEnumDecodeJson, genericEnumEncodeJson)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Gargantext.Prelude (class Eq, class Read, class Show) import Simple.JSON as JSON
import Simple.JSON.Generics as JSONG
import Gargantext.Prelude
import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson, genericEnumDecodeJson, genericEnumEncodeJson)
data UpdateNodeParams = UpdateNodeParamsList { methodList :: Method } data UpdateNodeParams = UpdateNodeParamsList { methodList :: Method }
| UpdateNodeParamsGraph { methodGraph :: GraphMetric } | UpdateNodeParamsGraph { methodGraph :: GraphMetric }
| UpdateNodeParamsTexts { methodTexts :: Granularity } | UpdateNodeParamsTexts { methodTexts :: Granularity }
| UpdateNodeParamsBoard { methodBoard :: Charts } | UpdateNodeParamsBoard { methodBoard :: Charts }
derive instance Eq UpdateNodeParams
derive instance eqUpdateNodeParams :: Eq UpdateNodeParams derive instance Generic UpdateNodeParams _
instance Show UpdateNodeParams where show = genericShow
derive instance genericUpdateNodeParams :: Generic UpdateNodeParams _ instance JSON.ReadForeign UpdateNodeParams where readImpl = JSONG.untaggedSumRep
instance JSON.WriteForeign UpdateNodeParams where
instance showUpdateNodeParams :: Show UpdateNodeParams where writeImpl (UpdateNodeParamsList { methodList }) = JSON.writeImpl { methodList }
show = genericShow writeImpl (UpdateNodeParamsGraph { methodGraph }) = JSON.writeImpl { methodGraph }
writeImpl (UpdateNodeParamsTexts { methodTexts }) = JSON.writeImpl { methodTexts }
instance decodeJsonUpdateNodeParams :: Argonaut.DecodeJson UpdateNodeParams where writeImpl (UpdateNodeParamsBoard { methodBoard }) = JSON.writeImpl { methodBoard }
decodeJson = genericSumDecodeJson
instance encodeJsonUpdateNodeParams :: Argonaut.EncodeJson UpdateNodeParams where
encodeJson = genericSumEncodeJson
---------------------------------------------------------------------- ----------------------------------------------------------------------
data Method = Basic | Advanced | WithModel data Method = Basic | Advanced | WithModel
derive instance Generic Method _
derive instance genericMethod :: Generic Method _ derive instance Eq Method
instance Show Method where show = genericShow
derive instance eqMethod :: Eq Method instance JSON.ReadForeign Method where readImpl = JSONG.enumSumRep
instance JSON.WriteForeign Method where writeImpl = JSON.writeImpl <<< show
instance showMethod :: Show Method where instance Read Method where
show = genericShow
instance readMethod :: Read Method where
read "Basic" = Just Basic read "Basic" = Just Basic
read "Advanced" = Just Advanced read "Advanced" = Just Advanced
read "WithModel" = Just WithModel read "WithModel" = Just WithModel
read _ = Nothing read _ = Nothing
instance decodeJsonMethod :: Argonaut.DecodeJson Method where
decodeJson = genericEnumDecodeJson
instance encodeJsonMethod :: Argonaut.EncodeJson Method where
encodeJson = genericEnumEncodeJson
---------------------------------------------------------------------- ----------------------------------------------------------------------
data GraphMetric = Order1 | Order2 data GraphMetric = Order1 | Order2
derive instance Generic GraphMetric _
derive instance genericGraphMetric :: Generic GraphMetric _ derive instance Eq GraphMetric
instance Show GraphMetric where show = genericShow
derive instance eqGraphMetric :: Eq GraphMetric instance Read GraphMetric where
instance showGraphMetric :: Show GraphMetric where
show = genericShow
instance readGraphMetric :: Read GraphMetric where
read "Order1" = Just Order1 read "Order1" = Just Order1
read "Order2" = Just Order2 read "Order2" = Just Order2
read _ = Nothing read _ = Nothing
instance JSON.ReadForeign GraphMetric where readImpl = JSONG.enumSumRep
instance decodeJsonGraphMetric :: Argonaut.DecodeJson GraphMetric where instance JSON.WriteForeign GraphMetric where writeImpl = JSON.writeImpl <<< show
decodeJson = genericEnumDecodeJson
instance encodeJsonGraphMetric :: Argonaut.EncodeJson GraphMetric where
encodeJson = genericEnumEncodeJson
---------------------------------------------------------------------- ----------------------------------------------------------------------
data Granularity = NewNgrams | NewTexts | Both data Granularity = NewNgrams | NewTexts | Both
derive instance Generic Granularity _
derive instance genericGranularity :: Generic Granularity _ derive instance Eq Granularity
instance Show Granularity where show = genericShow
derive instance eqGranularity :: Eq Granularity instance Read Granularity where
instance showGranularity :: Show Granularity where
show = genericShow
instance readGranularity :: Read Granularity where
read "NewNgrams" = Just NewNgrams read "NewNgrams" = Just NewNgrams
read "NewTexts" = Just NewTexts read "NewTexts" = Just NewTexts
read "Both" = Just Both read "Both" = Just Both
read _ = Nothing read _ = Nothing
instance JSON.ReadForeign Granularity where readImpl = JSONG.enumSumRep
instance decodeJsonGranularity :: Argonaut.DecodeJson Granularity where instance JSON.WriteForeign Granularity where writeImpl = JSON.writeImpl <<< show
decodeJson = genericEnumDecodeJson
instance encodeJsonGranularity :: Argonaut.EncodeJson Granularity where
encodeJson = genericEnumEncodeJson
---------------------------------------------------------------------- ----------------------------------------------------------------------
data Charts = Sources | Authors | Institutes | Ngrams | All data Charts = Sources | Authors | Institutes | Ngrams | All
derive instance Generic Charts _
derive instance genericChart :: Generic Charts _ derive instance Eq Charts
instance Show Charts where show = genericShow
derive instance eqChart :: Eq Charts instance Read Charts where
instance showChart :: Show Charts where
show = genericShow
instance readChart :: Read Charts where
read "Sources " = Just Sources read "Sources " = Just Sources
read "Authors" = Just Authors read "Authors" = Just Authors
read "Institutes" = Just Institutes read "Institutes" = Just Institutes
read "Ngrams" = Just Ngrams read "Ngrams" = Just Ngrams
read "AllCharts" = Just All read "AllCharts" = Just All
read _ = Nothing read _ = Nothing
instance JSON.ReadForeign Charts where readImpl = JSONG.enumSumRep
instance decodeJsonChart :: Argonaut.DecodeJson Charts where instance JSON.WriteForeign Charts where
decodeJson = genericEnumDecodeJson writeImpl All = JSON.writeImpl $ "AllCharts"
writeImpl f = JSON.writeImpl $ show f
instance encodeJsonChart :: Argonaut.EncodeJson Charts where
encodeJson = genericEnumEncodeJson
module Gargantext.Components.Forest.Tree.Node.Action.Upload where module Gargantext.Components.Forest.Tree.Node.Action.Upload where
import Data.Either (fromRight) import Data.Either (fromRight')
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq) import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe(..), fromJust, fromMaybe) import Data.Maybe (Maybe(..), fromJust, fromMaybe)
...@@ -13,7 +13,7 @@ import DOM.Simple.Console (log2) ...@@ -13,7 +13,7 @@ import DOM.Simple.Console (log2)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial, unsafeCrashWith)
import React.SyntheticEvent as E import React.SyntheticEvent as E
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
...@@ -73,8 +73,8 @@ data DroppedFile = ...@@ -73,8 +73,8 @@ data DroppedFile =
, fileType :: Maybe FileType , fileType :: Maybe FileType
, lang :: Lang , lang :: Lang
} }
derive instance genericDroppedFile :: Generic DroppedFile _ derive instance Generic DroppedFile _
instance eqDroppedFile :: Eq DroppedFile where instance Eq DroppedFile where
eq = genericEq eq = genericEq
type FileHash = String type FileHash = String
...@@ -302,8 +302,8 @@ fileTypeViewCpt = here.component "fileTypeView" cpt ...@@ -302,8 +302,8 @@ fileTypeViewCpt = here.component "fileTypeView" cpt
newtype FileUploadQuery = FileUploadQuery { newtype FileUploadQuery = FileUploadQuery {
fileType :: FileType fileType :: FileType
} }
derive instance newtypeSearchQuery :: Newtype FileUploadQuery _ derive instance Newtype FileUploadQuery _
instance fileUploadQueryToQuery :: GT.ToQuery FileUploadQuery where instance GT.ToQuery FileUploadQuery where
toQuery (FileUploadQuery {fileType}) = toQuery (FileUploadQuery {fileType}) =
QP.print id id $ QP.QueryPairs $ QP.print id id $ QP.QueryPairs $
pair "fileType" fileType pair "fileType" fileType
...@@ -347,7 +347,7 @@ uploadArbitraryDataURL :: Session ...@@ -347,7 +347,7 @@ uploadArbitraryDataURL :: Session
-> String -> String
-> Aff GT.AsyncTaskWithType -> Aff GT.AsyncTaskWithType
uploadArbitraryDataURL session id mName contents' = do uploadArbitraryDataURL session id mName contents' = do
let re = unsafePartial $ fromRight $ DSR.regex "data:.*;base64," DSRF.noFlags let re = fromRight' (\_ -> unsafeCrashWith "Unexpected Left") $ DSR.regex "data:.*;base64," DSRF.noFlags
contents = DSR.replace re "" contents' contents = DSR.replace re "" contents'
task <- postWwwUrlencoded session p (bodyParams contents) task <- postWwwUrlencoded session p (bodyParams contents)
pure $ GT.AsyncTaskWithType { task, typ: GT.Form } pure $ GT.AsyncTaskWithType { task, typ: GT.Form }
......
...@@ -11,12 +11,12 @@ import Gargantext.Prelude ...@@ -11,12 +11,12 @@ import Gargantext.Prelude
data FileType = CSV | CSV_HAL | WOS | PresseRIS | Arbitrary data FileType = CSV | CSV_HAL | WOS | PresseRIS | Arbitrary
derive instance genericFileType :: Generic FileType _ derive instance Generic FileType _
instance eqFileType :: Eq FileType where instance Eq FileType where
eq = genericEq eq = genericEq
instance showFileType :: Show FileType where instance Show FileType where
show = genericShow show = genericShow
instance readFileType :: Read FileType where instance Read FileType where
read :: String -> Maybe FileType read :: String -> Maybe FileType
read "Arbitrary" = Just Arbitrary read "Arbitrary" = Just Arbitrary
read "CSV" = Just CSV read "CSV" = Just CSV
...@@ -27,6 +27,6 @@ instance readFileType :: Read FileType where ...@@ -27,6 +27,6 @@ instance readFileType :: Read FileType where
newtype UploadFileBlob = UploadFileBlob Blob newtype UploadFileBlob = UploadFileBlob Blob
derive instance genericUploadFileBlob :: Generic UploadFileBlob _ derive instance Generic UploadFileBlob _
instance eqUploadFileBlob :: Eq UploadFileBlob where instance Eq UploadFileBlob where
eq (UploadFileBlob b1) (UploadFileBlob b2) = eq (size b1) (size b2) eq (UploadFileBlob b1) (UploadFileBlob b2) = eq (size b1) (size b2)
...@@ -30,7 +30,7 @@ data NodeAction = Documentation NodeType ...@@ -30,7 +30,7 @@ data NodeAction = Documentation NodeType
| CloseNodePopover | CloseNodePopover
------------------------------------------------------------------------ ------------------------------------------------------------------------
instance eqNodeAction :: Eq NodeAction where instance Eq NodeAction where
eq (Documentation x) (Documentation y) = true && (x == y) eq (Documentation x) (Documentation y) = true && (x == y)
eq SearchBox SearchBox = true eq SearchBox SearchBox = true
eq Download Download = true eq Download Download = true
...@@ -49,7 +49,7 @@ instance eqNodeAction :: Eq NodeAction where ...@@ -49,7 +49,7 @@ instance eqNodeAction :: Eq NodeAction where
eq CloseNodePopover CloseNodePopover = true eq CloseNodePopover CloseNodePopover = true
eq _ _ = false eq _ _ = false
instance showNodeAction :: Show NodeAction where instance Show NodeAction where
show (Documentation x) = "Documentation of " <> show x show (Documentation x) = "Documentation of " <> show x
show SearchBox = "SearchBox" show SearchBox = "SearchBox"
show Download = "Download" show Download = "Download"
......
module Gargantext.Components.Forest.Tree.Node.Tools.FTree where module Gargantext.Components.Forest.Tree.Node.Tools.FTree where
import Data.Argonaut (class DecodeJson, decodeJson, (.:)) import Data.Array as A
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq) import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Foreign as F
import Simple.JSON as JSON
import Simple.JSON.Generics as JSONG
import Gargantext.Prelude import Gargantext.Prelude
...@@ -16,9 +19,15 @@ type Name = String ...@@ -16,9 +19,15 @@ type Name = String
----------------------------------------------------------------------- -----------------------------------------------------------------------
type FTree = NTree LNode type FTree = NTree LNode
data NTree a = NTree a (Array (NTree a)) data NTree a = NTree a (Array (NTree a))
derive instance genericNTree :: Generic (NTree a) _ derive instance Generic (NTree a) _
instance eqNTree :: Eq a => Eq (NTree a) where instance JSON.ReadForeign (NTree LNode) where
readImpl f = do
inst :: { node :: LNode, children :: Array FTree } <- JSON.readImpl f
let (LNode { id }) = inst.node
pure $ NTree inst.node ((addParent id) <$> inst.children)
instance Eq a => Eq (NTree a) where
eq (NTree a1 as1) (NTree a2 as2) = (eq a1 a2) && (eq as1 as2) eq (NTree a1 as1) (NTree a2 as2) = (eq a1 a2) && (eq as1 as2)
type Tree = { tree :: FTree type Tree = { tree :: FTree
, tasks :: Array GT.AsyncTaskWithType , tasks :: Array GT.AsyncTaskWithType
} }
...@@ -26,7 +35,7 @@ type Tree = { tree :: FTree ...@@ -26,7 +35,7 @@ type Tree = { tree :: FTree
fTreeID :: FTree -> ID fTreeID :: FTree -> ID
fTreeID (NTree (LNode { id }) _) = id fTreeID (NTree (LNode { id }) _) = id
instance ntreeFunctor :: Functor NTree where instance Functor NTree where
map f (NTree x ary) = NTree (f x) (map (map f) ary) map f (NTree x ary) = NTree (f x) (map (map f) ary)
newtype LNode = newtype LNode =
...@@ -36,31 +45,16 @@ newtype LNode = ...@@ -36,31 +45,16 @@ newtype LNode =
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
, parent_id :: Maybe ID , parent_id :: Maybe ID
} }
derive instance newtypeLNode :: Newtype LNode _ derive instance Newtype LNode _
derive instance genericLNode :: Generic LNode _ derive instance Generic LNode _
instance eqLNode :: Eq LNode where instance Eq LNode where eq = genericEq
eq = genericEq instance JSON.ReadForeign LNode where
instance decodeJsonLNode :: DecodeJson LNode where readImpl f = do
decodeJson json = do inst :: { id :: ID, name :: Name, type :: GT.NodeType, parent_id :: Maybe ID } <- JSON.readImpl f
obj <- decodeJson json pure $ LNode { id: inst.id
id_ <- obj .: "id" , name: inst.name
name <- obj .: "name" , nodeType: inst.type
nodeType <- obj .: "type" , parent_id: Nothing }
pure $ LNode { id : id_
, name
, nodeType
, parent_id : Nothing
}
instance decodeJsonFTree :: DecodeJson (NTree LNode) where
decodeJson json = do
obj <- decodeJson json
node <- obj .: "node"
nodes <- obj .: "children"
node' <- decodeJson node
nodes' <- decodeJson nodes
let (LNode {id}) = node'
pure $ NTree node' (map (addParent id) nodes')
addParent :: ID -> NTree LNode -> NTree LNode addParent :: ID -> NTree LNode -> NTree LNode
addParent id (NTree (LNode p@{id:id'}) ary)= addParent id (NTree (LNode p@{id:id'}) ary)=
......
...@@ -52,7 +52,7 @@ asyncProgressBarCpt = here.component "asyncProgressBar" cpt ...@@ -52,7 +52,7 @@ asyncProgressBarCpt = here.component "asyncProgressBar" cpt
asyncProgress@(GT.AsyncProgress {status}) <- queryProgress props asyncProgress@(GT.AsyncProgress {status}) <- queryProgress props
liftEffect do liftEffect do
T.write_ (min 100.0 $ GT.progressPercent asyncProgress) progress T.write_ (min 100.0 $ GT.progressPercent asyncProgress) progress
if (status == GT.Finished) || (status == GT.Killed) || (status == GT.Failed) then do if (status == GT.IsFinished) || (status == GT.IsKilled) || (status == GT.IsFailure) then do
_ <- case R.readRef intervalIdRef of _ <- case R.readRef intervalIdRef of
Nothing -> pure unit Nothing -> pure unit
Just iid -> clearInterval iid Just iid -> clearInterval iid
......
...@@ -10,10 +10,10 @@ import Reactix as R ...@@ -10,10 +10,10 @@ import Reactix as R
data SubTreeOut = SubTreeOut { in :: GT.ID data SubTreeOut = SubTreeOut { in :: GT.ID
, out :: GT.ID , out :: GT.ID
} }
derive instance genericSubTreeOut :: Generic SubTreeOut _ derive instance Generic SubTreeOut _
instance eqSubTreOut :: Eq SubTreeOut where instance Eq SubTreeOut where
eq = genericEq eq = genericEq
instance showSubTreeOut :: Show SubTreeOut where instance Show SubTreeOut where
show = genericShow show = genericShow
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -21,10 +21,10 @@ data SubTreeParams = SubTreeParams { showtypes :: Array GT.NodeType ...@@ -21,10 +21,10 @@ data SubTreeParams = SubTreeParams { showtypes :: Array GT.NodeType
, valitypes :: Array GT.NodeType , valitypes :: Array GT.NodeType
} }
derive instance genericSubTreeParams :: Generic SubTreeParams _ derive instance Generic SubTreeParams _
instance eqSubTreeParams :: Eq SubTreeParams where instance Eq SubTreeParams where
eq = genericEq eq = genericEq
instance showSubTreeParams :: Show SubTreeParams where instance Show SubTreeParams where
show = genericShow show = genericShow
------------------------------------------------------------------------ ------------------------------------------------------------------------
......
...@@ -29,8 +29,8 @@ here = R2.here "Gargantext.Components.Graph" ...@@ -29,8 +29,8 @@ here = R2.here "Gargantext.Components.Graph"
type OnProps = () type OnProps = ()
data Stage = Init | Ready | Cleanup data Stage = Init | Ready | Cleanup
derive instance genericStage :: Generic Stage _ derive instance Generic Stage _
derive instance eqStage :: Eq Stage derive instance Eq Stage
type Props sigma forceatlas2 = type Props sigma forceatlas2 =
......
...@@ -14,15 +14,15 @@ allLangs = [ EN ...@@ -14,15 +14,15 @@ allLangs = [ EN
data Lang = FR | EN | Universal | No_extraction data Lang = FR | EN | Universal | No_extraction
instance showLang :: Show Lang where instance Show Lang where
show FR = "FR" show FR = "FR"
show EN = "EN" show EN = "EN"
show Universal = "All" show Universal = "All"
show No_extraction = "Nothing" show No_extraction = "Nothing"
derive instance eqLang :: Eq Lang derive instance Eq Lang
instance readLang :: Read Lang where instance Read Lang where
read "FR" = Just FR read "FR" = Just FR
read "EN" = Just EN read "EN" = Just EN
read "All" = Just Universal read "All" = Just Universal
...@@ -30,7 +30,7 @@ instance readLang :: Read Lang where ...@@ -30,7 +30,7 @@ instance readLang :: Read Lang where
read _ = Nothing read _ = Nothing
instance encodeJsonLang :: EncodeJson Lang where instance EncodeJson Lang where
encodeJson a = encodeJson (show a) encodeJson a = encodeJson (show a)
-- Language used for the landing page -- Language used for the landing page
......
This diff is collapsed.
...@@ -16,10 +16,10 @@ newtype NodePoly a = ...@@ -16,10 +16,10 @@ newtype NodePoly a =
, date :: String , date :: String
, hyperdata :: a , hyperdata :: a
} }
derive instance genericNodePoly :: Generic (NodePoly a) _ derive instance Generic (NodePoly a) _
instance eqNodePoly :: Eq a => Eq (NodePoly a) where instance Eq a => Eq (NodePoly a) where
eq = genericEq eq = genericEq
instance decodeNodePoly :: (DecodeJson a) instance (DecodeJson a)
=> DecodeJson (NodePoly a) where => DecodeJson (NodePoly a) where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
...@@ -44,7 +44,7 @@ instance decodeNodePoly :: (DecodeJson a) ...@@ -44,7 +44,7 @@ instance decodeNodePoly :: (DecodeJson a)
newtype HyperdataList = HyperdataList { preferences :: String } newtype HyperdataList = HyperdataList { preferences :: String }
instance decodeHyperdataList :: DecodeJson HyperdataList where instance DecodeJson HyperdataList where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
pref <- obj .:? "preferences" .!= "" pref <- obj .:? "preferences" .!= ""
......
...@@ -239,10 +239,10 @@ contactCellsCpt = here.component "contactCells" cpt where ...@@ -239,10 +239,10 @@ contactCellsCpt = here.component "contactCells" cpt where
data HyperdataAnnuaire = HyperdataAnnuaire data HyperdataAnnuaire = HyperdataAnnuaire
{ title :: Maybe String { title :: Maybe String
, desc :: Maybe String } , desc :: Maybe String }
derive instance genericHyperdataAnnuaire :: Generic HyperdataAnnuaire _ derive instance Generic HyperdataAnnuaire _
instance eqHyperdataAnnuaire :: Eq HyperdataAnnuaire where instance Eq HyperdataAnnuaire where
eq = genericEq eq = genericEq
instance decodeHyperdataAnnuaire :: DecodeJson HyperdataAnnuaire where instance DecodeJson HyperdataAnnuaire where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
title <- obj .:? "title" title <- obj .:? "title"
...@@ -260,10 +260,10 @@ newtype AnnuaireInfo = ...@@ -260,10 +260,10 @@ newtype AnnuaireInfo =
, date :: String , date :: String
, hyperdata :: HyperdataAnnuaire , hyperdata :: HyperdataAnnuaire
} }
derive instance genericAnnuaireInfo :: Generic AnnuaireInfo _ derive instance Generic AnnuaireInfo _
instance eqAnnuaireInfo :: Eq AnnuaireInfo where instance Eq AnnuaireInfo where
eq = genericEq eq = genericEq
instance decodeAnnuaireInfo :: DecodeJson AnnuaireInfo where instance DecodeJson AnnuaireInfo where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
id <- obj .: "id" id <- obj .: "id"
...@@ -285,7 +285,7 @@ instance decodeAnnuaireInfo :: DecodeJson AnnuaireInfo where ...@@ -285,7 +285,7 @@ instance decodeAnnuaireInfo :: DecodeJson AnnuaireInfo where
--newtype AnnuaireTable = AnnuaireTable { annuaireTable :: Array (Maybe Contact)} --newtype AnnuaireTable = AnnuaireTable { annuaireTable :: Array (Maybe Contact)}
--instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where --instance DecodeJson AnnuaireTable where
-- decodeJson json = do -- decodeJson json = do
-- rows <- decodeJson json -- rows <- decodeJson json
-- pure $ AnnuaireTable { annuaireTable : rows} -- pure $ AnnuaireTable { annuaireTable : rows}
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
module Gargantext.Utils.Tuple where
import Data.Tuple (Tuple(..))
mapFst :: forall a b c. (a -> c) -> Tuple a b -> Tuple c b
mapFst f (Tuple k v) = Tuple (f k) v
This diff is collapsed.
This diff is collapsed.
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