Merge branch 'dev' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev

docker-env.sh

@@ -37,11 +37,15 @@ package(){
 }
 
 pulp(){
-  dockerrun node pulp "$@"
+  dockerrun node pulp --psc-package "$@"
 }
 
 repl(){
-  dockerrun -ti node pulp repl "$@"
+  dockerrun -ti node pulp --psc-package repl "$@"
+}
+
+check(){
+  pulp test "$@"
 }
 
 setup(){
@@ -50,7 +54,7 @@ setup(){
 }
 
 build(){
-  pulp --psc-package browserify --to dist/bundle.js
+  pulp browserify --to dist/bundle.js
 }
 
 serve(){

psc-package.json

@@ -3,6 +3,9 @@
   "set": "master",
   "source": "https://github.com/np/package-sets.git",
   "depends": [
+    "spec-quickcheck",
+    "spec-discovery",
+    "uint",
     "js-timers",
     "psci-support",
     "css",

src/Gargantext/Components/Charts/Options/ECharts.purs

@@ -5,7 +5,6 @@ import Prelude
 import CSS (italic)
 import CSS.Common (normal)
 import Data.Array (length)
-import Data.Maybe (Maybe(..))
 import Gargantext.Components.Charts.Options.Color (transparent, violet, black)
 import Gargantext.Components.Charts.Options.Data (DataLegend, DataAxis, dataSerie)
 import Gargantext.Components.Charts.Options.Font (IconOptions(..), Shape(..), TextStyle, chartFontStyle, chartFontWeight, icon, mkTooltip, Tooltip)
@@ -27,18 +26,18 @@ chart = echarts <<< chartWith <<< opts
 chartWith :: Option -> Echarts
 chartWith option =
   { option
-  , className : Nothing
-  , style     : Nothing
-  , theme     : Nothing
-  , group     : Nothing
-  , initOpts  : Nothing
-  , notMerge  : Nothing
-  , lazyUpdate: Nothing
-  , loading   : Nothing
-  , optsLoading: Nothing
-  , onReady    : Nothing
-  , resizable  : Nothing
-  , onEvents   : Nothing
+--, className : Nothing
+--, style     : Nothing
+--, theme     : Nothing
+--, group     : Nothing
+--, initOpts  : Nothing
+--, notMerge  : Nothing
+--, lazyUpdate: Nothing
+--, loading   : Nothing
+--, optsLoading: Nothing
+--, onReady    : Nothing
+--, resizable  : Nothing
+--, onEvents   : Nothing
   }
 
 echarts :: Echarts -> R.ReactElement
@@ -98,10 +97,10 @@ legend =
    , itemGap: 10.0
    , itemWidth: 25.0
    , itemHeight: 14.0
-   , formatter: Nothing
+ --, formatter: Nothing
    , selectedMode: selectedMode $ Bool true
    , inactiveColor: violet
-   , selected: Nothing
+ --- selected: Nothing
    , textStyle: textStyle
    , "data": [data1]
   }

src/Gargantext/Components/Charts/Options/Type.purs

@@ -2,7 +2,6 @@ module Gargantext.Components.Charts.Options.Type where
 
 import Prelude
 
-import Data.Maybe (Maybe)
 import Gargantext.Components.Charts.Options.Color (Color)
 import Gargantext.Components.Charts.Options.Data (DataLegend, DataAxis)
 import Gargantext.Components.Charts.Options.Font (TextStyle, Tooltip)
@@ -15,21 +14,22 @@ import Unsafe.Coerce (unsafeCoerce)
 
 newtype ChartAlign = ChartAlign String
 
--- TODO: Not sure that Maybe is working here => use Optional
+-- TODO: Maybe is not working here => use Optional
+
 type Echarts =
-  { className   :: Maybe String
-  , style       :: Maybe String  -- objealect-black-altdarkmincnaquadahherry-blossomect,
-  , theme       :: Maybe String
-  , group       :: Maybe String
-  , option      :: Option       --  PropTypes.object.isRequired,
-  , initOpts    :: Maybe String -- PropTypes.object,
-  , notMerge    :: Maybe Boolean
-  , lazyUpdate  :: Maybe Boolean
-  , loading     :: Maybe Boolean
-  , optsLoading :: Maybe OptsLoading --  PropTypes.object,
-  , onReady     :: Maybe String   --  PropTypes.func,
-  , resizable   :: Maybe Boolean  -- PropTypes.bool,
-  , onEvents    :: Maybe String   -- PropTypes.object
+  { option      :: Option       --  PropTypes.object.isRequired,
+--, className   :: Maybe String
+--, style       :: Maybe String  -- objealect-black-altdarkmincnaquadahherry-blossomect,
+--, theme       :: Maybe String
+--, group       :: Maybe String
+--, initOpts    :: Maybe String -- PropTypes.object,
+--, notMerge    :: Maybe Boolean
+--, lazyUpdate  :: Maybe Boolean
+--, loading     :: Maybe Boolean
+--, optsLoading :: Maybe OptsLoading --  PropTypes.object,
+--, onReady     :: Maybe String   --  PropTypes.func,
+--, resizable   :: Maybe Boolean  -- PropTypes.bool,
+--, onEvents    :: Maybe String   -- PropTypes.object
   }
 
 type Option =
@@ -112,10 +112,10 @@ type Legend =
   , itemGap :: Number
   , itemWidth :: Number
   , itemHeight :: Number
-  , formatter :: Maybe String
+--, formatter :: Maybe String
   , selectedMode :: SelectedMode
   , inactiveColor :: Color
-  , selected :: Maybe String -- object
+--, selected :: Maybe String -- object
   , textStyle :: TextStyle
   , "data" :: Array DataLegend
   }

src/Gargantext/Components/GraphExplorer/Sigmajs.js

 'use strict';
 
+var dummyClass = 'DummyClass';
+exports.edgeShapesClass = dummyClass;
+exports.filterClass = dummyClass;
+exports.forceAtlas2Class = dummyClass;
+exports.loadGEXFClass = dummyClass;
+exports.loadJSONClass = dummyClass;
+exports.nOverlapClass = dummyClass;
+exports.neoCypherClass = dummyClass;
+exports.neoGraphItemsProducersClass = dummyClass;
+exports.nodeShapesClass = dummyClass;
+exports.randomizeNodePositionsClass = dummyClass;
+exports.relativeSizeClass = dummyClass;
+exports.sigmaClass = dummyClass;
+exports.sigmaEnableSVGClass = dummyClass;
+exports.sigmaEnableWebGLClass = dummyClass;
+exports.forceLinkClass = dummyClass;
+
+if (typeof window !== 'undefined') {
+
 const SJS = require('react-sigma');
 const FL = require('react-sigma/lib/ForceLink');
 
@@ -18,3 +37,5 @@ exports.sigmaClass = SJS.Sigma;
 exports.sigmaEnableSVGClass = SJS.SigmaEnableSVG;
 exports.sigmaEnableWebGLClass = SJS.SigmaEnableWebGL;
 exports.forceLinkClass = FL.default;
+
+}

src/Gargantext/Utils/KarpRabin.purs

+-- |
+-- The present module has been ported from Haskell to PureScript
+-- by Nicolas Pouillard for the Gargantext projet.
+--
+-- Original Haskell code:
+--   Copyright      : (c) 2010 Daniel Fischer
+--   Licence        : BSD3
+--   Maintainer     : Daniel Fischer <daniel.is.fischer@googlemail.com>
+--
+-- Simultaneous search for multiple patterns in a 'String'
+-- using the Karp-Rabin algorithm.
+--
+-- A description of the algorithm for a single pattern can be found at
+-- <http://www-igm.univ-mlv.fr/~lecroq/string/node5.html#SECTION0050>.
+module Gargantext.Utils.KarpRabin ( -- * Overview
+                                    -- $overview
+
+                                    -- ** Caution
+                                    -- $caution
+
+                                    -- * Function
+                                    indicesOfAny
+                                  ) where
+
+
+import Data.Array as A
+import Data.Enum (fromEnum)
+import Data.Foldable (class Foldable, minimum, foldl)
+import Data.Int (quot)
+import Data.List as L
+import Data.List (List)
+import Data.Map as M
+import Data.Maybe (Maybe(..), isJust)
+import Data.String as S
+import Data.String (CodePoint)
+import Data.Tuple (Tuple(..))
+import Data.UInt (UInt, shl, fromInt)
+import Partial.Unsafe (unsafePartial)
+
+import Prelude
+
+fromCodePoint :: CodePoint -> UInt
+fromCodePoint c = fromInt (fromEnum c)
+
+-- $overview
+--
+-- The Karp-Rabin algorithm works by calculating a hash of the pattern and
+-- comparing that hash with the hash of a slice of the target string with
+-- the same length as the pattern. If the hashes are equal, the slice of the
+-- target is compared to the pattern byte for byte (since the hash
+-- function generally isn't injective).
+--
+-- For a single pattern, this tends to be more efficient than the na&#239;ve
+-- algorithm, but it cannot compete with algorithms like
+-- Knuth-Morris-Pratt or Boyer-Moore.
+--
+-- However, the algorithm can be generalised to search for multiple patterns
+-- simultaneously. If the shortest pattern has length @k@, hash the prefix of
+-- length @k@ of all patterns and compare the hash of the target's slices of
+-- length @k@ to them. If there's a match, check whether the slice is part
+-- of an occurrence of the corresponding pattern.
+--
+-- With a hash-function that
+--
+--   * allows to compute the hash of one slice in constant time from the hash
+--     of the previous slice, the new and the dropped character, and
+--
+--   * produces few spurious matches,
+--
+-- searching for occurrences of any of @n@ patterns has a best-case complexity
+-- of /O/(@targetLength@ * @lookup n@). The worst-case complexity is
+-- /O/(@targetLength@ * @lookup n@ * @sum patternLengths@), the average is
+-- not much worse than the best case.
+--
+-- The functions in this module store the hashes of the patterns in an
+-- 'Map', so the lookup is /O/(@log n@). Re-hashing is done in constant
+-- time and spurious matches of the hashes /should be/ sufficiently rare.
+-- The maximal length of the prefixes to be hashed is 32.
+
+-- $caution
+--
+-- Unfortunately, the constant factors are high, so these functions are slow.
+-- Unless the number of patterns to search for is high (larger than 50 at
+-- least), repeated search for single patterns using Boyer-Moore or DFA and
+-- manual merging of the indices is faster. /Much/ faster for less than 40
+-- or so patterns.
+--
+-- In summary, this module is more of an interesting curiosity than anything
+-- else.
+
+-- | @'indicesOfAny'@ finds all occurrences of any of several non-empty patterns
+--   in a strict target string. If no non-empty patterns are given,
+--   the result is an empty array. Otherwise the result array contains
+--   the pairs of all indices where any of the (non-empty) patterns start
+--   and the array of all patterns starting at that index, the patterns being
+--   represented by their (zero-based) position in the pattern array.
+--   Empty patterns are filtered out before processing begins.
+indicesOfAny :: Array String                  -- ^ Array of non-empty patterns
+             -> String                        -- ^ String to search
+             -> Array (Tuple Int (Array Int)) -- ^ Array of matches
+indicesOfAny pats = if A.null nepats then const []
+                                     else strictMatcher nepats
+      where
+        nepats = A.filter (not <<< S.null) pats
+
+
+------------------------------------------------------------------------------
+--                                 Workers                                 --
+------------------------------------------------------------------------------
+
+rehash' :: UInt -> UInt -> UInt -> CodePoint -> CodePoint -> UInt
+rehash' shDi out h o n =
+    (h `shl` shDi - (fromCodePoint o `shl` out)) + fromCodePoint n
+
+minimum1 :: forall a f. Ord a => Foldable f => a -> f a -> a
+minimum1 a fa =
+  case minimum fa of
+    Nothing -> a
+    Just b  -> min a b
+
+strictMatcher :: Array String -> String -> Array (Tuple Int (Array Int))
+strictMatcher pats = unsafePartial search
+  where
+    hLen = minimum1 32 (S.length <$> pats)
+    hLen' = fromInt hLen
+    shDi = case 32 `quot` hLen of
+              q | q < 4 -> q
+                | otherwise -> 4
+    outS = fromInt (shDi * hLen)
+    patNum = A.length pats
+    rehash :: UInt -> CodePoint -> CodePoint -> UInt
+    rehash = case shDi of
+                1 -> rehash' (fromInt 1) hLen'
+                2 -> rehash' (fromInt 2) outS
+                3 -> rehash' (fromInt 3) outS
+                _ -> rehash' (fromInt 4) outS
+    hash :: String -> UInt
+    hash = foldl (\h w -> (h `shl` fromInt shDi) + fromCodePoint w) (fromInt 0)
+        <<< S.toCodePointArray
+        <<< S.take hLen
+    hashMap =
+      M.fromFoldableWith (flip (<>))
+                         (A.mapWithIndex (\i a -> Tuple (hash a) [i]) pats)
+    search :: Partial => String -> Array (Tuple Int (Array Int))
+    search str = if strLen < hLen then []
+                                  else A.fromFoldable (go 0 shash)
+          where
+            strLen = S.length str
+            maxIdx = strLen - hLen
+            arr = S.toCodePointArray str
+            strAt i = A.unsafeIndex arr i
+            shash = hash str
+            go sI h =
+              case M.lookup h hashMap of
+                Nothing ->
+                  if sI == maxIdx
+                    then L.Nil
+                    else go (sI + 1) (rehash h (strAt sI) (strAt (sI + hLen)))
+                Just ps ->
+                  let rst = S.drop sI str
+                      hd  = strAt sI
+                      more = if sI == maxIdx then L.Nil else
+                                go (sI + 1) (rehash h hd (strAt (sI + hLen)))
+                      okay bs =
+                        isJust (S.stripPrefix (S.Pattern bs) rst)
+                  in case A.filter (\x -> okay (A.unsafeIndex pats x)) ps of
+                           [] -> more
+                           qs -> Tuple sI qs L.: more

test/Gargantext/Utils/KarpRabin/Spec.purs

+module Gargantext.Utils.KarpRabin.Spec where
+
+import Prelude
+import Data.Array (index)
+import Data.Foldable (all)
+import Data.Maybe (Maybe(..), isJust)
+import Data.String (drop, stripPrefix, Pattern(..))
+import Data.Tuple (Tuple(..))
+import Gargantext.Utils.KarpRabin (indicesOfAny)
+-- import Test.QuickCheck ((===), (/==), (<?>), Result(..))
+import Test.Spec (Spec, describe, it)
+import Test.Spec.Assertions (shouldEqual)
+import Test.Spec.QuickCheck (quickCheck')
+
+validIndices :: Array String -> String -> Boolean
+validIndices pats input = all validIndex (indicesOfAny pats input)
+  where
+    validIndex (Tuple i ps) = all validPat ps
+      where
+        input' = drop i input
+        validPat p =
+          case index pats p of
+            Just pat -> isJust (stripPrefix (Pattern pat) input')
+                        -- <?> (show input' <> " should start with " <> show pat)
+            Nothing  -> false -- Failed "out of bounds pattern"
+
+spec :: Spec Unit
+spec =
+  describe "KarpRabin" do
+    it "works on a single pattern matching two times" do
+      let pats   = ["ab"]
+      let input  = "abcbab"
+      let output = [Tuple 0 [0], Tuple 4 [0]]
+      indicesOfAny pats input `shouldEqual` output
+
+    it "works on a many unmatching patterns" do
+      let pats   = ["abd","e","bac","abcbabe"]
+      let input  = "abcbab"
+      let output = []
+      indicesOfAny pats input `shouldEqual` output
+
+    it "works on a simple case" do
+      let pats   = ["ab","cb","bc","bca"]
+      let input  = "abcbab"
+      let output = [Tuple 0 [0]
+                   ,Tuple 1 [2]
+                   ,Tuple 2 [1]
+                   ,Tuple 4 [0]
+                   ]
+      indicesOfAny pats input `shouldEqual` output
+
+    it "works with overlaps" do
+      let pats   = ["aba"]
+      let input  = "ababa"
+      let output = [Tuple 0 [0]
+                   ,Tuple 2 [0]
+                   ]
+      indicesOfAny pats input `shouldEqual` output
+
+    it "returns valid indices" do
+      validIndices ["a","ab","ba","abc","aba","abab","abcde"]
+                   "ababarbabacbbababcaccacabbababa"
+          `shouldEqual` true
+
+    it "returns valid indices 2000 random samples" do
+      quickCheck' 2000 validIndices

test/Main.purs

 module Test.Main where
 
 import Prelude
---import Control.Monad.Eff (Eff)
---import Control.Monad.Eff.Console (CONSOLE, log)
+import Effect (Effect)
+import Test.Spec.Discovery (discover)
+import Test.Spec.Reporter.Console (consoleReporter)
+import Test.Spec.Runner (run)
 
---main :: forall e. Eff (console :: CONSOLE | e) Unit
---main = do
---  log "You should add some tests."
+main :: Effect Unit
+main = discover "Gargantext\\..*Spec" >>= run [consoleReporter]