diff --git a/package.yaml b/package.yaml index 776928a09b0ad95b76192e76839590cbf533a92b..a97d27574b8920acc6f330f0dafbbd2814aa886e 100644 --- a/package.yaml +++ b/package.yaml @@ -149,6 +149,8 @@ tests: garg-test: main: Main.hs source-dirs: src-test + default-extensions: + - NoImplicitPrelude ghc-options: - -threaded - -rtsopts diff --git a/src-test/Main.hs b/src-test/Main.hs index 66e33f604ff2d85b68b38676193bdc6a4be54540..1df5be16689a4c803de5c91be634ac4a057b7d4a 100644 --- a/src-test/Main.hs +++ b/src-test/Main.hs @@ -1,3 +1,14 @@ +{-| +Module : Main.hs +Description : Main for Gargantext Tests +Copyright : (c) CNRS, 2017-Present +License : AGPL + CECILL v3 +Maintainer : team@gargantext.org +Stability : experimental +Portability : POSIX +-} + +import Gargantext.Prelude import Gargantext.Types.Main (Language(..)) --import qualified Ngrams.Lang.Fr as Fr import qualified Ngrams.Lang as Lang diff --git a/src-test/Ngrams/Lang.hs b/src-test/Ngrams/Lang.hs index 9e4e6401581b595f2781e7747c55604f5f2b3863..3faa4c9ff1392db3130a23ff7e93f62cd038a8bc 100644 --- a/src-test/Ngrams/Lang.hs +++ b/src-test/Ngrams/Lang.hs @@ -1,5 +1,6 @@ module Ngrams.Lang where +import Gargantext.Prelude (IO()) import Gargantext.Types.Main (Language(..)) import qualified Ngrams.Lang.Fr as Fr diff --git a/src-test/Ngrams/Lang/En.hs b/src-test/Ngrams/Lang/En.hs index dd38148fd4144fb78255ff1bc2cba327cacf2e5f..637b67d11586463f1acef41fb1eae088310e469e 100644 --- a/src-test/Ngrams/Lang/En.hs +++ b/src-test/Ngrams/Lang/En.hs @@ -4,14 +4,15 @@ 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 Data.Text (Text(..)) -import Data.List ((!!)) ngramsExtractionTest :: IO () ngramsExtractionTest = hspec $ do diff --git a/src-test/Ngrams/Lang/Occurrences.hs b/src-test/Ngrams/Lang/Occurrences.hs index 1dfa5d4ab4f022e4651517df192f87dd03b6244e..b9d59a195ede3ec30e661f8b28418df97f64f755 100644 --- a/src-test/Ngrams/Lang/Occurrences.hs +++ b/src-test/Ngrams/Lang/Occurrences.hs @@ -4,18 +4,13 @@ module Ngrams.Lang.Occurrences where import Test.Hspec -import Control.Exception (evaluate) - -import Data.Text (Text) +import Data.Either (Either(Right)) import Gargantext.Prelude -import Gargantext.Types.Main (Language(..)) -import Gargantext.Ngrams import Gargantext.Ngrams.Occurrences (parseOccurrences) -import Gargantext.Ngrams.Parser (extractNgrams, selectNgrams) - +parsersTest :: IO () parsersTest = hspec $ do describe "Parser for occurrences" $ do diff --git a/src-test/Ngrams/Metrics.hs b/src-test/Ngrams/Metrics.hs index ec10e294a3dcc9e78b94931675aae9aca86b9a7e..5e5f3bb563059da1df30536d243e273937b483f4 100644 --- a/src-test/Ngrams/Metrics.hs +++ b/src-test/Ngrams/Metrics.hs @@ -4,12 +4,15 @@ module Ngrams.Metrics (main) where -import Gargantext.Ngrams.Metrics -import Data.Ratio -import Data.Text (Text) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Ratio + import Test.Hspec import Test.QuickCheck -import qualified Data.Text as T + +import Gargantext.Prelude +import Gargantext.Ngrams.Metrics #if !MIN_VERSION_base(4,8,0) import Control.Applicative @@ -121,5 +124,5 @@ testPair :: (Eq a, Show a) -> Text -- ^ Second input -> a -- ^ Expected result -> SpecWith () -testPair f a b r = it ("‘" ++ T.unpack a ++ "’ and ‘" ++ T.unpack b ++ "’") $ +testPair f a b r = it ("‘" <> T.unpack a <> "’ and ‘" <> T.unpack b <> "’") $ f a b `shouldBe` r diff --git a/src-test/Parsers/Date.hs b/src-test/Parsers/Date.hs index e79ae272b4d23296e8de5b6474e60867d96b2c59..9246d8e870921d86592b09fc9f82b20eb3ad99ac 100644 --- a/src-test/Parsers/Date.hs +++ b/src-test/Parsers/Date.hs @@ -9,7 +9,6 @@ import Test.QuickCheck import Parsers.Types import Control.Applicative ((<*>)) -import Data.Tuple (uncurry) import Data.Either (Either(..)) import Data.Time (ZonedTime(..)) import Data.Text (pack, Text) diff --git a/src-test/Parsers/Types.hs b/src-test/Parsers/Types.hs index fb63d85eadd91b110d89abfc03edf42c2fa95c71..c60e22b3e67148a0a946af7f8d4b0bdfda7a6d40 100644 --- a/src-test/Parsers/Types.hs +++ b/src-test/Parsers/Types.hs @@ -1,10 +1,10 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE StandaloneDeriving #-} module Parsers.Types where import Gargantext.Prelude -import Prelude (floor, fromIntegral) import Test.QuickCheck import Test.QuickCheck.Instances () @@ -18,7 +18,7 @@ import Data.Either (Either(..)) deriving instance Eq ZonedTime looseTimeOfDayPrecision :: TimeOfDay -> TimeOfDay -looseTimeOfDayPrecision (TimeOfDay h m s) = TimeOfDay h m 0 +looseTimeOfDayPrecision (TimeOfDay h m _) = TimeOfDay h m 0 looseLocalTimePrecision :: LocalTime -> LocalTime looseLocalTimePrecision (LocalTime ld ltd) = LocalTime ld $ looseTimeOfDayPrecision ltd diff --git a/src/Gargantext/Analysis.hs b/src/Gargantext/Analysis.hs index b8712dec9f090e6071a15dcf0a750f83f3a97eb1..64cd4e9880e928e262d8e910dcf753900880a459 100644 --- a/src/Gargantext/Analysis.hs +++ b/src/Gargantext/Analysis.hs @@ -1,6 +1,20 @@ -module Gargantext.Analysis where +{-| +Module : Gargantext.Analysis +Description : Gargantext Analysis +Copyright : (c) CNRS, 2017-Present +License : AGPL + CECILL v3 +Maintainer : team@gargantext.org +Stability : experimental +Portability : POSIX +-} -import Gargantext.Prelude +{-# LANGUAGE NoImplicitPrelude #-} + + +module Gargantext.Analysis + where + +import Gargantext.Prelude (undefined, IO(), Int()) -- import qualified Data.Text.Lazy as DTL import Data.Text diff --git a/src/Gargantext/Ngrams/TextMining.hs b/src/Gargantext/Ngrams/TextMining.hs index ed03c50d0d8e61bda43860273162f549b346e18c..55c660f8b94708b5882d107cefdb054b11665e92 100644 --- a/src/Gargantext/Ngrams/TextMining.hs +++ b/src/Gargantext/Ngrams/TextMining.hs @@ -46,7 +46,7 @@ average x = L.sum x / L.genericLength x average' :: [Int] -> Double average' x = (L.sum y) / (L.genericLength y) where - y = map fromIntegral x + y = L.map fromIntegral x countYear :: [Integer] -> Map Integer Integer diff --git a/src/Gargantext/Prelude.hs b/src/Gargantext/Prelude.hs index f824015946eade47408780eaed81f408a7b82507..60ec0036739cdacc7af2d00c82d4bf2bcd109d9d 100644 --- a/src/Gargantext/Prelude.hs +++ b/src/Gargantext/Prelude.hs @@ -24,7 +24,8 @@ import Protolude ( Bool(True, False), Int, Double, Integer , sum, fromIntegral, length, fmap , takeWhile, sqrt, undefined, identity , abs, maximum, minimum, return, snd, truncate - , (+), (*), (/), (-), (.), (>=), ($), (**), (^), (<), (>), (==), (<>) + , (+), (*), (/), (-), (.), (>=), ($), (**), (^), (<), (>) + , Eq, (==), (<>) , (&&), (||), not , toS ) diff --git a/src/Gargantext/RCT.hs b/src/Gargantext/RCT.hs index 4a3283e790ea5bab854df2d935a67899f75d307f..41893f3320b88be1ea9615d1d8d9bf23359b0645 100644 --- a/src/Gargantext/RCT.hs +++ b/src/Gargantext/RCT.hs @@ -1,3 +1,16 @@ +{-| +Module : Gargantext. +Description : +Copyright : (c) CNRS, 2017-Present +License : AGPL + CECILL v3 +Maintainer : team@gargantext.org +Stability : experimental +Portability : POSIX + +-} + +{-# LANGUAGE NoImplicitPrelude #-} + module Gargantext.RCT where import Gargantext.Prelude @@ -51,4 +64,3 @@ foo = undefined -- forms = words - diff --git a/src/Gargantext/Types/Main.hs b/src/Gargantext/Types/Main.hs index 162f6387253c4b811fc06ca36d0c9d69bdc5e6a6..aa46296203d66025c8d739742fb85e6c26244a77 100644 --- a/src/Gargantext/Types/Main.hs +++ b/src/Gargantext/Types/Main.hs @@ -21,22 +21,21 @@ commentary with @some markup@. module Gargantext.Types.Main where ------------------------------------------------------------------------ -import Prelude -import Protolude (fromMaybe) - +import Data.Maybe (fromMaybe) import Data.Eq (Eq()) import Data.Monoid ((<>)) -import Data.Text (Text) +import Data.Text (Text, pack) import Data.List (lookup) import Gargantext.Types.Node +import Gargantext.Prelude ------------------------------------------------------------------------ ------------------------------------------------------------------------ - -- | Language of a Text -- For simplicity, we suppose text has an homogenous language -data Language = EN | FR -- | DE | IT | SP +data Language = EN | FR + -- | DE | IT | SP -- > EN == english -- > FR == french -- > DE == deutch (not implemented yet) @@ -44,11 +43,9 @@ data Language = EN | FR -- | DE | IT | SP -- > SP == spanish (not implemented yet) -- > ... add your language and help us to implement it (: - -- All the Database is structred like a hierarchical Tree data Tree a = NodeT a [Tree a] - deriving (Show, Read, Eq) - + deriving (Show, Read, Eq) -- data Tree a = NodeT a [Tree a] -- same as Data.Tree @@ -161,19 +158,16 @@ nodeTypes = [ (NodeUser , 1) ] -- nodeTypeId :: NodeType -> NodeTypeId -nodeTypeId tn = fromMaybe (error $ "Typename " <> show tn <> " does not exist") +nodeTypeId tn = fromMaybe (panic $ pack $ "Typename " <> show tn <> " does not exist") (lookup tn nodeTypes) - - -- Temporary types to be removed -type Ngrams = (Text, Text, Text) +type Ngrams = (Text, Text, Text) type ErrorMessage = Text -- Queries type ParentId = NodeId type Limit = Int -type Offset = Int - +type Offset = Int diff --git a/src/Gargantext/Utils/DateUtils.hs b/src/Gargantext/Utils/DateUtils.hs index bf5943b06ea88b61866edebf6bfa3d69025c74d9..792f576888b4dbbf181e27d290397e4b2bcc85df 100644 --- a/src/Gargantext/Utils/DateUtils.hs +++ b/src/Gargantext/Utils/DateUtils.hs @@ -1,3 +1,15 @@ +{-| +Module : Gargantext. +Description : +Copyright : (c) CNRS, 2017-Present +License : AGPL + CECILL v3 +Maintainer : team@gargantext.org +Stability : experimental +Portability : POSIX +-} + +{-# LANGUAGE NoImplicitPrelude #-} + module Gargantext.Utils.DateUtils where import Gargantext.Prelude