Spec.purs 6.93 KB
Newer Older
1 2 3
module Gargantext.Components.NgramsTable.Spec where

import Prelude
4
import Data.List as L
5
import Data.Maybe (Maybe(..))
6 7
import Data.Map as Map
import Data.Set as Set
8 9
import Data.Tuple (Tuple(..))
import Test.Spec (Spec, describe, it)
10
-- import Test.Spec.Assertions (shouldEqual)
11 12
-- import Test.Spec.QuickCheck (quickCheck')

13 14 15
import Test.Utils (shouldEqualArray)

import Gargantext.Components.NgramsTable.Core (highlightNgrams, HighlightElement, NgramsElement(..), NgramsRepoElement(..), NgramsTable(..), NgramsTerm, normNgram)
16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48
import Gargantext.Types (CTabNgramType(..), TermList(..))


ne :: String -> TermList -> CTabNgramType -> NgramsElement
ne ngrams list ngramType = NgramsElement { ngrams: normed
                                         , size: 1  -- TODO
                                         , list
                                         , occurrences: 0
                                         , parent:   Nothing
                                         , root:     Nothing
                                         , children: Set.empty
                                         }
  where
    normed = normNgram ngramType ngrams

tne :: String -> TermList -> CTabNgramType -> Tuple NgramsTerm NgramsElement
tne ngrams list ngramType = Tuple normed (ne ngrams list ngramType)
  where
    normed = normNgram ngramType ngrams

nre :: String -> TermList -> CTabNgramType -> NgramsRepoElement
nre ngrams list ngramType = NgramsRepoElement { size: 1  -- TODO
                                              , list
                                              , parent:   Nothing
                                              , root:     Nothing
                                              , children: Set.empty
                                              }

tnre :: String -> TermList -> CTabNgramType -> Tuple NgramsTerm NgramsRepoElement
tnre ngrams list ngramType = Tuple normed (nre ngrams list ngramType)
  where
    normed = normNgram ngramType ngrams

49 50 51 52 53 54 55 56 57
highlightNil :: String -> HighlightElement
highlightNil s = Tuple s L.Nil

highlightTuple :: String -> CTabNgramType -> TermList -> Tuple NgramsTerm TermList
highlightTuple s ngramType term = Tuple (normNgram ngramType s) term

highlightSingleton :: String -> CTabNgramType -> TermList -> HighlightElement
highlightSingleton s ngramType term = Tuple s (L.singleton $ highlightTuple s ngramType term)

58
spec :: Spec Unit
59
spec = do
60
  describe "NgramsTable.highlightNgrams" do
61
    it "works on a simple example" do
62
      let ngramType = CTabSources
63
      let table = NgramsTable
64 65 66 67 68
                   { ngrams_repo_elements: Map.fromFoldable [ tnre "which"     StopTerm ngramType
                                                            , tnre "stops"     StopTerm ngramType
                                                            , tnre "candidate" CandidateTerm ngramType
                                                            ]
                   , ngrams_scores: Map.fromFoldable [] }
69
          input = "this is a graph about a biography which stops at every candidate"
70 71 72 73 74 75 76
          output = [ highlightNil " this is a graph about a biography "
                   , highlightSingleton " which" ngramType StopTerm
                   , highlightNil " "
                   , highlightSingleton " stops" ngramType StopTerm
                   , highlightNil " at every "
                   , highlightSingleton " candidate" ngramType CandidateTerm
                   , highlightNil " "
77
                   ]
78
      highlightNgrams CTabTerms table input `shouldEqualArray` output
79 80

    it "works when pattern overlaps" do
81
      let ngramType = CTabSources
82
      let table = NgramsTable
83 84 85 86 87
                    { ngrams_repo_elements: Map.fromFoldable [ tnre "is"     StopTerm ngramType
                                                             , tnre "a"      StopTerm ngramType
                                                             , tnre "of"     StopTerm ngramType
                                                             ]
                    , ngrams_scores: Map.fromFoldable [] }
88
          input = "This is a new state of the"
89 90 91 92 93 94 95
          output = [ highlightNil " This "
                   , highlightSingleton " is" ngramType StopTerm
                   , highlightNil " "
                   , highlightSingleton " a" ngramType StopTerm
                   , highlightNil " new state "
                   , highlightSingleton " of" ngramType StopTerm
                   , highlightNil " the "
96
                   ]
97
      highlightNgrams CTabTerms table input `shouldEqualArray` output
98 99

    it "works when pattern overlaps 2" do
100
      let ngramType = CTabSources
101
      let table = NgramsTable
102 103 104 105 106
                    { ngrams_repo_elements: Map.fromFoldable [ tnre "from"   CandidateTerm ngramType
                                                             , tnre "i"      StopTerm ngramType
                                                             , tnre "images" CandidateTerm ngramType
                                                             ]
                    , ngrams_scores: Map.fromFoldable [] }
107
          input = "This is from space images"
108 109 110 111 112
          output = [ highlightNil " This is "
                   , highlightSingleton " from" ngramType CandidateTerm
                   , highlightNil " space "
                   , highlightSingleton " images" ngramType CandidateTerm
                   , highlightNil " "
113
                   ]
114
      highlightNgrams CTabTerms table input `shouldEqualArray` output
115 116 117 118

    it "works when pattern overlaps 3" do
      let ngramType = CTabSources
      let table = NgramsTable
119 120
                    { ngrams_repo_elements: Map.fromFoldable [ tnre "something"             CandidateTerm ngramType
                                                             , tnre "something different"   MapTerm ngramType
121 122
                                                             ]
                    , ngrams_scores: Map.fromFoldable [] }
123 124 125 126 127 128 129 130
          input = "and now for something different"
          output = [ highlightNil " and now for "
                   , Tuple " something" $ L.fromFoldable [
                         highlightTuple "something different" ngramType MapTerm
                       , highlightTuple "something" ngramType CandidateTerm
                       ]
                   , Tuple " different" $ L.singleton $ highlightTuple "something different" ngramType MapTerm
                   , highlightNil " "
131
                   ]
132
      highlightNgrams CTabTerms table input `shouldEqualArray` output
133 134

    it "works with punctuation" do
135
      let ngramType = CTabSources
136
      let table = NgramsTable
137 138
                    { ngrams_repo_elements: Map.fromFoldable [ tnre "graph" CandidateTerm ngramType ]
                    , ngrams_scores: Map.fromFoldable [] }
139
          input = "before graph, after"
140 141 142
          output = [ highlightNil " before "
                   , highlightSingleton " graph" ngramType CandidateTerm
                   , highlightNil ", after "
143
                   ]
144
      highlightNgrams CTabTerms table input `shouldEqualArray` output