[DOC] adding a file for examples, text ngrams extraction and some metrics (begin).
[gargantext.git] / src-test / Ngrams / Lang / Fr.hs
index ba03a101d5d53f0b7d41618cd30da9e61f0f8257..c8df545dfb49187b81583e9a3fb46d505fec5386 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   #-}
@@ -7,8 +20,8 @@ module Ngrams.Lang.Fr where
 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 ()
 ngramsExtractionTest = hspec $ do
@@ -32,7 +45,7 @@ ngramsExtractionTest = hspec $ do
         it "Groupe : nom commun et adjectifs avec conjonction" $ do
             let textFr = "Le livre blanc et rouge."
             testFr <- map (selectNgrams FR) <$> (extractNgrams FR) textFr
-            testFr `shouldBe` [[("livre blanc","N","O"),("livre rouge","N","O")]]
+            testFr `shouldBe` [[("livre blanc","NC","O"),("livre rouge","NC","O")]]
                 -- `shouldBe` [[("livre blanc et rouge","N","O")]] ?
 
         it "Groupe: Nom commun + préposition + Nom commun" $ do