[Phylo] Example Phylo' type.
[gargantext.git] / src-test / Ngrams / Lang / En.hs
index 637b67d11586463f1acef41fb1eae088310e469e..96b70ecd336b7ae9b85327b7a6c2417f47213841 100644 (file)
@@ -1,3 +1,16 @@
+{-|
+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 OverloadedStrings   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE NoImplicitPrelude   #-}
@@ -10,8 +23,8 @@ 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 Gargantext.Text.Ngrams.PosTagging.Parser (extractNgrams, selectNgrams)
 
 
 ngramsExtractionTest :: IO ()
@@ -21,7 +34,7 @@ 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) 
@@ -33,9 +46,3 @@ ngramsExtractionTest = hspec $ do
             t2 `shouldBe` [[("Donald Trump","NNP","PERSON"),("president of the United-States of America","NN","LOCATION")]]
 
 
-
-
-
-
-
-