-{-# LANGUAGE OverloadedStrings #-}
+{-|
+Module : Ngrams.Lang
+Description :
+Copyright : (c) CNRS, 2017-Present
+License : AGPL + CECILL v3
+Maintainer : team@gargantext.org
+Stability : experimental
+Portability : POSIX
+
+Here is a longer description of this module, containing some
+commentary with @some markup@.
+-}
+
{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE NoImplicitPrelude #-}
module Ngrams.Lang.En where
+{-
+import Data.List ((!!))
+import Data.Text (Text)
+
import Test.Hspec
import Gargantext.Prelude
-import Gargantext.Types.Main (Language(..))
-import Gargantext.Ngrams.Parser (extractNgrams, selectNgrams)
+import Gargantext.Core (Lang(..))
-import Data.Text (Text(..))
-import Data.List ((!!))
+-- TODO this import is not used anymore
+import Gargantext.Text.Ngrams.PosTagging.Parser (extractNgrams, selectNgrams)
+-- use instead
+-- import Gargantext.Text.Terms (extractNgramsT)
ngramsExtractionTest :: IO ()
ngramsExtractionTest = hspec $ do
it "\"Of\" seperates two ngrams" $ do
t1 <- map (selectNgrams EN) <$> extractNgrams EN (textTest !! 0)
- t1 `shouldBe` [[("Alcoholic extract of Kaempferia galanga","NN","O"),("analgesic activities","NN+CC","O"),("antiinflammatory activities","NN+CC","O"),("animal models","NN","O")]]
+ t1 `shouldBe` [[("Alcoholic extract of Kaempferia galanga","NN","LOCATION"),("analgesic activities","NN+CC","O"),("antiinflammatory activities","NN+CC","O"),("animal models","NN","O")]]
it "Tests the conjunction of coordination in two ngrams with its adjectives" $ do
t2 <- map (selectNgrams EN) <$> extractNgrams EN (textTest !! 2)
t2 <- map (selectNgrams EN) <$> extractNgrams EN t
t2 `shouldBe` [[("Donald Trump","NNP","PERSON"),("president of the United-States of America","NN","LOCATION")]]
-
-
-
-
-
-
-
+-}