[refactor] remove unnecessary LANGUAGE pragmas

Also, fix for notifications throttle delay value
parent efc0fe8e
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
module Main where module Main where
import Control.DeepSeq import Control.DeepSeq
......
{-# LANGUAGE OverloadedStrings #-}
module CLI.Phylo.Common where module CLI.Phylo.Common where
import Control.Concurrent.Async (mapConcurrently) import Control.Concurrent.Async (mapConcurrently)
......
{-# LANGUAGE OverloadedStrings #-}
module CLI.Phylo.Profile where module CLI.Phylo.Profile where
import CLI.Phylo.Common import CLI.Phylo.Common
......
...@@ -12,11 +12,8 @@ stack exec ghc -- --make -O2 -threaded scripts/haskell/dependencies.hs ...@@ -12,11 +12,8 @@ stack exec ghc -- --make -O2 -threaded scripts/haskell/dependencies.hs
-} -}
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
module Main where module Main where
......
...@@ -67,6 +67,7 @@ common defaults ...@@ -67,6 +67,7 @@ common defaults
MultiParamTypeClasses MultiParamTypeClasses
NamedFieldPuns NamedFieldPuns
NoImplicitPrelude NoImplicitPrelude
NumericUnderscores
OverloadedStrings OverloadedStrings
RankNTypes RankNTypes
RecordWildCards RecordWildCards
......
...@@ -27,7 +27,6 @@ Pouillard (who mainly made it). ...@@ -27,7 +27,6 @@ Pouillard (who mainly made it).
-} -}
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
......
{--| Support in Gargantext for CORS (Cross-origin resource sharing) --} {--| Support in Gargantext for CORS (Cross-origin resource sharing) --}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
module Gargantext.API.Admin.Settings.CORS where module Gargantext.API.Admin.Settings.CORS where
......
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.API.Admin.Settings.MicroServices where module Gargantext.API.Admin.Settings.MicroServices where
......
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.API.Errors.TH ( module Gargantext.API.Errors.TH (
deriveHttpStatusCode deriveHttpStatusCode
, deriveIsFrontendErrorData , deriveIsFrontendErrorData
......
...@@ -12,7 +12,6 @@ Portability : POSIX ...@@ -12,7 +12,6 @@ Portability : POSIX
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PolyKinds #-} {-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StandaloneKindSignatures #-} {-# LANGUAGE StandaloneKindSignatures #-}
......
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
{-| Edit 'sensitiveKeywords' to extend the list of redacted fields. -} {-| Edit 'sensitiveKeywords' to extend the list of redacted fields. -}
......
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
module Gargantext.API.Routes.Named ( module Gargantext.API.Routes.Named (
......
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.API.Routes.Named.Annuaire ( module Gargantext.API.Routes.Named.Annuaire (
-- * Routes types -- * Routes types
AddAnnuaireWithForm(..) AddAnnuaireWithForm(..)
......
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.API.Routes.Named.Contact ( module Gargantext.API.Routes.Named.Contact (
-- * Routes types -- * Routes types
ContactAPI(..) ContactAPI(..)
......
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.API.Routes.Named.Context ( module Gargantext.API.Routes.Named.Context (
-- * Routes types -- * Routes types
......
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.API.Routes.Named.Corpus ( module Gargantext.API.Routes.Named.Corpus (
-- * Routes types -- * Routes types
CorpusExportAPI(..) CorpusExportAPI(..)
......
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.API.Routes.Named.Count ( module Gargantext.API.Routes.Named.Count (
-- * Routes types -- * Routes types
CountAPI(..) CountAPI(..)
......
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Gargantext.API.Routes.Named.Document ( module Gargantext.API.Routes.Named.Document (
-- * Routes types -- * Routes types
DocumentsFromWriteNodesAPI(..) DocumentsFromWriteNodesAPI(..)
......
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.API.Routes.Named.EKG ( module Gargantext.API.Routes.Named.EKG (
-- * Routes types -- * Routes types
EkgAPI(..) EkgAPI(..)
......
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Gargantext.API.Routes.Named.File ( module Gargantext.API.Routes.Named.File (
-- * Routes types -- * Routes types
FileAPI(..) FileAPI(..)
......
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.API.Routes.Named.FrameCalc ( module Gargantext.API.Routes.Named.FrameCalc (
-- * Routes types -- * Routes types
......
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.API.Routes.Named.List ( module Gargantext.API.Routes.Named.List (
-- * Routes types -- * Routes types
GETAPI(..) GETAPI(..)
......
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.API.Routes.Named.Metrics ( module Gargantext.API.Routes.Named.Metrics (
-- * Routes types -- * Routes types
......
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.API.Routes.Named.Node ( module Gargantext.API.Routes.Named.Node (
-- * Routes types -- * Routes types
NodeAPI(..) NodeAPI(..)
......
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE KindSignatures #-} {-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
......
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Gargantext.API.Routes.Named.Public ( module Gargantext.API.Routes.Named.Public (
-- * Routes types -- * Routes types
GargPublicAPI(..) GargPublicAPI(..)
......
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.API.Routes.Named.Search ( module Gargantext.API.Routes.Named.Search (
-- * Routes types -- * Routes types
SearchAPI(..) SearchAPI(..)
......
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
module Gargantext.API.Routes.Named.Share ( module Gargantext.API.Routes.Named.Share (
......
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
......
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.API.Routes.Named.Tree ( module Gargantext.API.Routes.Named.Tree (
-- * Routes types -- * Routes types
......
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.API.Routes.Named.Viz ( module Gargantext.API.Routes.Named.Viz (
-- * Routes types -- * Routes types
......
...@@ -73,7 +73,7 @@ dispatcherListener subscriptions = do ...@@ -73,7 +73,7 @@ dispatcherListener subscriptions = do
-- NOTE I'm not sure that we need more than 1 worker here, but in -- NOTE I'm not sure that we need more than 1 worker here, but in
-- theory, the worker can perform things like user authentication, -- theory, the worker can perform things like user authentication,
-- DB queries etc so it can be slow sometimes. -- DB queries etc so it can be slow sometimes.
Async.withAsync (throttle 500 throttleTChan sendDataMessageThrottled) $ \_ -> do Async.withAsync (throttle 500_000 throttleTChan sendDataMessageThrottled) $ \_ -> do
void $ Async.concurrently (Async.replicateConcurrently 5 $ worker tChan throttleTChan) $ do void $ Async.concurrently (Async.replicateConcurrently 5 $ worker tChan throttleTChan) $ do
forever $ do forever $ do
-- putText "[dispatcher_listener] receiving" -- putText "[dispatcher_listener] receiving"
......
...@@ -85,7 +85,6 @@ where $n_{ij}$ is the cooccurrence between term $i$ and term $j$ ...@@ -85,7 +85,6 @@ where $n_{ij}$ is the cooccurrence between term $i$ and term $j$
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE GADTs #-}
module Gargantext.Core.Methods.Similarities.Accelerate.Distributional module Gargantext.Core.Methods.Similarities.Accelerate.Distributional
where where
......
...@@ -11,8 +11,6 @@ Thx to Alp Well Typed for the first version. ...@@ -11,8 +11,6 @@ Thx to Alp Well Typed for the first version.
-} -}
{-# LANGUAGE OverloadedStrings #-}
module Gargantext.Core.Text.Corpus.Parsers.Wikidata.Crawler module Gargantext.Core.Text.Corpus.Parsers.Wikidata.Crawler
where where
......
{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
module Gargantext.Core.Text.Corpus.Query ( module Gargantext.Core.Text.Corpus.Query (
Query -- * opaque Query -- * opaque
, RawQuery(..) , RawQuery(..)
......
...@@ -15,8 +15,6 @@ that could be the incarnation of the mythic Gargantua. ...@@ -15,8 +15,6 @@ that could be the incarnation of the mythic Gargantua.
-} -}
{-# LANGUAGE OverloadedStrings #-}
module Gargantext.Core.Text.Prepare module Gargantext.Core.Text.Prepare
where where
......
{-# LANGUAGE OverloadedStrings #-}
module Gargantext.Core.Text.Terms.Mono.Stem.Internal.Lancaster module Gargantext.Core.Text.Terms.Mono.Stem.Internal.Lancaster
( stem ( stem
......
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.Core.Viz.Types where module Gargantext.Core.Viz.Types where
......
...@@ -9,13 +9,6 @@ Portability : POSIX ...@@ -9,13 +9,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Admin.Types.Hyperdata.Any module Gargantext.Database.Admin.Types.Hyperdata.Any
......
...@@ -12,13 +12,7 @@ Portability : POSIX ...@@ -12,13 +12,7 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-deprecations #-} {-# OPTIONS_GHC -fno-warn-deprecations #-}
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
......
...@@ -9,13 +9,6 @@ Portability : POSIX ...@@ -9,13 +9,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Admin.Types.Hyperdata.Corpus module Gargantext.Database.Admin.Types.Hyperdata.Corpus
......
...@@ -9,10 +9,7 @@ Portability : POSIX ...@@ -9,10 +9,7 @@ Portability : POSIX
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Admin.Types.Hyperdata.CorpusField module Gargantext.Database.Admin.Types.Hyperdata.CorpusField
where where
......
...@@ -9,12 +9,6 @@ Portability : POSIX ...@@ -9,12 +9,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
......
...@@ -9,13 +9,6 @@ Portability : POSIX ...@@ -9,13 +9,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Admin.Types.Hyperdata.Default module Gargantext.Database.Admin.Types.Hyperdata.Default
......
...@@ -9,13 +9,6 @@ Portability : POSIX ...@@ -9,13 +9,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Admin.Types.Hyperdata.Document where module Gargantext.Database.Admin.Types.Hyperdata.Document where
......
...@@ -9,13 +9,6 @@ Portability : POSIX ...@@ -9,13 +9,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Admin.Types.Hyperdata.File module Gargantext.Database.Admin.Types.Hyperdata.File
......
...@@ -9,13 +9,6 @@ Portability : POSIX ...@@ -9,13 +9,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Admin.Types.Hyperdata.Folder module Gargantext.Database.Admin.Types.Hyperdata.Folder
......
...@@ -9,13 +9,6 @@ Portability : POSIX ...@@ -9,13 +9,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Admin.Types.Hyperdata.List module Gargantext.Database.Admin.Types.Hyperdata.List
......
...@@ -9,13 +9,6 @@ Portability : POSIX ...@@ -9,13 +9,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Admin.Types.Hyperdata.Model module Gargantext.Database.Admin.Types.Hyperdata.Model
......
...@@ -9,13 +9,6 @@ Portability : POSIX ...@@ -9,13 +9,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Admin.Types.Hyperdata.Phylo module Gargantext.Database.Admin.Types.Hyperdata.Phylo
......
...@@ -9,13 +9,6 @@ Portability : POSIX ...@@ -9,13 +9,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Admin.Types.Hyperdata.Texts module Gargantext.Database.Admin.Types.Hyperdata.Texts
......
...@@ -10,13 +10,7 @@ Portability : POSIX ...@@ -10,13 +10,7 @@ Portability : POSIX
-} -}
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
......
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Admin.Types.Metrics where module Gargantext.Database.Admin.Types.Metrics where
......
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
......
{-# LANGUAGE GADTs #-}
module Gargantext.Utils.Jobs.Map ( module Gargantext.Utils.Jobs.Map (
-- * Types -- * Types
JobMap(..) JobMap(..)
......
{-# LANGUAGE MultiWayIf, FunctionalDependencies, MultiParamTypeClasses, TypeFamilies, ScopedTypeVariables #-} {-# LANGUAGE MultiWayIf, FunctionalDependencies, TypeFamilies, ScopedTypeVariables #-}
module Gargantext.Utils.Jobs.Monad ( module Gargantext.Utils.Jobs.Monad (
-- * Types and classes -- * Types and classes
JobEnv(..) JobEnv(..)
......
...@@ -10,7 +10,6 @@ Portability : POSIX ...@@ -10,7 +10,6 @@ Portability : POSIX
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
......
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module Test.API.Setup where module Test.API.Setup where
......
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
......
{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
module Test.Core.Text.Corpus.Query (tests) where module Test.Core.Text.Corpus.Query (tests) where
......
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
......
...@@ -8,7 +8,6 @@ Stability : experimental ...@@ -8,7 +8,6 @@ Stability : experimental
Portability : POSIX Portability : POSIX
-} -}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
module Test.Database.Operations.DocumentSearch where module Test.Database.Operations.DocumentSearch where
......
...@@ -8,7 +8,6 @@ Stability : experimental ...@@ -8,7 +8,6 @@ Stability : experimental
Portability : POSIX Portability : POSIX
-} -}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
module Test.Database.Operations.NodeStory where module Test.Database.Operations.NodeStory where
......
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
module Test.Ngrams.Query (tests) where module Test.Ngrams.Query (tests) where
......
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
......
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
......
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
......
...@@ -8,11 +8,9 @@ Stability : experimental ...@@ -8,11 +8,9 @@ Stability : experimental
Portability : POSIX Portability : POSIX
-} -}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NumericUnderscores #-}
module Test.Utils.Jobs (test) where module Test.Utils.Jobs (test) where
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment