diff --git a/app/Main.hs b/app/Main.hs
index 26e4f98d77effeb9da4aa17183c3e0f44313570d..4030786659f548fcd2ed6339d05e684dfbd0fbac 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,6 +1,8 @@
 module Main where
 
+--import System.Environment (getArgs)
 import Data.Gargantext.Server (startGargantext)
 
 main :: IO ()
-main = startGargantext
+--  (iniFile:_) <- getArgs
+main = startGargantext -- port iniFile
diff --git a/gargantext.cabal b/gargantext.cabal
index 8fabc3c584faf82f36ab7364264ab2789ebd88a0..0904eec34e69f12bb1993ecaf7b93f1e58cb7e71 100644
--- a/gargantext.cabal
+++ b/gargantext.cabal
@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: b579b76daf844d03881190aae30b1ef7e26436cddf446a3ef2d524ca4f122a97
+-- hash: b9bfa189420281ceb8fe8d47b1d7800acdc1f9529c864156abcbfbfea5e06dc6
 
 name:                gargantext
 version:             0.1.0.0
@@ -22,6 +22,7 @@ cabal-version:       >= 1.10
 library
   hs-source-dirs:
       src
+  default-extensions: NoImplicitPrelude
   build-depends:
       aeson
     , aeson-lens
diff --git a/package.yaml b/package.yaml
index 2d2643202415302a09a2acace70ebace2e428dd7..df231240820ce649f6ce4859c9b2f8754169439e 100644
--- a/package.yaml
+++ b/package.yaml
@@ -16,6 +16,8 @@ dependencies:
 - text
 library:
   source-dirs: src
+  default-extensions: 
+  - NoImplicitPrelude
   ghc-options:
   - -Wincomplete-uni-patterns
   - -Wincomplete-record-updates
diff --git a/src/Gargantext/Analysis.hs b/src/Gargantext/Analysis.hs
index e325c54b3497c5cd33fcb6f85ae77a88b9cea8e3..b8712dec9f090e6071a15dcf0a750f83f3a97eb1 100644
--- a/src/Gargantext/Analysis.hs
+++ b/src/Gargantext/Analysis.hs
@@ -1,5 +1,7 @@
 module Gargantext.Analysis where
 
+import Gargantext.Prelude
+
 -- import qualified Data.Text.Lazy as DTL
 import Data.Text
 import Opaleye (Column, PGInt4)
diff --git a/src/Gargantext/Database/Instances.hs b/src/Gargantext/Database/Instances.hs
index bf83160c82c8b7cb85b231c284a59f0c2d641395..bcf50b0ee8651736acdf1e684242c863606440dc 100644
--- a/src/Gargantext/Database/Instances.hs
+++ b/src/Gargantext/Database/Instances.hs
@@ -4,6 +4,8 @@
 
 module Gargantext.Database.Instances where
 
+import Gargantext.Prelude
+
 import Data.Time (UTCTime)
 import Opaleye (PGInt4, PGTimestamptz, PGFloat8
                , QueryRunnerColumnDefault
diff --git a/src/Gargantext/Ngrams/Count.hs b/src/Gargantext/Ngrams/Count.hs
index e40146a19b142d0914ccd2b7f26e337abd2c359f..e018e3203de7b9c7d3deef4460aa51ae65cabfe1 100644
--- a/src/Gargantext/Ngrams/Count.hs
+++ b/src/Gargantext/Ngrams/Count.hs
@@ -2,14 +2,15 @@
 
 module Gargantext.Ngrams.Count where
 
-import System.Environment (getArgs)
+import Gargantext.Prelude
+
 
 import Data.Foldable as F
 
 import Data.Map (Map)
 import qualified Data.Map as M
 
-import qualified Data.Text.Lazy.IO as DTLIO
+--import qualified Data.Text.Lazy.IO as DTLIO
 import qualified Data.Text.Lazy as DTL
 
 -- | /O(n)/ Breaks a 'Text' up into each Text list of chars.
@@ -36,11 +37,11 @@ occurrences xs = foldl' (\x y -> M.insertWith' (+) y 1 x) M.empty xs
 --occurrences' :: Ord a => [a] -> Map a Integer
 --occurrences' xs = DTL.foldl (\x y -> M.insertWith' (+) y 1 x) M.empty xs
 
-countMain :: IO ()
-countMain = do
-  (fichier:_) <- getArgs
-  c <- DTLIO.readFile fichier
-  --print $ occurrences $ DTL.chunksOf 1 c
-  print $ occurrences $ letters'' c
-  --print $ occurrences $ DTL.words $ DTL.toLower c
-
+--countMain :: IO ()
+--countMain = do
+--  (fichier:_) <- getArgs
+--  c <- DTLIO.readFile fichier
+--  --print $ occurrences $ DTL.chunksOf 1 c
+--  pure $ occurrences $ letters'' c
+--  --print $ occurrences $ DTL.words $ DTL.toLower c
+--
diff --git a/src/Gargantext/Ngrams/Metrics.hs b/src/Gargantext/Ngrams/Metrics.hs
index 0bdaf11dec706b4b588d034104fc2d93cac3ea89..5533d61e15ea7e50b98b1db62e9b38347fa0c566 100644
--- a/src/Gargantext/Ngrams/Metrics.hs
+++ b/src/Gargantext/Ngrams/Metrics.hs
@@ -21,6 +21,8 @@ module Gargantext.Ngrams.Metrics (levenshtein
                                       , hamming
                                       ) where
 
+import Gargantext.Prelude
+
 import Data.Text (Text)
 import GHC.Real (Ratio)
 import qualified Data.Text.Metrics as DTM
diff --git a/src/Gargantext/Ngrams/Occurrences.hs b/src/Gargantext/Ngrams/Occurrences.hs
index b0f098e2909cb800d72e82e6ab3913907ef51a9b..b279dc5926626a796440ab2977b5030731067a9c 100644
--- a/src/Gargantext/Ngrams/Occurrences.hs
+++ b/src/Gargantext/Ngrams/Occurrences.hs
@@ -2,14 +2,18 @@
 
 module Gargantext.Ngrams.Occurrences where
 
+import Gargantext.Prelude
+
+import Control.Monad ((>>),(>>=))
+import Data.String (String())
 import Data.Attoparsec.Text
 import Data.Text (Text)
 
-
 import Data.Either.Extra(Either(..))
 import qualified Data.Text as T
 import Control.Applicative
 
+
 occurrenceParser :: Text -> Parser Bool
 occurrenceParser txt = manyTill anyChar (string txt) >> pure True
 
diff --git a/src/Gargantext/Ngrams/TextMining.hs b/src/Gargantext/Ngrams/TextMining.hs
index f40a672bd0a903c47160d7b585315213c1dae1e1..ed03c50d0d8e61bda43860273162f549b346e18c 100644
--- a/src/Gargantext/Ngrams/TextMining.hs
+++ b/src/Gargantext/Ngrams/TextMining.hs
@@ -1,5 +1,10 @@
+
 module Gargantext.Ngrams.TextMining where
 
+import Gargantext.Prelude
+import Data.Ord(Ordering(LT,GT), compare)
+import Data.Text (pack)
+import Data.Bool (otherwise)
 import Data.Map (empty, Map, insertWith, toList)
 import Data.List (foldl, foldl')
 import qualified Data.List as L
@@ -9,7 +14,7 @@ sortGT (a1, b1) (a2, b2)
     | a1 < a2 = GT
     | a1 > a2 = LT
     | a1 == a2 = compare b1 b2
-sortGT (_, _) (_, _) = error "What is this case ?"
+sortGT (_, _) (_, _) = panic (pack "What is this case ?")
 
 
 --histogram :: Ord a => [a] -> [(a, Int)]
@@ -51,7 +56,3 @@ countYear (x:xs) = insertWith (+) x 1 (countYear xs)
 countYear' :: [Integer] -> Map Integer Integer
 countYear' (xs) = foldl' (\x y -> insertWith (+) y 1 x) empty xs
 
-
-textMiningMain :: IO ()
-textMiningMain = do
-    print $ merge ["abc"::String] ["bcd" :: String]
diff --git a/src/Gargantext/Parsers.hs b/src/Gargantext/Parsers.hs
index 96cf6fa9ae53e5fd84b764263c999113271bee58..0bdace34a2d2bfbf24b6c892dd3a2ce5776ae7d0 100644
--- a/src/Gargantext/Parsers.hs
+++ b/src/Gargantext/Parsers.hs
@@ -21,11 +21,15 @@ please follow the types.
 module Gargantext.Parsers -- (parse, FileFormat(..))
     where
 
-import System.FilePath (takeExtension)
+import Gargantext.Prelude
+
+import System.FilePath (takeExtension, FilePath())
 import Data.Attoparsec.ByteString (parseOnly, Parser)
 import Data.ByteString as DB
-import Data.Map                    as DM
-----import Data.Either.Extra(Either(..))
+import Data.Map        as DM
+import Data.Ord()
+import Data.String()
+import Data.Either.Extra(Either())
 ----
 --import Control.Monad (join)
 import Codec.Archive.Zip (withArchive, getEntry, getEntries)
@@ -34,7 +38,7 @@ import Path.IO (resolveFile')
 --import Control.Applicative ( (<$>) )
 import Control.Concurrent.Async as CCA (mapConcurrently)
 
-
+import Data.String (String())
 import Gargantext.Parsers.WOS (wosParser)
 ---- import Gargantext.Parsers.XML (xmlParser)
 ---- import Gargantext.Parsers.DOC (docParser)
diff --git a/src/Gargantext/Prelude.hs b/src/Gargantext/Prelude.hs
index 8f1309f0898c8a82717b5b3485cbf0925223a6f6..393cddd6a114d101a38ca04ef6db7e2e36769f7e 100644
--- a/src/Gargantext/Prelude.hs
+++ b/src/Gargantext/Prelude.hs
@@ -10,6 +10,8 @@ module Gargantext.Prelude
   ( module Gargantext.Prelude
   , module Protolude
   , headMay
+  , module Text.Show
+  , module Text.Read
   )
   where
 
@@ -22,7 +24,7 @@ import Protolude ( Bool(True, False), Int, Double, Integer
                  , sum, fromIntegral, length, fmap
                  , takeWhile, sqrt, undefined, identity
                  , abs, maximum, minimum, return, snd, truncate
-                 , (+), (*), (/), (-), (.), (>=), ($), (**), (^)
+                 , (+), (*), (/), (-), (.), (>=), ($), (**), (^), (<), (>), (==)
                  )
 
 -- TODO import functions optimized in Utils.Count
@@ -34,7 +36,8 @@ import qualified Control.Monad as M
 import qualified Data.Map as Map
 import qualified Data.Vector as V
 import Safe (headMay)
-
+import Text.Show (Show(), show)
+import Text.Read (Read())
 --pf :: (a -> Bool) -> [a] -> [a]
 --pf = filter
 
diff --git a/src/Gargantext/RCT.hs b/src/Gargantext/RCT.hs
index ee7d75899ad6713a0d6ce9ddeafc4cc8a3b0d314..4a3283e790ea5bab854df2d935a67899f75d307f 100644
--- a/src/Gargantext/RCT.hs
+++ b/src/Gargantext/RCT.hs
@@ -1,5 +1,7 @@
 module Gargantext.RCT where
 
+import Gargantext.Prelude
+
 foo :: Int
 foo = undefined
 --import Data.Text (Text, words)
diff --git a/src/Gargantext/Types/Main.hs b/src/Gargantext/Types/Main.hs
index f6f5160fdec96a7a9db9c099f0ce8bb8c124cf1f..7045697e616771226db4e86a6617f2ccf8e8d3cd 100644
--- a/src/Gargantext/Types/Main.hs
+++ b/src/Gargantext/Types/Main.hs
@@ -1,15 +1,29 @@
--- | CNRS Copyrights
--- Licence: https://gitlab.iscpif.fr/humanities/gargantext/blob/stable/LICENSE
--- Author: Alexandre Delanoë (alexandre.delanoe@iscpif.fr)
+{-|
+Module      : .Gargantext.Types.Main
+Description : Short description
+Copyright   : (c) CNRS, 2017
+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 FlexibleInstances #-}
 
 module Gargantext.Types.Main where
 
+import Prelude
+
+import Data.Eq (Eq())
 import Data.Monoid ((<>))
 import Protolude (fromMaybe)
 
 --import Data.ByteString (ByteString())
 import Data.Text (Text)
 import Data.Time (UTCTime)
+import Data.List (lookup)
 import Gargantext.Types.Node ( NodePoly, HyperdataUser
                                , HyperdataFolder   , HyperdataCorpus   , HyperdataDocument
                                , HyperdataFavorites, HyperdataResource
@@ -171,13 +185,14 @@ nodeTypes = [ (NodeUser      ,  1)
             ]
 --
 nodeTypeId :: NodeType -> NodeTypeId
-nodeTypeId tn = fromMaybe (error ("Typename " ++ show tn ++ " does not exist")) (lookup tn nodeTypes)
+nodeTypeId tn = fromMaybe (error $ "Typename " <> show tn <> " does not exist")
+                          (lookup tn nodeTypes)
 
 
 
 -- Temporary types to be removed
 type Ngrams = (Text, Text, Text)
-type ErrorMessage = String
+type ErrorMessage = Text
 
 
 
diff --git a/src/Gargantext/Types/Node.hs b/src/Gargantext/Types/Node.hs
index 4e0f535f34bbf766d425015f387b415ed44f5050..3f069d7163e9b39e4091734db1be64090ee9f474 100644
--- a/src/Gargantext/Types/Node.hs
+++ b/src/Gargantext/Types/Node.hs
@@ -4,6 +4,9 @@
 
 module Gargantext.Types.Node where
 
+import Gargantext.Prelude
+
+import Text.Show (Show())
 import Data.Text (Text)
 import GHC.Generics (Generic)
 import Data.Time (UTCTime)
diff --git a/src/Gargantext/Utils/DateUtils.hs b/src/Gargantext/Utils/DateUtils.hs
index 2c1801ab67b302d5069aa720f63731f432e88fcc..bf5943b06ea88b61866edebf6bfa3d69025c74d9 100644
--- a/src/Gargantext/Utils/DateUtils.hs
+++ b/src/Gargantext/Utils/DateUtils.hs
@@ -1,5 +1,6 @@
 module Gargantext.Utils.DateUtils where
 
+import Gargantext.Prelude
 import Data.Time (UTCTime, toGregorian, utctDay)
 
 --
@@ -26,5 +27,3 @@ averageLength l = fromIntegral (sum (map length l)) / fromIntegral (length l)
 --	c <- getCurrentTime
 --	print c -- $ toYear $ toGregorian $ utctDay c
 
-charToString :: Char -> String
-charToString = (:[])
diff --git a/src/Gargantext/Utils/Prefix.hs b/src/Gargantext/Utils/Prefix.hs
index 3bd6fff83520381546b599474db377e0972cbdcd..d252348952827ab0894b827db4f9f1be77a81a22 100644
--- a/src/Gargantext/Utils/Prefix.hs
+++ b/src/Gargantext/Utils/Prefix.hs
@@ -1,11 +1,14 @@
+
 module Gargantext.Utils.Prefix where
 
+import Prelude
+
 import Data.Aeson (Value, defaultOptions, parseJSON)
 import Data.Aeson.TH (Options, fieldLabelModifier, omitNothingFields)
 import Data.Aeson.Types (Parser)
 import Data.Char (toLower)
 import Data.Monoid ((<>))
-import Text.Read (readMaybe)
+import Text.Read (Read(..),readMaybe)
 
 
 -- | Aeson Options that remove the prefix from fields
@@ -24,13 +27,13 @@ unCapitalize (c:cs) = toLower c : cs
 dropPrefix :: String -> String -> String
 dropPrefix prefix input = go prefix input
   where
-    go pre [] = error $ contextual $ "prefix leftover: " <> pre
+    go pre [] = error $ conStringual $ "prefix leftover: " <> pre
     go [] (c:cs) = c : cs
     go (p:preRest) (c:cRest)
       | p == c = go preRest cRest
-      | otherwise = error $ contextual $ "not equal: " <>  (p:preRest)  <> " " <> (c:cRest)
+      | otherwise = error $ conStringual $ "not equal: " <>  (p:preRest)  <> " " <> (c:cRest)
 
-    contextual msg = "dropPrefix: " <> msg <> ". " <> prefix <> " " <> input
+    conStringual msg = "dropPrefix: " <> msg <> ". " <> prefix <> " " <> input
 
 parseJSONFromString :: (Read a) => Value -> Parser a
 parseJSONFromString v = do