Merge branch 'dev' of ssh://gitlab.iscpif.fr:20022/gargantext/haskell-gargantext into dev

devops/docker/Dockerfile

-from fpco/stack-build:lts-16.26
+from fpco/stack-build:lts-17.10
 
 RUN apt-get update && \
     apt-get install -y git libigraph0-dev && \
     rm -rf /var/lib/apt/lists/*
 
-RUN mkdir -v /deps && \
-    cd /deps && \
-    git clone https://gitlab.iscpif.fr/gargantext/clustering-louvain-cplusplus && \
-    cd clustering-louvain-cplusplus && \
-    ./install

package.yaml

 name: gargantext
-version: '0.0.2.9.2'
+version: '0.0.2.9.3'
 synopsis: Search, map, share
 description: Please see README.md
 category: Data
@@ -66,7 +66,7 @@ library:
   - Gargantext.Database.Admin.Types.Node
   - Gargantext.Prelude
   - Gargantext.Prelude.Crypto.Pass.User
-  - Gargantext.Prelude.Utils
+  - Gargantext.Prelude.GargDB
   - Gargantext.Core.Text
   - Gargantext.Core.Text.Context
   - Gargantext.Core.Text.Corpus.Parsers

src/Gargantext/API/Ngrams.hs

@@ -88,56 +88,51 @@ import Control.Concurrent
 import Control.Lens ((.~), view, (^.), (^..), (+~), (%~), (.~), sumOf, at, _Just, Each(..), (%%~), mapped, ifolded, withIndex)
 import Control.Monad.Reader
 import Data.Aeson hiding ((.=))
-import qualified Data.Aeson.Text as DAT
 import Data.Either (Either(..))
 import Data.Foldable
-import qualified Data.List as List
 import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as Map
-import qualified Data.Map.Strict.Patch as PM
 import Data.Maybe (fromMaybe)
 import Data.Monoid
 import Data.Ord (Down(..))
 import Data.Patch.Class (Action(act), Transformable(..), ours)
-import qualified Data.Set as S
-import qualified Data.Set as Set
 import Data.Swagger hiding (version, patch)
 import Data.Text (Text, isInfixOf, unpack)
 import Data.Text.Lazy.IO as DTL
 import Formatting (hprint, int, (%))
-import Formatting.Clock (timeSpecs)
 import GHC.Generics (Generic)
-import Servant hiding (Patch)
-import System.Clock (getTime, TimeSpec, Clock(..))
-import Servant.Job.Async (JobFunction(..), serveJobsAPI)
-import System.IO (stderr)
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
-
-import Prelude (error)
-import Gargantext.Prelude hiding (log)
-
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Types (HasSettings)
-import qualified Gargantext.API.Metrics as Metrics
 import Gargantext.API.Ngrams.Types
 import Gargantext.API.Prelude
 import Gargantext.Core.Types (ListType(..), NodeId, ListId, DocId, Limit, Offset, TODO, assertValid)
 import Gargantext.Core.Utils (something)
--- import Gargantext.Core.Viz.Graph.API (recomputeGraph)
--- import Gargantext.Core.Viz.Graph.Distances (Distance(Conditional))
 import Gargantext.Database.Action.Flow.Types
 import Gargantext.Database.Action.Metrics.NgramsByNode (getOccByNgramsOnlyFast')
 import Gargantext.Database.Admin.Config (userMaster)
 import Gargantext.Database.Admin.Types.Node (NodeType(..))
 import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
-import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
-import Gargantext.Database.Query.Table.Node.Select
 import Gargantext.Database.Query.Table.Ngrams hiding (NgramsType(..), ngramsType, ngrams_terms)
-import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
 import Gargantext.Database.Query.Table.Node (getNode)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
+import Gargantext.Database.Query.Table.Node.Select
 import Gargantext.Database.Schema.Node (node_id, node_parentId, node_userId)
+import Gargantext.Prelude hiding (log)
 import Gargantext.Prelude.Job
+import Gargantext.Prelude.Clock (hasTime, getTime)
+import Prelude (error)
+import Servant hiding (Patch)
+import Servant.Job.Async (JobFunction(..), serveJobsAPI)
+import System.IO (stderr)
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+import qualified Data.Aeson.Text as DAT
+import qualified Data.List as List
+import qualified Data.Map.Strict as Map
+import qualified Data.Map.Strict.Patch as PM
+import qualified Data.Set as S
+import qualified Data.Set as Set
+import qualified Gargantext.API.Metrics as Metrics
+import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
 
 {-
 -- TODO sequences of modifications (Patchs)
@@ -476,9 +471,6 @@ type MaxSize = Int
 -- | Table of Ngrams is a ListNgrams formatted (sorted and/or cut).
 -- TODO: should take only one ListId
 
-getTime' :: MonadBase IO m => m TimeSpec
-getTime' = liftBase $ getTime ProcessCPUTime
-
 
 getTableNgrams :: forall env err m.
                   (RepoCmdM env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
@@ -492,7 +484,7 @@ getTableNgrams :: forall env err m.
 getTableNgrams _nType nId tabType listId limit_ offset
                listType minSize maxSize orderBy searchQuery = do
 
-  t0 <- getTime'
+  t0 <- getTime
   -- lIds <- selectNodesWithUsername NodeList userMaster
   let
     ngramsType = ngramsTypeFromTabType tabType
@@ -546,14 +538,14 @@ getTableNgrams _nType nId tabType listId limit_ offset
     setScores False table = pure table
     setScores True  table = do
       let ngrams_terms = table ^.. each . ne_ngrams
-      t1 <- getTime'
+      t1 <- getTime
       occurrences <- getOccByNgramsOnlyFast' nId
                                              listId
                                             ngramsType
                                             ngrams_terms
-      t2 <- getTime'
+      t2 <- getTime
       liftBase $ hprint stderr
-        ("getTableNgrams/setScores #ngrams=" % int % " time=" % timeSpecs % "\n")
+        ("getTableNgrams/setScores #ngrams=" % int % " time=" % hasTime % "\n")
         (length ngrams_terms) t1 t2
       {-
       occurrences <- getOccByNgramsOnlySlow nType nId
@@ -574,7 +566,7 @@ getTableNgrams _nType nId tabType listId limit_ offset
 
   let scoresNeeded = needsScores orderBy
   tableMap1 <- getNgramsTableMap listId ngramsType
-  t1 <- getTime'
+  t1 <- getTime
   tableMap2 <- tableMap1 & v_data %%~ setScores scoresNeeded
                                     . Map.mapWithKey ngramsElementFromRepo
 
@@ -582,16 +574,16 @@ getTableNgrams _nType nId tabType listId limit_ offset
                                                   . filteredNodes
   let fltrCount = length $ fltr ^. v_data . _NgramsTable
 
-  t2 <- getTime'
+  t2 <- getTime
   tableMap3 <- tableMap2 & v_data %%~ fmap NgramsTable
                                     . setScores (not scoresNeeded)
                                     . selectAndPaginate
-  t3 <- getTime'
+  t3 <- getTime
   liftBase $ hprint stderr
-            ("getTableNgrams total=" % timeSpecs
-                          % " map1=" % timeSpecs
-                          % " map2=" % timeSpecs
-                          % " map3=" % timeSpecs
+            ("getTableNgrams total=" % hasTime
+                          % " map1=" % hasTime
+                          % " map2=" % hasTime
+                          % " map3=" % hasTime
                           % " sql="  % (if scoresNeeded then "map2" else "map3")
                           % "\n"
             ) t0 t3 t0 t1 t1 t2 t2 t3

src/Gargantext/API/Ngrams/List.hs

@@ -128,8 +128,5 @@ instance FromJSON WithFile where
   parseJSON = genericParseJSON $ jsonOptions "_wf_"
 instance ToJSON WithFile where
   toJSON = genericToJSON $ jsonOptions "_wf_"
-
-
 instance ToSchema WithFile where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_")
-

src/Gargantext/API/Ngrams/Prelude.hs

@@ -48,18 +48,13 @@ toTermList lt nt nl = toTermList' lt <$> Map.lookup nt nl
         (roots, children) = List.partition (\(_t, nre) -> view nre_root nre == Nothing)
                           $ List.filter (\(_t,nre) -> view nre_list nre == lt'') ns
 
-        roots'    = catMaybes
-                   $ map (\(t,nre) -> (,) <$> Just t
-                                           <*> Just (map toTerm $ unMSet 
-                                                                $ view nre_children nre
-                                                    )
-                         ) roots
+        roots'    = map (\(t,nre) -> (t, map toTerm $ unMSet $ view nre_children nre )) roots
 
         children' = catMaybes
                   $ map (\(t,nre) -> (,) <$> view nre_root nre
-                                          <*> Just (map toTerm $ [t] 
-                                                              <> (unMSet $ view nre_children nre)
-                                                   )
+                                         <*> Just (map toTerm $ [t] 
+                                                             <> (unMSet $ view nre_children nre)
+                                                  )
                         ) children 
 
 ------------------------------------------
@@ -68,4 +63,3 @@ patchMSet_toList = HM.toList . unPatchMapToHashMap . unPatchMSet
 
 unMSet :: MSet a -> [a]
 unMSet (MSet a) = Map.keys a
-

src/Gargantext/API/Ngrams/Tools.hs

@@ -91,7 +91,7 @@ filterListWithRootHashMap lt m = snd <$> HM.filter isMapTerm m
     isMapTerm (l, maybeRoot) = case maybeRoot of
       Nothing -> l == lt
       Just  r -> case HM.lookup r m of
-        Nothing -> panic $ "Garg.API.Ngrams.Tools: filterWithRoot, unknown key: " <> unNgramsTerm r
+        Nothing -> panic $ "[Garg.API.Ngrams.Tools] filterWithRoot, unknown key: " <> unNgramsTerm r
         Just  (l',_) -> l' == lt
 
 filterListWithRoot :: ListType
@@ -102,7 +102,7 @@ filterListWithRoot lt m = snd <$> HM.filter isMapTerm m
     isMapTerm (l, maybeRoot) = case maybeRoot of
       Nothing -> l == lt
       Just  r -> case HM.lookup r m of
-        Nothing -> panic $ "Garg.API.Ngrams.Tools: filterWithRoot, unknown key: " <> unNgramsTerm r
+        Nothing -> panic $ "[Garg.API.Ngrams.Tools] filterWithRoot, unknown key: " <> unNgramsTerm r
         Just  (l',_) -> l' == lt
 
 groupNodesByNgrams :: ( At root_map

src/Gargantext/API/Ngrams/Types.hs

@@ -20,39 +20,35 @@ import Data.Aeson.TH (deriveJSON)
 import Data.Either (Either(..))
 import Data.Foldable
 import Data.Hashable (Hashable)
-import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
-import qualified Data.List as List
 import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as Map
-import qualified Data.Map.Strict.Patch as PM
 import Data.Maybe (fromMaybe)
 import Data.Monoid
-import Data.Patch.Class (Replace, replace, Action(act), Group, Applicable(..), Composable(..), Transformable(..),
-                         PairPatch(..), Patched, ConflictResolution, ConflictResolutionReplace,
-                         MaybePatch(Mod), unMod, old, new)
+import Data.Patch.Class (Replace, replace, Action(act), Group, Applicable(..), Composable(..), Transformable(..),PairPatch(..), Patched, ConflictResolution, ConflictResolutionReplace,MaybePatch(Mod), unMod, old, new)
 import Data.Set (Set)
-import qualified Data.Set as Set
 import Data.String (IsString, fromString)
 import Data.Swagger hiding (version, patch)
 import Data.Text (Text, pack, strip)
 import Data.Validity
 import Database.PostgreSQL.Simple.FromField (FromField, fromField, ResultError(ConversionFailed), returnError)
 import GHC.Generics (Generic)
-import Servant hiding (Patch)
-import Servant.Job.Utils (jsonOptions)
-import System.FileLock (FileLock)
-import Test.QuickCheck (elements, frequency)
-import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
-
-import Protolude (maybeToEither)
-import Gargantext.Prelude
-
-import Gargantext.Prelude.Crypto.Hash (IsHashable(..))
 import Gargantext.Core.Text (size)
 import Gargantext.Core.Types (ListType(..), ListId, NodeId)
 import Gargantext.Core.Types (TODO)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixUntagged, unPrefixSwagger, wellNamedSchema)
 import Gargantext.Database.Prelude (fromField', CmdM', HasConnectionPool, HasConfig)
+import Gargantext.Prelude
+import Gargantext.Prelude.Crypto.Hash (IsHashable(..))
+import Protolude (maybeToEither)
+import Servant hiding (Patch)
+import Servant.Job.Utils (jsonOptions)
+import System.FileLock (FileLock)
+import Test.QuickCheck (elements, frequency)
+import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+import qualified Data.HashMap.Strict.InsOrd             as InsOrdHashMap
+import qualified Data.List                              as List
+import qualified Data.Map.Strict                        as Map
+import qualified Data.Map.Strict.Patch                  as PM
+import qualified Data.Set                               as Set
 import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
 
 ------------------------------------------------------------------------
@@ -87,9 +83,8 @@ instance ToParamSchema TabType
 instance ToJSON        TabType
 instance FromJSON      TabType
 instance ToSchema      TabType
-instance Arbitrary     TabType
-  where
-    arbitrary = elements [minBound .. maxBound]
+instance Arbitrary     TabType where
+  arbitrary = elements [minBound .. maxBound]
 instance FromJSONKey TabType where
   fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
 instance ToJSONKey TabType where
@@ -130,7 +125,6 @@ instance (ToJSONKey a, ToSchema a) => ToSchema (MSet a) where
 newtype NgramsTerm = NgramsTerm { unNgramsTerm :: Text }
   deriving (Ord, Eq, Show, Generic, ToJSONKey, ToJSON, FromJSON, Semigroup, Arbitrary, Serialise, ToSchema, Hashable)
 
-
 instance IsHashable NgramsTerm where
   hash (NgramsTerm t) = hash t
 

src/Gargantext/API/Node/Corpus/New.hs

@@ -52,7 +52,7 @@ import Gargantext.Database.Admin.Types.Node (CorpusId, NodeType(..), UserId)
 import Gargantext.Database.Query.Table.Node (getNodeWith)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Schema.Node (node_hyperdata)
-import qualified Gargantext.Prelude.Utils as GPU
+import qualified Gargantext.Prelude.GargDB as GargDB
 import qualified Gargantext.Core.Text.Corpus.API as API
 import qualified Gargantext.Core.Text.Corpus.Parsers as Parser (FileFormat(..), parseFormat)
 
@@ -330,7 +330,7 @@ addToCorpusWithFile user cid nwf@(NewWithFile _d _l fName) logStatus = do
                    , _scst_events    = Just []
                    }
 
-  fPath <- GPU.writeFile nwf
+  fPath <- GargDB.writeFile nwf
   printDebug "[addToCorpusWithFile] File saved as: " fPath
 
   uId <- getUserId user

src/Gargantext/API/Node/File.hs

@@ -6,24 +6,14 @@
 module Gargantext.API.Node.File where
 
 import Control.Lens ((^.))
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Lazy as BSL
-import qualified Data.MIME.Types as DMT
 import Data.Swagger
 import Data.Text
 import GHC.Generics (Generic)
-import qualified Network.HTTP.Media as M
-import Servant
-import Servant.Job.Async (JobFunction(..), serveJobsAPI)
-
-import Gargantext.Prelude
-import qualified Gargantext.Prelude.Utils as GPU
-
-import Gargantext.Core.Types (TODO)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Node.Types
 import Gargantext.API.Prelude
+import Gargantext.Core.Types (TODO)
 import Gargantext.Database.Action.Flow.Types
 import Gargantext.Database.Action.Node (mkNodeWithParent)
 import Gargantext.Database.Admin.Types.Hyperdata.File
@@ -31,6 +21,14 @@ import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Query.Table.Node (getNodeWith)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Schema.Node (node_hyperdata)
+import Gargantext.Prelude
+import Servant
+import Servant.Job.Async (JobFunction(..), serveJobsAPI)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as BSL
+import qualified Data.MIME.Types as DMT
+import qualified Gargantext.Prelude.GargDB as GargDB
+import qualified Network.HTTP.Media as M
 
 data RESPONSE deriving Typeable
 
@@ -49,7 +47,7 @@ fileApi uId nId = fileDownload uId nId
 
 newtype Contents = Contents BS.ByteString
 
-instance GPU.ReadFile Contents where
+instance GargDB.ReadFile Contents where
   readFile' fp = do
     c <- BS.readFile fp
     pure $ Contents c
@@ -72,7 +70,7 @@ fileDownload uId nId = do
   let (HyperdataFile { _hff_name = name'
                      , _hff_path = path }) = node ^. node_hyperdata
 
-  Contents c <- GPU.readFile $ unpack path
+  Contents c <- GargDB.readFile $ unpack path
 
   let (mMime, _) = DMT.guessType DMT.defaultmtd False $ unpack name'
       mime = case mMime of
@@ -121,7 +119,7 @@ addWithFile uId nId nwf@(NewWithFile _d _l fName) logStatus = do
                    , _scst_events    = Just []
                    }
 
-  fPath <- GPU.writeFile nwf
+  fPath <- GargDB.writeFile nwf
   printDebug "[addWithFile] File saved as: " fPath
 
   nIds <- mkNodeWithParent NodeFile (Just nId) uId fName

src/Gargantext/API/Node/New.hs

@@ -24,12 +24,6 @@ import Data.Aeson
 import Data.Swagger
 import Data.Text (Text)
 import GHC.Generics (Generic)
-import Servant
-import Servant.Job.Async
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary
-import Web.FormUrlEncoded          (FromForm)
-
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Prelude
 import Gargantext.Database.Action.Flow.Types
@@ -40,6 +34,11 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Database.Query.Table.Node.User
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude
+import Servant
+import Servant.Job.Async
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary
+import Web.FormUrlEncoded          (FromForm)
 
 ------------------------------------------------------------------------
 data PostNode = PostNode { pn_name     :: Text

src/Gargantext/API/Node/Types.hs

@@ -18,7 +18,7 @@ import Web.FormUrlEncoded          (FromForm)
 import Gargantext.Core (Lang(..){-, allLangs-})
 import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
 import Gargantext.Prelude
-import qualified Gargantext.Prelude.Utils as GPU
+import qualified Gargantext.Prelude.GargDB as GargDB
 import Gargantext.API.Node.Corpus.New.File (FileType)
 
 -------------------------------------------------------
@@ -57,7 +57,7 @@ instance ToJSON NewWithFile where
 instance ToSchema NewWithFile where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wfi_")
 
-instance GPU.SaveFile NewWithFile where
+instance GargDB.SaveFile NewWithFile where
   saveFile' fp (NewWithFile b64d _ _) = do
     let eDecoded = BSB64.decode $ TE.encodeUtf8 b64d
     case eDecoded of
@@ -65,5 +65,5 @@ instance GPU.SaveFile NewWithFile where
       Right decoded -> BS.writeFile fp decoded
     -- BS.writeFile fp $ BSB64.decodeLenient $ TE.encodeUtf8 b64d
 
---instance GPU.ReadFile NewWithFile where
+--instance GargDB.ReadFile NewWithFile where
 --  readFile' = TIO.readFile

src/Gargantext/Core/Text/Corpus/Parsers/GrandDebat.hs

@@ -27,17 +27,15 @@ module Gargantext.Core.Text.Corpus.Parsers.GrandDebat
   where
 
 import Data.Aeson (ToJSON, FromJSON)
-import qualified Data.ByteString.Lazy as DBL
-import qualified Data.JsonStream.Parser as P
 import Data.Text (Text)
-import qualified Data.Text as Text
 import GHC.Generics (Generic)
-
 import Gargantext.Core (Lang(..))
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..), ToHyperdataDocument, toHyperdataDocument)
 import Gargantext.Prelude
-import Gargantext.Prelude.Utils
-
+import Gargantext.Prelude.GargDB
+import qualified Data.ByteString.Lazy as DBL
+import qualified Data.JsonStream.Parser as P
+import qualified Data.Text as Text
 
 data GrandDebatReference = GrandDebatReference
   { id        :: !(Maybe Text)

src/Gargantext/Core/Text/Examples.hs

@@ -112,7 +112,7 @@ ex_cooc_mat :: IO (Map Label Index, Matrix Int, Matrix Double, (DAA.Vector Gener
 ex_cooc_mat = do
   m <- ex_cooc
   let (ti,_) = createIndices m
-  let mat_cooc = cooc2mat Triangular ti m
+  let mat_cooc = cooc2mat Triangle ti m
   pure ( ti
        , mat_cooc
        , incExcSpeGen_proba  mat_cooc
@@ -123,7 +123,7 @@ ex_incExcSpeGen :: IO ([(Label, Double)], [(Label, Double)])
 ex_incExcSpeGen = incExcSpeGen_sorted <$> ex_cooc
 
 incExcSpeGen_sorted :: Ord t => Map (t,t) Int -> ([(t,Double)],[(t,Double)])
-incExcSpeGen_sorted m = both ordonne (incExcSpeGen $ cooc2mat Triangular ti m)
+incExcSpeGen_sorted m = both ordonne (incExcSpeGen $ cooc2mat Triangle ti m)
   where
     (ti,fi) = createIndices m
     ordonne x = sortWith (Down . snd)

src/Gargantext/Core/Text/Learn.hs

@@ -34,7 +34,7 @@ import Data.Tuple.Extra (both)
 import qualified Data.ByteString.Lazy as BSL
 
 import Gargantext.Prelude
-import Gargantext.Prelude.Utils
+import Gargantext.Prelude.GargDB
 import Gargantext.Core (Lang(..), allLangs)
 import Gargantext.Core.Text.Terms.Mono (words)
 import Gargantext.Core.Text.Metrics.Count (occurrencesWith)

src/Gargantext/Core/Text/List/Learn.hs

@@ -28,7 +28,7 @@ import Gargantext.Core
 import Gargantext.Core.Text.Metrics.Count (occurrencesWith)
 import Gargantext.Core.Types.Main (ListType(..))
 import Gargantext.Prelude
-import Gargantext.Prelude.Utils
+import Gargantext.Prelude.GargDB
 
 ------------------------------------------------------------------------
 train :: Double -> Double -> SVM.Problem -> IO SVM.Model

src/Gargantext/Core/Text/Metrics.hs

@@ -70,7 +70,7 @@ localMetrics' m = Map.fromList $ zipWith (\(_,t) (inc,spe) -> (t, Vec.fromList [
                                           scores
   where
     (ti, fi) = createIndices m
-    (is, ss) = incExcSpeGen $ cooc2mat Triangular ti m
+    (is, ss) = incExcSpeGen $ cooc2mat Triangle ti m
     scores   = DAA.toList
              $ DAA.run
              $ DAA.zip (DAA.use is) (DAA.use ss)
@@ -82,7 +82,7 @@ scored' :: Ord t => Map (t,t) Int -> [Scored t]
 scored' m = zipWith (\(_,t) (inc,spe) -> Scored t inc spe) (Map.toList fi) scores
   where
     (ti, fi) = createIndices m
-    (is, ss) = incExcSpeGen $ cooc2mat Triangular ti m
+    (is, ss) = incExcSpeGen $ cooc2mat Triangle ti m
     scores   = DAA.toList
              $ DAA.run
              $ DAA.zip (DAA.use is) (DAA.use ss)

src/Gargantext/Core/Viz/Graph/Index.hs

@@ -60,17 +60,17 @@ cooc2mat sym ti m = map2mat sym 0 n idx
     n = M.size ti
     idx = toIndex ti m -- it is important to make sure that toIndex is ran only once.
 
-data MatrixShape = Triangular | Square
+data MatrixShape = Triangle | Square
 
 map2mat :: Elt a => MatrixShape -> a -> Int -> Map (Index, Index) a -> Matrix a
 map2mat sym def n m = A.fromFunction shape getData
   where
     getData = (\(Z :. x :. y) ->
       case sym of
-        Triangular -> fromMaybe def (M.lookup (x,y) m)
-        Square -> fromMaybe (fromMaybe def $ M.lookup (y,x) m)
-                                           $ M.lookup (x, y) m
-                                           )
+        Triangle -> fromMaybe def (M.lookup (x,y) m)
+        Square   -> fromMaybe (fromMaybe def $ M.lookup (y,x) m)
+                                             $ M.lookup (x, y) m
+                                             )
     shape   = (Z :. n :. n)
 
 mat2map :: (Elt a, Shape (Z :. Index)) =>

src/Gargantext/Core/Viz/Graph/Tools.hs

@@ -57,8 +57,8 @@ cooc2graph' distance threshold myCooc
     $ mat2map
     $ measure distance
     $ case distance of
-        Conditional    -> map2mat Triangular 0 tiSize
-        Distributional -> map2mat Square     0 tiSize
+        Conditional    -> map2mat Triangle 0 tiSize
+        Distributional -> map2mat Square   0 tiSize
     $ Map.filter (> 1) myCooc'
 
      where
@@ -85,7 +85,7 @@ cooc2graph'' distance threshold myCooc = neighbouMap
   where
     (ti, _) = createIndices myCooc
     myCooc' = toIndex ti myCooc
-    matCooc = map2mat Triangular 0 (Map.size ti) $ Map.filter (> 1) myCooc'
+    matCooc = map2mat Triangle 0 (Map.size ti) $ Map.filter (> 1) myCooc'
     distanceMat = measure distance matCooc
     neighbouMap = filterByNeighbours threshold
                 $ mat2map distanceMat
@@ -125,7 +125,7 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
     tiSize  = Map.size ti
     myCooc' = toIndex ti theMatrix
     matCooc = case distance of  -- Shape of the Matrix
-                Conditional    -> map2mat Triangular 0 tiSize
+                Conditional    -> map2mat Triangle 0 tiSize
                 Distributional -> map2mat Square     0 tiSize
             $ case distance of   -- Removing the Diagonal ?
                 Conditional     -> Map.filterWithKey (\(a,b) _ -> a /= b)

src/Gargantext/Database/Action/Delete.hs

@@ -33,7 +33,7 @@ import Gargantext.Database.Query.Table.Node (getNodeWith)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude
-import qualified Gargantext.Prelude.Utils as GPU
+import qualified Gargantext.Prelude.GargDB as GargDB
 
 ------------------------------------------------------------------------
 
@@ -53,7 +53,7 @@ deleteNode u nodeId = do
     nt | nt == toDBid NodeFile -> do
       node <- getNodeWith nodeId (Proxy :: Proxy HyperdataFile)
       let (HyperdataFile { _hff_path = path }) = node ^. node_hyperdata
-      GPU.rmFile $ unpack path
+      GargDB.rmFile $ unpack path
       N.deleteNode nodeId
     _                             -> N.deleteNode nodeId
    

src/Gargantext/Prelude/Clock.hs

+{-|
+Module      : Gargantext.Prelude.Clock
+Description : Useful Tools near Prelude of the project
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+module Gargantext.Prelude.Clock
+  where
+
+import Formatting.Clock (timeSpecs)
+import Formatting.Internal (Format(..))
+import Gargantext.Prelude
+import qualified System.Clock          as Clock (getTime, TimeSpec, Clock(..))
+
+---------------------------------------------------------------------------------
+getTime :: MonadBase IO m => m Clock.TimeSpec
+getTime = liftBase $ Clock.getTime Clock.ProcessCPUTime
+
+hasTime :: Formatting.Internal.Format r (Clock.TimeSpec -> Clock.TimeSpec -> r)
+hasTime = timeSpecs
+
+

src/Gargantext/Prelude/Crypto/Pass/User.hs

@@ -22,7 +22,7 @@ import Data.Text (Text)
 import Data.String (String)
 import Control.Monad
 import Control.Monad.Random
-import Data.List hiding (sum)
+import qualified Data.List as List
 
 -- | 2) Easy password manager imports
 import Gargantext.Prelude
@@ -35,7 +35,7 @@ import Gargantext.Prelude.Utils (shuffle)
 gargPass :: MonadRandom m => m Text
 gargPass = cs <$> gargPass' chars 33
   where
-    chars = zipWith (\\) charSets visualySimilar
+    chars = zipWith (List.\\) charSets visualySimilar
 
     charSets = [ ['a'..'z']
                , ['A'..'Z']
@@ -49,7 +49,7 @@ gargPass' :: MonadRandom m => [String] -> Int -> m String
 gargPass' charSets n = do
   parts <- getPartition n
   chars <- zipWithM replicateM parts (uniform <$> charSets)
-  shuffle' (concat chars)
+  shuffle' (List.concat chars)
   where
     getPartition n' = adjust <$> replicateM (k-1) (getRandomR (1, n' `div` k))
     k = length charSets
@@ -59,7 +59,7 @@ shuffle' :: (Eq a, MonadRandom m) => [a] -> m [a]
 shuffle' [] = pure []
 shuffle' lst = do
   x <- uniform lst
-  xs <- shuffle (delete x lst)
+  xs <- shuffle (List.delete x lst)
   return (x : xs)
 
 
@@ -84,5 +84,5 @@ getRandomIndex list = randomRIO (0, (length list - 1))
 getRandomElement :: [b] -> IO b
 getRandomElement list = do
   index <- (getRandomIndex list)
-  pure (list !! index)
+  pure (list List.!! index)
 

src/Gargantext/Prelude/GargDB.hs

+{-|
+Module      : Gargantext.Prelude.GargDB
+Description : Useful Tools near Prelude of the project
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+TODO_1: qualitative  tests (human)
+TODO_2: quantitative tests (coded)
+
+-}
+
+module Gargantext.Prelude.GargDB
+  where
+
+import Control.Exception
+import Control.Lens (view)
+import Control.Monad.Reader (MonadReader)
+import Data.Aeson (ToJSON, toJSON)
+import Data.Text (Text)
+import Data.Tuple.Extra (both)
+import GHC.IO (FilePath)
+import Gargantext.Database.Prelude (HasConfig(..))
+import Gargantext.Prelude
+import Gargantext.Prelude.Config
+import Gargantext.Prelude.Crypto.Hash
+import System.Directory (createDirectoryIfMissing)
+import System.IO.Error
+import System.Random (newStdGen)
+import qualified Data.Text             as Text
+import qualified System.Directory      as SD
+
+-------------------------------------------------------------------
+-- | Main Class to use (just declare needed functions)
+class GargDB a where
+  write :: a        -> IO ()
+  read  :: FilePath -> IO a
+
+  rm    :: (a, FilePath) -> IO ()
+  mv    :: (a, FilePath) -> FilePath -> IO ()
+
+
+-- | Why not this class too ?
+class ToJSON parameters => GargDB' parameters gargdata where
+  write' :: parameters -> gargdata -> IO ()
+  read'  :: parameters -> IO gargdata
+
+  rm'    :: gargdata -> parameters -> IO ()
+  mv'    :: gargdata -> parameters -> parameters -> IO ()
+
+-------------------------------------------------------------------
+-- | Deprecated Class, use GargDB instead
+class SaveFile a where
+  saveFile' :: FilePath -> a -> IO ()
+
+class ReadFile a where
+  readFile' :: FilePath -> IO a
+
+-------------------------------------------------------------------
+-------------------------------------------------------------------
+type GargFilePath = (FolderPath, FileName)
+-- where
+type FolderPath = FilePath
+type FileName   = FilePath
+
+           --------------------------------
+
+dataFilePath :: (ToJSON a) => a -> GargFilePath
+dataFilePath = toPath . hash . show . toJSON
+
+randomFilePath :: ( MonadReader  env m
+                  , MonadBase IO     m
+                  )
+               => m GargFilePath
+randomFilePath = do
+  (foldPath, fileName)  <- liftBase
+                         $ toPath
+                         . hash
+                         . show
+                         <$> newStdGen
+  pure (foldPath, fileName)
+
+
+-- | toPath' : how to hash text to path
+{- example of use:
+>>> toPath' (1,2) ("","helloword")
+("/he","lloword")
+
+>>> toPath' (2,2) ("","helloword")
+("/he/ll","oword")
+
+>>> toPath' (2,3) ("","helloword")
+("/hel/low","ord")
+-}
+toPath :: Text -> (FolderPath, FileName)
+toPath tx = both Text.unpack $ toPath' (2,3) ("", tx)
+
+toPath' :: (Int,Int) -> (Text,Text) -> (Text,Text)
+toPath' (n,m) (t,x) = foldl' (\tx _ -> toPath'' m tx) (t,x) [1..n]
+
+toPath'' :: Int -> (Text, Text) -> (Text, Text)
+toPath'' n (fp,fn) = (fp'',fn')
+  where
+    (fp',fn') = Text.splitAt n fn
+    fp''      = Text.intercalate "/" [fp,fp']
+
+-------------------------------------------------------------------
+type DataPath   = FilePath
+toFilePath :: FilePath -> FilePath -> FilePath
+toFilePath fp1 fp2 = fp1 <> "/" <> fp2
+
+-------------------------------------------------------------------
+
+-- | Disk operations
+-- | For example, this write file with a random filepath
+-- better use a hash of json of Type used to parameter as input 
+-- the functions
+writeFile :: ( MonadReader env m
+             , HasConfig   env
+             , MonadBase IO    m
+             , SaveFile        a
+             )
+          => a -> m FilePath
+writeFile a = do
+  dataPath <- view $ hasConfig . gc_datafilepath
+
+  (foldPath, fileName) <- randomFilePath
+
+  let filePath     = toFilePath foldPath fileName
+      dataFoldPath = toFilePath dataPath foldPath
+      dataFileName = toFilePath dataPath filePath
+
+  _ <- liftBase $ createDirectoryIfMissing True dataFoldPath
+  _ <- liftBase $ saveFile' dataFileName a
+
+  pure filePath
+
+---
+
+-- | Example to read a file with Type 
+readFile :: ( MonadReader  env m
+            , HasConfig    env
+            , MonadBase IO     m
+            , ReadFile         a
+            )
+         => FilePath -> m a
+readFile fp = do
+  dataPath <- view $ hasConfig . gc_datafilepath
+  liftBase $ readFile' $ toFilePath dataPath fp
+
+---
+
+rmFile :: ( MonadReader env m
+              , MonadBase IO m
+              , HasConfig env
+              )
+           => FilePath -> m ()
+rmFile = onDisk_1 SD.removeFile
+
+cpFile :: (MonadReader env m, MonadBase IO m, HasConfig env)
+           => FilePath -> FilePath -> m ()
+cpFile = onDisk_2 SD.copyFile
+
+---
+
+mvFile :: (MonadReader env m, MonadBase IO m, HasConfig env)
+       => FilePath -> FilePath -> m ()
+mvFile fp1 fp2 = do
+  cpFile fp1 fp2
+  rmFile fp1
+  pure ()
+
+------------------------------------------------------------------------
+onDisk_1 :: ( MonadReader env m
+              , MonadBase IO m
+              , HasConfig env
+              )
+        => (FilePath -> IO ()) -> FilePath -> m ()
+onDisk_1 action fp = do
+  dataPath <- view $ hasConfig . gc_datafilepath
+  liftBase $ action (toFilePath dataPath fp) `catch` handleExists
+    where
+      handleExists e
+        | isDoesNotExistError e = return ()
+        | otherwise = throwIO e
+
+
+onDisk_2 :: ( MonadReader env m
+              , MonadBase IO m
+              , HasConfig env
+              )
+        => (FilePath -> FilePath -> IO ())
+        -> FilePath
+        -> FilePath
+        -> m ()
+onDisk_2 action fp1 fp2 = do
+  dataPath <- view $ hasConfig . gc_datafilepath
+  let fp1' = toFilePath dataPath fp1
+      fp2' = toFilePath dataPath fp2
+  liftBase $ action fp1' fp2' `catch` handleExists
+    where
+      handleExists e
+        | isDoesNotExistError e = return ()
+        | otherwise = throwIO e
+------------------------------------------------------------------------
+

src/Gargantext/Prelude/Utils.hs

@@ -9,206 +9,16 @@ Portability : POSIX
 
 TODO_1: qualitative  tests (human)
 TODO_2: quantitative tests (coded)
+
+
 -}
 
 module Gargantext.Prelude.Utils
   where
 
-
-import Control.Exception
-import Control.Lens (view)
 import Control.Monad.Random.Class (MonadRandom)
-import Control.Monad.Reader (MonadReader)
-import Data.Aeson (ToJSON, toJSON)
-import Data.Text (Text)
-import Data.Tuple.Extra (both)
-import GHC.IO (FilePath)
-import Gargantext.Database.Admin.Types.Node (NodeId, NodeType)
-import Gargantext.Database.Prelude (HasConfig(..))
-import Gargantext.Prelude
-import Gargantext.Prelude.Config
-import Gargantext.Prelude.Crypto.Hash
-import System.Directory (createDirectoryIfMissing)
-import System.IO.Error
-import System.Random (newStdGen)
-import qualified Data.Text             as Text
-import qualified System.Directory as SD
 import qualified System.Random.Shuffle as SRS
 
--------------------------------------------------------------------
--- | Main Class to use (just declare needed functions)
-class GargDB a where
-  write :: a        -> IO ()
-  read  :: FilePath -> IO a
-
-  rm    :: (a, FilePath) -> IO ()
-  mv    :: (a, FilePath) -> FilePath -> IO ()
-
-
--- | Why not this class too ?
-class ToJSON parameters => GargDB' parameters gargdata where
-  write' :: parameters -> gargdata -> IO ()
-  read'  :: parameters -> IO gargdata
-
-  rm'    :: gargdata -> parameters -> IO ()
-  mv'    :: gargdata -> parameters -> parameters -> IO ()
-
--------------------------------------------------------------------
--- | Deprecated Class, use GargDB instead
-class SaveFile a where
-  saveFile' :: FilePath -> a -> IO ()
-
-class ReadFile a where
-  readFile' :: FilePath -> IO a
-
--------------------------------------------------------------------
--------------------------------------------------------------------
-type GargFilePath = (FolderPath, FileName)
--- where
-type FolderPath = FilePath
-type FileName   = FilePath
-
-           --------------------------------
-
-dataFilePath :: (ToJSON a) => a -> GargFilePath
-dataFilePath = toPath . hash . show . toJSON
-
-randomFilePath :: ( MonadReader  env m
-                  , MonadBase IO     m
-                  )
-               => m GargFilePath
-randomFilePath = do
-  (foldPath, fileName)  <- liftBase
-                         $ toPath
-                         . hash
-                         . show
-                         <$> newStdGen
-  pure (foldPath, fileName)
-
-
--- | toPath' : how to hash text to path
-{- example of use:
->>> toPath' (1,2) ("","helloword")
-("/he","lloword")
-
->>> toPath' (2,2) ("","helloword")
-("/he/ll","oword")
-
->>> toPath' (2,3) ("","helloword")
-("/hel/low","ord")
--}
-toPath :: Text -> (FolderPath, FileName)
-toPath tx = both Text.unpack $ toPath' (2,3) ("", tx)
-
-toPath' :: (Int,Int) -> (Text,Text) -> (Text,Text)
-toPath' (n,m) (t,x) = foldl' (\tx _ -> toPath'' m tx) (t,x) [1..n]
-
-toPath'' :: Int -> (Text, Text) -> (Text, Text)
-toPath'' n (fp,fn) = (fp'',fn')
-  where
-    (fp',fn') = Text.splitAt n fn
-    fp''      = Text.intercalate "/" [fp,fp']
-
--------------------------------------------------------------------
-type DataPath   = FilePath
-toFilePath :: FilePath -> FilePath -> FilePath
-toFilePath fp1 fp2 = fp1 <> "/" <> fp2
-
--------------------------------------------------------------------
-
--- | Disk operations
--- | For example, this write file with a random filepath
--- better use a hash of json of Type used to parameter as input 
--- the functions
-writeFile :: ( MonadReader env m
-             , HasConfig   env
-             , MonadBase IO    m
-             , SaveFile        a
-             )
-          => a -> m FilePath
-writeFile a = do
-  dataPath <- view $ hasConfig . gc_datafilepath
-
-  (foldPath, fileName) <- randomFilePath
-
-  let filePath     = toFilePath foldPath fileName
-      dataFoldPath = toFilePath dataPath foldPath
-      dataFileName = toFilePath dataPath filePath
-
-  _ <- liftBase $ createDirectoryIfMissing True dataFoldPath
-  _ <- liftBase $ saveFile' dataFileName a
-
-  pure filePath
-
----
-
--- | Example to read a file with Type 
-readFile :: ( MonadReader  env m
-            , HasConfig    env
-            , MonadBase IO     m
-            , ReadFile         a
-            )
-         => FilePath -> m a
-readFile fp = do
-  dataPath <- view $ hasConfig . gc_datafilepath
-  liftBase $ readFile' $ toFilePath dataPath fp
-
----
-
-rmFile :: ( MonadReader env m
-              , MonadBase IO m
-              , HasConfig env
-              )
-           => FilePath -> m ()
-rmFile = onDisk_1 SD.removeFile
-
-cpFile :: (MonadReader env m, MonadBase IO m, HasConfig env)
-           => FilePath -> FilePath -> m ()
-cpFile = onDisk_2 SD.copyFile
-
----
-
-mvFile :: (MonadReader env m, MonadBase IO m, HasConfig env)
-       => FilePath -> FilePath -> m ()
-mvFile fp1 fp2 = do
-  cpFile fp1 fp2
-  rmFile fp1
-  pure ()
-
-------------------------------------------------------------------------
-onDisk_1 :: ( MonadReader env m
-              , MonadBase IO m
-              , HasConfig env
-              )
-        => (FilePath -> IO ()) -> FilePath -> m ()
-onDisk_1 action fp = do
-  dataPath <- view $ hasConfig . gc_datafilepath
-  liftBase $ action (toFilePath dataPath fp) `catch` handleExists
-    where
-      handleExists e
-        | isDoesNotExistError e = return ()
-        | otherwise = throwIO e
-
-
-onDisk_2 :: ( MonadReader env m
-              , MonadBase IO m
-              , HasConfig env
-              )
-        => (FilePath -> FilePath -> IO ())
-        -> FilePath
-        -> FilePath
-        -> m ()
-onDisk_2 action fp1 fp2 = do
-  dataPath <- view $ hasConfig . gc_datafilepath
-  let fp1' = toFilePath dataPath fp1
-      fp2' = toFilePath dataPath fp2
-  liftBase $ action fp1' fp2' `catch` handleExists
-    where
-      handleExists e
-        | isDoesNotExistError e = return ()
-        | otherwise = throwIO e
-------------------------------------------------------------------------
-
 ------------------------------------------------------------------------
 -- | Misc Utils
 shuffle :: MonadRandom m => [a] -> m [a]
@@ -216,7 +26,8 @@ shuffle ns = SRS.shuffleM ns
 --------------------------------------------------------------------------
 
 -- TODO gargDB instance for NodeType
+{-
 data NodeToHash = NodeToHash { nodeType :: NodeType
                              , nodeId   :: NodeId
                              }
-
+-}