Skip to content

haskell-gargantext
haskell-gargantext
Commit 0ad98105 authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

Merge remote-tracking branch 'origin/adinapoli/issue-355' into dev

parents 6a0c62d6 f9332b80
Hide whitespace changes
Inline Side-by-side
Showing with 497 additions and 355 deletions
.gitlab-ci.yml
View file @ 0ad98105
...@@ -37,7 +37,7 @@ cabal: ...@@ -37,7 +37,7 @@ cabal:
- .cabal/ - .cabal/
policy: pull-push policy: pull-push
script: script:
- nix-shell --run "./bin/update-project-dependencies $CABAL_STORE_DIR && cabal --store-dir=$CABAL_STORE_DIR v2-build --flags 'test-crypto no-phylo-debug-logs' --ghc-options='-O0 -fclear-plugins'" - nix-shell --run "./bin/update-project-dependencies $CABAL_STORE_DIR && cabal --store-dir=$CABAL_STORE_DIR v2-build all --flags 'test-crypto no-phylo-debug-logs' --ghc-options='-O0 -fclear-plugins'"
allow_failure: false allow_failure: false
bench: bench:
......
bin/gargantext-admin/Main.hs deleted 100644 → 0
View file @ 6a0c62d6
{-|
Module : Main.hs
Description : Gargantext Admin tools
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE Strict #-}
module Main where
import Gargantext.API.Dev (withDevEnv, runCmdDev)
import Gargantext.API.Errors.Types
import Gargantext.Database.Action.User.New (newUsers)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (Cmd'')
import Gargantext.Prelude
import Gargantext.API.Admin.EnvTypes (DevEnv)
import qualified Data.List.NonEmpty as NE
main :: IO ()
main = do
(iniPath:mails) <- getArgs
withDevEnv iniPath $ \env -> do
x <- runCmdDev env ((newUsers $ NE.map cs (NE.fromList mails)) :: Cmd'' DevEnv BackendInternalError (NonEmpty UserId))
putStrLn (show x :: Text)
pure ()
bin/gargantext-cli/CLI/Admin.hs 0 → 100644
View file @ 0ad98105
module CLI.Admin (
adminCLI
, adminCmd
) where
import CLI.Types
import Data.List.NonEmpty qualified as NE
import Data.Text qualified as T
import Gargantext.API.Admin.EnvTypes
import Gargantext.API.Dev
import Gargantext.API.Errors
import Gargantext.Core.Types
import Gargantext.Database.Action.User.New
import Gargantext.Database.Prelude
import Gargantext.Prelude
import Options.Applicative
import Prelude (String)
adminCLI :: AdminArgs -> IO ()
adminCLI (AdminArgs iniPath mails) = do
withDevEnv iniPath $ \env -> do
x <- runCmdDev env ((newUsers $ NE.map cs (NE.fromList mails)) :: Cmd'' DevEnv BackendInternalError (NonEmpty UserId))
putStrLn (show x :: Text)
adminCmd :: HasCallStack => Mod CommandFields CLI
adminCmd = command "admin" (info (helper <*> fmap CLISub admin_p) (progDesc "Create users."))
admin_p :: Parser CLICmd
admin_p = fmap CCMD_admin $ AdminArgs
<$> ( strOption ( long "ini-path"
<> metavar "FILEPATH"
<> help "Location of the .ini path"
) )
<*> ( option (maybeReader emails_p) ( long "emails"
<> metavar "email1,email2,..."
<> help "A comma-separated list of emails."
) )
emails_p :: String -> Maybe [String]
emails_p s = case T.splitOn "," (T.pack s) of
[] -> Nothing
xs -> pure $ map T.unpack xs
bin/gargantext-golden-file-diff/Main.hs → bin/gargantext-cli/CLI/FileDiff.hs
View file @ 0ad98105
module Main where module CLI.FileDiff where
import Prelude import CLI.Types
import Data.List qualified as L
import Data.Text qualified as T
import Data.Text.IO qualified as TIO
import Data.TreeDiff.Class import Data.TreeDiff.Class
import Data.TreeDiff.Pretty import Data.TreeDiff.Pretty
import qualified Data.Text as T import Gargantext.Prelude (HasCallStack, unless, exitFailure)
import qualified Data.Text.IO as TIO import Options.Applicative
import System.Environment (getArgs) import Prelude
import System.Exit (exitFailure)
import Control.Monad (unless)
import qualified Data.List as L
-- | Renders in a pretty way the content of two golden files. The -- | Renders in a pretty way the content of two golden files. The
-- first file should contain the expected output, the second the -- first file should contain the expected output, the second the
-- actual data generated by the test suite. -- actual data generated by the test suite.
main :: IO () fileDiffCLI :: GoldenFileDiffArgs -> IO ()
main = do fileDiffCLI (GoldenFileDiffArgs refPath newPath) = do
(refPath:newPath:_) <- getArgs
ref <- T.lines <$> TIO.readFile refPath ref <- T.lines <$> TIO.readFile refPath
new <- T.lines <$> TIO.readFile newPath new <- T.lines <$> TIO.readFile newPath
...@@ -25,3 +24,17 @@ main = do ...@@ -25,3 +24,17 @@ main = do
unless (L.null differences) $ do unless (L.null differences) $ do
putStrLn $ show $ ansiWlEditExpr $ ediff' (map fst differences) (map snd differences) putStrLn $ show $ ansiWlEditExpr $ ediff' (map fst differences) (map snd differences)
exitFailure exitFailure
fileDiffCmd :: HasCallStack => Mod CommandFields CLI
fileDiffCmd = command "golden-file-diff" (info (helper <*> fmap CLISub filediff_p) (progDesc "Compare the output of two golden files."))
filediff_p :: Parser CLICmd
filediff_p = fmap CCMD_golden_file_diff $ GoldenFileDiffArgs
<$> ( strOption ( long "expected"
<> metavar "FILEPATH"
<> help "Path to the file containing the expected output."
) )
<*> ( strOption ( long "actual"
<> metavar "FILEPATH"
<> help "Path to the file containing the actual output."
) )
bin/gargantext-import/Main.hs → bin/gargantext-cli/CLI/Import.hs
View file @ 0ad98105
{-| {-|
Module : Main.hs Module : Import.hs
Description : Gargantext Import Corpus Description : Gargantext Import Corpus
Copyright : (c) CNRS, 2017-Present Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3 License : AGPL + CECILL v3
...@@ -12,10 +12,13 @@ Import a corpus binary. ...@@ -12,10 +12,13 @@ Import a corpus binary.
-} -}
{-# LANGUAGE Strict #-} {-# LANGUAGE Strict #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE LambdaCase #-}
module Main where module CLI.Import where
import Data.Text qualified as Text import CLI.Types
import Gargantext.API.Admin.EnvTypes (DevEnv(..), DevJobHandle(..)) import Gargantext.API.Admin.EnvTypes (DevEnv(..), DevJobHandle(..))
import Gargantext.API.Dev (withDevEnv, runCmdGargDev) import Gargantext.API.Dev (withDevEnv, runCmdGargDev)
import Gargantext.API.Errors.Types ( BackendInternalError ) import Gargantext.API.Errors.Types ( BackendInternalError )
...@@ -23,66 +26,62 @@ import Gargantext.API.Node () -- instances ...@@ -23,66 +26,62 @@ import Gargantext.API.Node () -- instances
import Gargantext.Core (Lang(..)) import Gargantext.Core (Lang(..))
import Gargantext.Core.Text.Corpus.Parsers (FileFormat(..), FileType(..)) import Gargantext.Core.Text.Corpus.Parsers (FileFormat(..), FileType(..))
import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Core.Types.Query (Limit)
import Gargantext.Database.Action.Flow (flowCorpusFile, flowAnnuaire, TermType(..)) import Gargantext.Database.Action.Flow (flowCorpusFile, flowAnnuaire, TermType(..))
import Gargantext.Database.Action.Flow.Types (FlowCmdM) import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Admin.Types.Node (CorpusId) import Gargantext.Database.Admin.Types.Node (CorpusId)
import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserNormalCorpusName)) import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserNormalCorpusName))
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Utils.Jobs.Monad ( MonadJobStatus, JobHandle ) import Gargantext.Utils.Jobs.Monad ( MonadJobStatus, JobHandle )
import Options.Applicative
import qualified Data.Text as T
import Prelude (String)
import Gargantext.Core.Types.Query
main :: IO () importCLI :: ImportArgs -> IO ()
main = do importCLI (ImportArgs fun user name iniPath limit corpusPath) = do
[fun, user, name, iniPath, limit, corpusPath] <- getArgs
--{-
let let
--tt = (Unsupervised EN 6 0 Nothing) tt = Multi EN
tt = (Multi EN) format = TsvGargV3
format = TsvGargV3 -- TsvHal --WOS
limit' = case (readMaybe limit :: Maybe Limit) of
Nothing -> panicTrace $ "Cannot read limit: " <> (Text.pack limit)
Just l -> l
corpus :: forall m. (FlowCmdM DevEnv BackendInternalError m, MonadJobStatus m, JobHandle m ~ DevJobHandle) => m CorpusId corpus :: forall m. (FlowCmdM DevEnv BackendInternalError m, MonadJobStatus m, JobHandle m ~ DevJobHandle) => m CorpusId
mkCorpusUser = MkCorpusUserNormalCorpusName (UserName $ cs user) (cs name :: Text) mkCorpusUser = MkCorpusUserNormalCorpusName (UserName $ cs user) (cs name :: Text)
corpus = flowCorpusFile mkCorpusUser limit' tt format Plain corpusPath Nothing DevJobHandle corpus = flowCorpusFile mkCorpusUser limit tt format Plain corpusPath Nothing DevJobHandle
corpusTsvHal :: forall m. (FlowCmdM DevEnv BackendInternalError m, MonadJobStatus m, JobHandle m ~ DevJobHandle) => m CorpusId corpusTsvHal :: forall m. (FlowCmdM DevEnv BackendInternalError m, MonadJobStatus m, JobHandle m ~ DevJobHandle) => m CorpusId
corpusTsvHal = flowCorpusFile mkCorpusUser limit' tt TsvHal Plain corpusPath Nothing DevJobHandle corpusTsvHal = flowCorpusFile mkCorpusUser limit tt TsvHal Plain corpusPath Nothing DevJobHandle
annuaire :: forall m. (FlowCmdM DevEnv BackendInternalError m, MonadJobStatus m, JobHandle m ~ DevJobHandle) => m CorpusId annuaire :: forall m. (FlowCmdM DevEnv BackendInternalError m, MonadJobStatus m, JobHandle m ~ DevJobHandle) => m CorpusId
annuaire = flowAnnuaire (MkCorpusUserNormalCorpusName (UserName $ cs user) "Annuaire") (Multi EN) corpusPath DevJobHandle annuaire = flowAnnuaire (MkCorpusUserNormalCorpusName (UserName $ cs user) "Annuaire") (Multi EN) corpusPath DevJobHandle
{-
let debatCorpus :: forall m. FlowCmdM DevEnv BackendInternalError m => m CorpusId
debatCorpus = do
docs <- liftIO ( splitEvery 500
<$> take (read limit :: Int)
<$> readFile corpusPath
:: IO [[GrandDebatReference ]]
)
flowCorpus (Text.pack user) (Text.pack name) (Multi FR) (map (map toHyperdataDocument) docs)
--}
withDevEnv iniPath $ \env -> do withDevEnv iniPath $ \env -> do
_ <- if fun == "corpus" void $ case fun of
then runCmdGargDev env corpus IF_corpus
else pure 0 --(cs "false") -> runCmdGargDev env corpus
IF_corpusTsvHal
-> runCmdGargDev env corpusTsvHal
IF_annuaire
-> runCmdGargDev env annuaire
importCmd :: HasCallStack => Mod CommandFields CLI
importCmd = command "import" (info (helper <*> fmap CLISub import_p) (progDesc "Import CLI."))
renderImportFunction :: ImportFunction -> T.Text
renderImportFunction = T.drop 3 . T.pack . show
_ <- if fun == "corpusTsvHal" import_p :: Parser CLICmd
then runCmdGargDev env corpusTsvHal import_p = fmap CCMD_import $ ImportArgs
else pure 0 --(cs "false") <$> ( option (eitherReader function_p) ( long "function"
<> help ("The function to use, one between: " <> (T.unpack $ T.intercalate "," $ map renderImportFunction [minBound .. maxBound]))
) )
<*> ( option str ( long "user") )
<*> ( option str ( long "name") )
<*> ( option str ( long "ini" <> help "Path to the .ini file.") )
<*> (fmap Limit ( option auto ( long "ini" <> metavar "INT" <> help "The limit for the query") ))
<*> ( option str ( long "corpus-path" <> help "Path to corpus file") )
_ <- if fun == "annuaire" function_p :: String -> Either String ImportFunction
then runCmdGargDev env annuaire function_p = \case
else pure 0 "corpus" -> Right IF_corpus
{- "corpusTsvHal" -> Right IF_corpusTsvHal
_ <- if corpusType == "csv" "annuaire" -> Right IF_annuaire
then runCmdDev env csvCorpus xs -> Left $ "Unrecognised function: " <> xs
else if corpusType == "debat"
then runCmdDev env debatCorpus
else panic "corpusType unknown: try \"csv\" or \"debat\""
-}
pure ()
bin/gargantext-init/Main.hs → bin/gargantext-cli/CLI/Init.hs
View file @ 0ad98105
{-| {-|
Module : Main.hs Module : Init.hs
Description : Gargantext Import Corpus Description : Gargantext Init Script
Copyright : (c) CNRS, 2017-Present Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3 License : AGPL + CECILL v3
Maintainer : team@gargantext.org Maintainer : team@gargantext.org
Stability : experimental Stability : experimental
Portability : POSIX Portability : POSIX
Import a corpus binary. Initialise the Gargantext dataset.
-} -}
{-# LANGUAGE Strict #-} {-# LANGUAGE Strict #-}
module Main where module CLI.Init where
import Data.List.NonEmpty qualified as NE import Data.List.NonEmpty qualified as NE
import Gargantext.API.Dev (withDevEnv, runCmdDev) import Gargantext.API.Dev (withDevEnv, runCmdDev)
...@@ -32,16 +32,12 @@ import Gargantext.Prelude ...@@ -32,16 +32,12 @@ import Gargantext.Prelude
import Gargantext.Prelude.Config (GargConfig(..), readConfig) import Gargantext.Prelude.Config (GargConfig(..), readConfig)
import Gargantext.API.Admin.Types import Gargantext.API.Admin.Types
import Gargantext.Database.Prelude (DBCmd') import Gargantext.Database.Prelude (DBCmd')
import CLI.Types
import Options.Applicative
main :: IO () initCLI :: InitArgs -> IO ()
main = do initCLI (InitArgs iniPath) = do
params@[iniPath] <- getArgs
_ <- if length params /= 1
then panicTrace "USAGE: ./gargantext-init gargantext.ini"
else pure ()
putStrLn ("Enter master user (gargantua) _password_ :" :: Text) putStrLn ("Enter master user (gargantua) _password_ :" :: Text)
password <- getLine password <- getLine
...@@ -77,4 +73,13 @@ main = do ...@@ -77,4 +73,13 @@ main = do
x <- runCmdDev env initMaster x <- runCmdDev env initMaster
_ <- runCmdDev env mkRoots _ <- runCmdDev env mkRoots
putStrLn (show x :: Text) putStrLn (show x :: Text)
pure ()
initCmd :: HasCallStack => Mod CommandFields CLI
initCmd = command "init" (info (helper <*> fmap CLISub init_p) (progDesc "Initialise this Gargantext instance."))
init_p :: Parser CLICmd
init_p = fmap CCMD_init $ InitArgs
<$> ( strOption ( long "ini-path"
<> metavar "FILEPATH"
<> help "Location of the .ini path"
) )
bin/gargantext-invitations/Main.hs → bin/gargantext-cli/CLI/Invitations.hs
View file @ 0ad98105
{-| {-|
Module : Main.hs Module : Invitations.hs
Description : GarganText Mailing Invitations Description : GarganText Mailing Invitations
Copyright : (c) CNRS, 2017-Present Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3 License : AGPL + CECILL v3
...@@ -12,35 +12,51 @@ Portability : POSIX ...@@ -12,35 +12,51 @@ Portability : POSIX
{-# LANGUAGE Strict #-} {-# LANGUAGE Strict #-}
module Main where module CLI.Invitations where
import CLI.Types
import Gargantext.API.Admin.Types
import Gargantext.API.Dev (withDevEnv, runCmdDev) import Gargantext.API.Dev (withDevEnv, runCmdDev)
import Gargantext.API.Node () -- instances only
import Gargantext.API.Errors.Types import Gargantext.API.Errors.Types
import Gargantext.API.Admin.Types import Gargantext.API.Node () -- instances only
import Gargantext.API.Node.Share qualified as Share
import Gargantext.API.Node.Share.Types qualified as Share
import Gargantext.Core.NLP (HasNLPServer) import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (CmdRandom) import Gargantext.Database.Prelude (CmdRandom)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Prelude.Config (readConfig) import Gargantext.Prelude.Config (readConfig)
import Prelude (read) import Options.Applicative
import Gargantext.API.Node.Share.Types qualified as Share import Prelude (String)
import Gargantext.API.Node.Share qualified as Share import Gargantext.Core.Types
main :: IO ()
main = do
params@[iniPath,user,node_id,email] <- getArgs
_ <- if length params /= 4
then panicTrace "USAGE: ./gargantext-init gargantext.ini username node_id student@university.edu"
else pure ()
invitationsCLI :: InvitationsArgs -> IO ()
invitationsCLI (InvitationsArgs iniPath user node_id email) = do
_cfg <- readConfig iniPath _cfg <- readConfig iniPath
let invite :: (HasSettings env, CmdRandom env BackendInternalError m, HasNLPServer env) => m Int let invite :: (HasSettings env, CmdRandom env BackendInternalError m, HasNLPServer env) => m Int
invite = Share.api (UserName $ cs user) (UnsafeMkNodeId $ (read node_id :: Int)) (Share.ShareTeamParams $ cs email) invite = Share.api (UserName $ cs user) node_id (Share.ShareTeamParams $ cs email)
withDevEnv iniPath $ \env -> do withDevEnv iniPath $ \env -> do
_ <- runCmdDev env invite void $ runCmdDev env invite
pure ()
invitationsCmd :: HasCallStack => Mod CommandFields CLI
invitationsCmd = command "invitations" (info (helper <*> fmap CLISub invitations_p) (progDesc "Mailing invitations."))
invitations_p :: Parser CLICmd
invitations_p = fmap CCMD_invitations $ InvitationsArgs
<$> ( strOption ( long "ini-path"
<> metavar "FILEPATH"
<> help "Location of the .ini path"
) )
<*> ( strOption ( long "user" ) )
<*> ( option (eitherReader node_p) ( long "node-id" <> metavar "POSITIVE-INT" <> help "The node ID.") )
<*> ( strOption ( long "email" <> help "The email address.") )
node_p :: String -> Either String NodeId
node_p i = case readMaybe i of
Nothing -> Left $ i <> " is not a valid integer."
Just xs
| xs < 0 -> Left $ "The node id needs to be a positive integer."
| otherwise
-> Right $ UnsafeMkNodeId xs
bin/gargantext-cli/CLI/Phylo.hs 0 → 100644
View file @ 0ad98105
{-|
Module : Phylo.hs
Description : Gargantext starter binary with Adaptative Phylo
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
Adaptative Phylo binaries
-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE Strict #-}
module CLI.Phylo where
import CLI.Phylo.Common
import CLI.Types
import Data.Aeson (eitherDecodeFileStrict')
import Data.List (nub)
import Data.Text qualified as T
import GHC.IO.Encoding
import Gargantext.Core.Viz.Phylo
import Gargantext.Core.Viz.Phylo.API.Tools
import Gargantext.Core.Viz.Phylo.PhyloExport (toPhyloExport, dotToFile)
import Gargantext.Core.Viz.Phylo.PhyloMaker (toPhylo, toPhyloWithoutLink)
import Gargantext.Core.Viz.Phylo.PhyloTools (printIOMsg, printIOComment, setConfig)
import Gargantext.Prelude hiding (hash, replace)
import Options.Applicative
import System.Directory (doesFileExist)
phyloCLI :: PhyloArgs -> IO ()
phyloCLI (PhyloArgs configPath) = do
setLocaleEncoding utf8
config_e <- eitherDecodeFileStrict' configPath
case config_e of
Left err -> panicTrace $ T.pack err
Right config -> do
currentLocale <- getLocaleEncoding
printIOMsg $ "Machine locale: " <> show currentLocale
printIOMsg "Starting the reconstruction"
printIOMsg "Parse the corpus"
mapList <- fileToList (listParser config) (listPath config)
corpus <- if (defaultMode config)
then fileToDocsDefault (corpusParser config) (corpusPath config) [Year 3 1 5,Month 3 1 5,Week 4 2 5] mapList
else fileToDocsAdvanced (corpusParser config) (corpusPath config) (timeUnit config) mapList
printIOComment (show (length corpus) <> " parsed docs from the corpus")
printIOComment (show (length $ nub $ concat $ map text corpus) <> " Size ngs_coterms")
printIOComment (show (length mapList) <> " Size ngs_terms List Map Ngrams")
printIOMsg "Reconstruct the phylo"
-- check the existing backup files
let backupPhyloWithoutLink = (outputPath config) <> "backupPhyloWithoutLink_" <> (configToSha BackupPhyloWithoutLink config) <> ".json"
let backupPhylo = (outputPath config) <> "backupPhylo_" <> (configToSha BackupPhylo config) <> ".json"
phyloWithoutLinkExists <- doesFileExist backupPhyloWithoutLink
phyloExists <- doesFileExist backupPhylo
-- reconstruct the phylo
phylo <- if phyloExists
then do
printIOMsg "Reconstruct the phylo from an existing file"
readPhylo backupPhylo
else do
if phyloWithoutLinkExists
then do
printIOMsg "Reconstruct the phylo from an existing file without links"
phyloWithoutLink <- readPhylo backupPhyloWithoutLink
writePhylo backupPhyloWithoutLink phyloWithoutLink
pure $ toPhylo (setConfig config phyloWithoutLink)
else do
printIOMsg "Reconstruct the phylo from scratch"
phyloWithoutLink <- pure $ toPhyloWithoutLink corpus config
writePhylo backupPhyloWithoutLink phyloWithoutLink
pure $ toPhylo (setConfig config phyloWithoutLink)
writePhylo backupPhylo phylo
printIOMsg "End of reconstruction, start the export"
let dot = toPhyloExport (setConfig config phylo)
let output = configToLabel config
dotToFile output dot
phyloCmd :: HasCallStack => Mod CommandFields CLI
phyloCmd = command "phylo" (info (helper <*> fmap CLISub phylo_p) (progDesc "Phylo toolkit."))
phylo_p :: Parser CLICmd
phylo_p = fmap CCMD_phylo $ PhyloArgs
<$> ( strOption ( long "config"
<> metavar "FILEPATH"
<> help "Path to a file containing a JSON to be parsed into a PhyloConfig"
) )
bin/gargantext-phylo/Phylo/Common.hs → bin/gargantext-cli/CLI/Phylo/Common.hs
View file @ 0ad98105
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Common where module CLI.Phylo.Common where
import Control.Concurrent.Async (mapConcurrently) import Control.Concurrent.Async (mapConcurrently)
import Crypto.Hash.SHA256 (hash) import Crypto.Hash.SHA256 (hash)
...@@ -99,6 +99,8 @@ tsvToDocs parser patterns time path = ...@@ -99,6 +99,8 @@ tsvToDocs parser patterns time path =
(map (T.strip . pack) $ splitOn ";" (unpack $ (tsv'_source row))) (map (T.strip . pack) $ splitOn ";" (unpack $ (tsv'_source row)))
time time
) <$> snd <$> Tsv.readWeightedTsv path ) <$> snd <$> Tsv.readWeightedTsv path
Csv _ -> panicTrace "CSV is currently not supported."
Csv' _ -> panicTrace "CSV is currently not supported."
-- To parse a file into a list of Document -- To parse a file into a list of Document
...@@ -109,6 +111,8 @@ fileToDocsAdvanced parser path time lst = do ...@@ -109,6 +111,8 @@ fileToDocsAdvanced parser path time lst = do
Wos limit -> wosToDocs limit patterns time path Wos limit -> wosToDocs limit patterns time path
Tsv _ -> tsvToDocs parser patterns time path Tsv _ -> tsvToDocs parser patterns time path
Tsv' _ -> tsvToDocs parser patterns time path Tsv' _ -> tsvToDocs parser patterns time path
Csv _ -> panicTrace "CSV is currently not supported."
Csv' _ -> panicTrace "CSV is currently not supported."
fileToDocsDefault :: CorpusParser -> FilePath -> [TimeUnit] -> TermList -> IO [Document] fileToDocsDefault :: CorpusParser -> FilePath -> [TimeUnit] -> TermList -> IO [Document]
fileToDocsDefault parser path timeUnits lst = fileToDocsDefault parser path timeUnits lst =
......
bin/gargantext-phylo-profile/Main.hs → bin/gargantext-cli/CLI/Phylo/Profile.hs
View file @ 0ad98105
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Main where module CLI.Phylo.Profile where
import Common import CLI.Phylo.Common
import Data.Aeson import Data.Aeson
import Data.List (nub) import Data.List (nub)
import Gargantext.Core.Viz.Phylo import Gargantext.Core.Viz.Phylo
import Gargantext.Core.Viz.Phylo.API.Tools import Gargantext.Core.Viz.Phylo.API.Tools
import Gargantext.Core.Viz.Phylo.PhyloExport (toPhyloExport, dotToFile) import Gargantext.Core.Viz.Phylo.PhyloExport (toPhyloExport, dotToFile)
import Gargantext.Core.Viz.Phylo.PhyloMaker (toPhylo, toPhyloWithoutLink) import Gargantext.Core.Viz.Phylo.PhyloMaker (toPhylo, toPhyloWithoutLink)
import Gargantext.Core.Viz.Phylo.PhyloTools (printIOMsg, printIOComment, setConfig, toPeriods, getTimePeriod, getTimeStep) import Gargantext.Core.Viz.Phylo.PhyloTools
import GHC.IO.Encoding import GHC.IO.Encoding
import GHC.Stack import GHC.Stack
import Paths_gargantext import Paths_gargantext
import Prelude import Prelude
import qualified Data.Text as T import Shelly hiding (command)
import Shelly
import System.Directory import System.Directory
import Options.Applicative
import CLI.Types
-------------- --------------
-- | Main | -- -- | Main | --
...@@ -46,8 +47,8 @@ phyloConfig outdir = PhyloConfig { ...@@ -46,8 +47,8 @@ phyloConfig outdir = PhyloConfig {
} }
main :: HasCallStack => IO () phyloProfileCLI :: HasCallStack => IO ()
main = do phyloProfileCLI = do
shelly $ escaping False $ withTmpDir $ \tdir -> do shelly $ escaping False $ withTmpDir $ \tdir -> do
curDir <- pwd curDir <- pwd
...@@ -110,3 +111,8 @@ main = do ...@@ -110,3 +111,8 @@ main = do
dotToFile output dot dotToFile output dot
echo "Done." echo "Done."
phyloProfileCmd :: HasCallStack => Mod CommandFields CLI
phyloProfileCmd =
command "phylo-profile" (info (helper <*> fmap CLISub (pure CCMD_phylo_profile))
(progDesc "Helper to profile phylo code."))
bin/gargantext-cli/CLI/Types.hs
View file @ 0ad98105
module CLI.Types where module CLI.Types where
import Prelude
import Data.String import Data.String
import Data.Text (Text) import Data.Text (Text)
import Gargantext.Core.Types.Query
import Prelude
import Gargantext.Core.Types (NodeId)
newtype CorpusFile = CorpusFile { _CorpusFile :: FilePath } newtype CorpusFile = CorpusFile { _CorpusFile :: FilePath }
deriving (Show, Eq, IsString) deriving (Show, Eq, IsString)
...@@ -22,11 +24,62 @@ data ObfuscateDBArgs = ObfuscateDBArgs { ...@@ -22,11 +24,62 @@ data ObfuscateDBArgs = ObfuscateDBArgs {
, dbPassword :: !Text , dbPassword :: !Text
} deriving (Show, Eq) } deriving (Show, Eq)
data AdminArgs = AdminArgs
{ iniPath :: !FilePath
, emails :: [String]
} deriving (Show, Eq)
data ImportFunction
= IF_corpus
| IF_corpusTsvHal
| IF_annuaire
deriving (Show, Eq, Enum, Bounded)
data ImportArgs = ImportArgs
{ imp_function :: !ImportFunction
, imp_user :: !Text
, imp_name :: !Text
, imp_ini :: !FilePath
, imp_limit :: !Limit
, imp_corpus_path :: !FilePath
} deriving (Show, Eq)
data InitArgs = InitArgs
{ init_ini :: !FilePath
} deriving (Show, Eq)
data InvitationsArgs = InvitationsArgs
{ inv_path :: !FilePath
, inv_user :: !Text
, inv_node_id :: !NodeId
, inv_email :: !Text
} deriving (Show, Eq)
data PhyloArgs = PhyloArgs
{ phylo_config :: !FilePath
} deriving (Show, Eq)
data UpgradeArgs = UpgradeArgs
{ upgrade_ini :: !FilePath
} deriving (Show, Eq)
data GoldenFileDiffArgs = GoldenFileDiffArgs
{ gdf_expected :: !FilePath
, gdf_actual :: !FilePath
} deriving (Show, Eq)
data CLICmd data CLICmd
= CCMD_clean_csv_corpus = CCMD_clean_csv_corpus
| CCMD_filter_terms_and_cooc !CorpusFile !TermListFile !OutputFile | CCMD_filter_terms_and_cooc !CorpusFile !TermListFile !OutputFile
| CCMD_obfuscate_db !ObfuscateDBArgs | CCMD_obfuscate_db !ObfuscateDBArgs
| CCMD_admin !AdminArgs
| CCMD_import !ImportArgs
| CCMD_init !InitArgs
| CCMD_invitations !InvitationsArgs
| CCMD_phylo !PhyloArgs
| CCMD_phylo_profile
| CCMD_upgrade !UpgradeArgs
| CCMD_golden_file_diff !GoldenFileDiffArgs
deriving (Show, Eq) deriving (Show, Eq)
data CLI = data CLI =
......
bin/gargantext-upgrade/Main.hs → bin/gargantext-cli/CLI/Upgrade.hs
View file @ 0ad98105
{-| {-|
Module : Main.hs Module : Upgrade.hs
Description : Gargantext Import Corpus Description : Gargantext Import Corpus
Copyright : (c) CNRS, 2017-Present Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3 License : AGPL + CECILL v3
...@@ -7,24 +7,26 @@ Maintainer : team@gargantext.org ...@@ -7,24 +7,26 @@ Maintainer : team@gargantext.org
Stability : experimental Stability : experimental
Portability : POSIX Portability : POSIX
Import a corpus binary. Upgrade a gargantext node.
-} -}
{-# LANGUAGE Strict #-} {-# LANGUAGE Strict #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
module Main where module CLI.Upgrade where
import CLI.Types
import Data.List qualified as List (cycle, concat, take, unlines) import Data.List qualified as List (cycle, concat, take, unlines)
import Gargantext.API.Dev (withDevEnv) import Gargantext.API.Dev (withDevEnv)
import Gargantext.API.Node () -- instances only import Gargantext.API.Node () -- instances only
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Prelude.Config (GargConfig(..), readConfig) import Gargantext.Prelude.Config (GargConfig(..), readConfig)
import Prelude qualified import Prelude qualified
import Options.Applicative
main :: IO () upgradeCLI :: UpgradeArgs -> IO ()
main = do upgradeCLI (UpgradeArgs iniPath) = do
let ___ = putStrLn ((List.concat let ___ = putStrLn ((List.concat
$ List.take 72 $ List.take 72
...@@ -34,11 +36,6 @@ main = do ...@@ -34,11 +36,6 @@ main = do
putStrLn ("GarganText upgrade to version 0.0.6.9.9.4.4" :: Text) putStrLn ("GarganText upgrade to version 0.0.6.9.9.4.4" :: Text)
___ ___
params@[iniPath] <- getArgs
_ <- if length params /= 1
then panicTrace "Usage: ./gargantext-upgrade gargantext.ini"
else pure ()
putStrLn $ List.unlines putStrLn $ List.unlines
[ "Your Database defined in gargantext.ini will be upgraded." [ "Your Database defined in gargantext.ini will be upgraded."
, "We stronlgy recommend you to make a backup using pg_dump." , "We stronlgy recommend you to make a backup using pg_dump."
...@@ -92,3 +89,13 @@ main = do ...@@ -92,3 +89,13 @@ main = do
-- CREATE INDEX IF NOT EXISTS node_stories_ngrams_id_idx -- CREATE INDEX IF NOT EXISTS node_stories_ngrams_id_idx
-- ON node_stories(ngrams_id); -- ON node_stories(ngrams_id);
-- |] -- |]
upgradeCmd :: HasCallStack => Mod CommandFields CLI
upgradeCmd = command "upgrade" (info (helper <*> fmap CLISub upgrade_p) (progDesc "Upgrade a Gargantext node."))
upgrade_p :: Parser CLICmd
upgrade_p = fmap CCMD_upgrade $ UpgradeArgs
<$> ( strOption ( long "ini-path"
<> metavar "FILEPATH"
<> help "Location of the .ini path"
) )
bin/gargantext-cli/Main.hs
View file @ 0ad98105
...@@ -23,6 +23,14 @@ import CLI.FilterTermsAndCooc ...@@ -23,6 +23,14 @@ import CLI.FilterTermsAndCooc
import CLI.ObfuscateDB (obfuscateDB, obfuscateDBCmd) import CLI.ObfuscateDB (obfuscateDB, obfuscateDBCmd)
import CLI.Types import CLI.Types
import Options.Applicative import Options.Applicative
import CLI.Admin (adminCLI, adminCmd)
import CLI.Import (importCLI, importCmd)
import CLI.Init (initCLI, initCmd)
import CLI.Invitations (invitationsCLI, invitationsCmd)
import CLI.Phylo (phyloCLI, phyloCmd)
import CLI.Phylo.Profile (phyloProfileCLI, phyloProfileCmd)
import CLI.Upgrade (upgradeCLI, upgradeCmd)
import CLI.FileDiff (fileDiffCLI, fileDiffCmd)
runCLI :: CLI -> IO () runCLI :: CLI -> IO ()
runCLI = \case runCLI = \case
...@@ -32,17 +40,41 @@ runCLI = \case ...@@ -32,17 +40,41 @@ runCLI = \case
-> filterTermsAndCoocCLI corpusFile termListFile outputFile -> filterTermsAndCoocCLI corpusFile termListFile outputFile
CLISub (CCMD_obfuscate_db args) CLISub (CCMD_obfuscate_db args)
-> obfuscateDB args -> obfuscateDB args
CLISub (CCMD_admin args)
-> adminCLI args
CLISub (CCMD_import args)
-> importCLI args
CLISub (CCMD_init args)
-> initCLI args
CLISub (CCMD_invitations args)
-> invitationsCLI args
CLISub (CCMD_phylo args)
-> phyloCLI args
CLISub CCMD_phylo_profile
-> phyloProfileCLI
CLISub (CCMD_upgrade args)
-> upgradeCLI args
CLISub (CCMD_golden_file_diff args)
-> fileDiffCLI args
main :: IO () main :: IO ()
main = runCLI =<< execParser opts main = runCLI =<< execParser opts
where where
opts = info (helper <*> allOptions) opts = info (helper <*> allOptions)
( fullDesc ( fullDesc
<> progDesc "CLI for the gargantext-server" <> progDesc "CLI for the gargantext-server. Type --help for all the commands."
<> header "gargantext-cli tools" ) <> header "gargantext-cli tools" )
allOptions :: Parser CLI allOptions :: Parser CLI
allOptions = subparser ( allOptions = subparser (
filterTermsAndCoocCmd <> filterTermsAndCoocCmd <>
obfuscateDBCmd obfuscateDBCmd <>
adminCmd <>
importCmd <>
initCmd <>
invitationsCmd <>
phyloCmd <>
phyloProfileCmd <>
upgradeCmd <>
fileDiffCmd
) )
bin/gargantext-phylo/Main.hs deleted 100644 → 0
View file @ 6a0c62d6
{-|
Module : Main.hs
Description : Gargantext starter binary with Adaptative Phylo
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
Adaptative Phylo binaries
-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE Strict #-}
module Main where
import Control.Concurrent.Async (mapConcurrently)
import Crypto.Hash.SHA256 (hash)
import Data.Aeson
import Data.ByteString.Char8 qualified as C8
import Data.List (nub, isSuffixOf, tail)
import Data.List.Split
import Data.Maybe (fromJust)
import Data.Text (unpack, replace, pack)
import Data.Text qualified as T
import Data.Vector qualified as Vector
import GHC.IO.Encoding
import Gargantext.API.Ngrams.Prelude (toTermList)
import Gargantext.API.Ngrams.Types
import Gargantext.Core.Text.Context (TermList)
import Gargantext.Core.Text.Corpus.Parsers (FileFormat(..), FileType(..), parseFile)
import Gargantext.Core.Text.Corpus.Parsers.TSV (tsv_title, tsv_abstract, tsv_publication_year, tsv_publication_month, tsv_publication_day, tsv'_source, tsv'_title, tsv'_abstract, tsv'_publication_year, tsv'_publication_month, tsv'_publication_day, tsv'_weight)
import Gargantext.Core.Text.Corpus.Parsers.TSV qualified as Tsv
import Gargantext.Core.Text.List.Formats.TSV (tsvMapTermList)
import Gargantext.Core.Text.Ngrams (NgramsType(..))
import Gargantext.Core.Text.Terms.WithList (Patterns, buildPatterns, extractTermsWithList)
import Gargantext.Core.Types.Main (ListType(..))
import Gargantext.Core.Viz.Phylo
import Gargantext.Core.Viz.Phylo.API.Tools
import Gargantext.Core.Viz.Phylo.PhyloExport (toPhyloExport, dotToFile)
import Gargantext.Core.Viz.Phylo.PhyloMaker (toPhylo, toPhyloWithoutLink)
import Gargantext.Core.Viz.Phylo.PhyloTools (printIOMsg, printIOComment, setConfig, toPeriods, getTimePeriod, getTimeStep)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
import Gargantext.Prelude hiding (hash, replace)
import Prelude qualified
import System.Directory (listDirectory,doesFileExist)
import Common
main :: IO ()
main = do
setLocaleEncoding utf8
currentLocale <- getLocaleEncoding
printIOMsg $ "Machine locale: " <> show currentLocale
printIOMsg "Starting the reconstruction"
printIOMsg "Read the configuration file"
[args] <- getArgs
jsonArgs <- (eitherDecode <$> readJson args) :: IO (Either Prelude.String PhyloConfig)
case jsonArgs of
Left err -> putStrLn err
Right config -> do
printIOMsg "Parse the corpus"
mapList <- fileToList (listParser config) (listPath config)
corpus <- if (defaultMode config)
then fileToDocsDefault (corpusParser config) (corpusPath config) [Year 3 1 5,Month 3 1 5,Week 4 2 5] mapList
else fileToDocsAdvanced (corpusParser config) (corpusPath config) (timeUnit config) mapList
printIOComment (show (length corpus) <> " parsed docs from the corpus")
printIOComment (show (length $ nub $ concat $ map text corpus) <> " Size ngs_coterms")
printIOComment (show (length mapList) <> " Size ngs_terms List Map Ngrams")
printIOMsg "Reconstruct the phylo"
-- check the existing backup files
let backupPhyloWithoutLink = (outputPath config) <> "backupPhyloWithoutLink_" <> (configToSha BackupPhyloWithoutLink config) <> ".json"
let backupPhylo = (outputPath config) <> "backupPhylo_" <> (configToSha BackupPhylo config) <> ".json"
phyloWithoutLinkExists <- doesFileExist backupPhyloWithoutLink
phyloExists <- doesFileExist backupPhylo
-- reconstruct the phylo
phylo <- if phyloExists
then do
printIOMsg "Reconstruct the phylo from an existing file"
readPhylo backupPhylo
else do
if phyloWithoutLinkExists
then do
printIOMsg "Reconstruct the phylo from an existing file without links"
phyloWithoutLink <- readPhylo backupPhyloWithoutLink
writePhylo backupPhyloWithoutLink phyloWithoutLink
pure $ toPhylo (setConfig config phyloWithoutLink)
else do
printIOMsg "Reconstruct the phylo from scratch"
phyloWithoutLink <- pure $ toPhyloWithoutLink corpus config
writePhylo backupPhyloWithoutLink phyloWithoutLink
pure $ toPhylo (setConfig config phyloWithoutLink)
writePhylo backupPhylo phylo
printIOMsg "End of reconstruction, start the export"
let dot = toPhyloExport (setConfig config phylo)
let output = configToLabel config
dotToFile output dot
gargantext.cabal
View file @ 0ad98105
...@@ -692,31 +692,25 @@ library ...@@ -692,31 +692,25 @@ library
, zip-archive ^>= 0.4.3 , zip-archive ^>= 0.4.3
, zlib ^>= 0.6.2.3 , zlib ^>= 0.6.2.3
executable gargantext-admin
import:
defaults
, optimized
main-is: Main.hs
other-modules:
Paths_gargantext
hs-source-dirs:
bin/gargantext-admin
build-depends:
extra
, gargantext
, gargantext-prelude
, text
executable gargantext-cli executable gargantext-cli
import: import:
defaults defaults
, optimized , optimized
main-is: Main.hs main-is: Main.hs
other-modules: other-modules:
CLI.Admin
CLI.CleanCsvCorpus CLI.CleanCsvCorpus
CLI.FileDiff
CLI.FilterTermsAndCooc CLI.FilterTermsAndCooc
CLI.Import
CLI.Init
CLI.Invitations
CLI.ObfuscateDB CLI.ObfuscateDB
CLI.Phylo
CLI.Phylo.Common
CLI.Phylo.Profile
CLI.Types CLI.Types
CLI.Upgrade
CLI.Utils CLI.Utils
Paths_gargantext Paths_gargantext
hs-source-dirs: hs-source-dirs:
...@@ -727,7 +721,8 @@ executable gargantext-cli ...@@ -727,7 +721,8 @@ executable gargantext-cli
, bytestring ^>= 0.10.12.0 , bytestring ^>= 0.10.12.0
, cassava ^>= 0.5.2.0 , cassava ^>= 0.5.2.0
, containers ^>= 0.6.5.1 , containers ^>= 0.6.5.1
, extra , cryptohash ^>= 0.11.9
, directory ^>= 1.3.6.0
, extra ^>= 1.7.9 , extra ^>= 1.7.9
, full-text-search ^>= 0.2.1.4 , full-text-search ^>= 0.2.1.4
, gargantext , gargantext
...@@ -735,105 +730,14 @@ executable gargantext-cli ...@@ -735,105 +730,14 @@ executable gargantext-cli
, ini ^>= 0.4.1 , ini ^>= 0.4.1
, optparse-applicative , optparse-applicative
, optparse-generic ^>= 1.4.7 , optparse-generic ^>= 1.4.7
, parallel ^>= 3.2.2.0
, postgresql-simple ^>= 0.6.4 , postgresql-simple ^>= 0.6.4
, protolude ^>= 0.3.3 , protolude ^>= 0.3.3
, split ^>= 0.2.3.4 , shelly
, text ^>= 1.2.4.1
, unordered-containers ^>= 0.2.16.0
, vector ^>= 0.12.3.0
executable gargantext-import
import:
defaults
, optimized
main-is: Main.hs
default-extensions:
TypeOperators
other-modules:
Paths_gargantext
hs-source-dirs:
bin/gargantext-import
build-depends:
extra ^>= 1.7.9
, gargantext
, gargantext-prelude
, servant-server ^>= 0.18.3
, text ^>= 1.2.4.1
executable gargantext-init
import:
defaults
, optimized
main-is: Main.hs
other-modules:
Paths_gargantext
hs-source-dirs:
bin/gargantext-init
build-depends:
cron ^>= 0.7.0
, extra ^>= 1.7.9
, gargantext
, gargantext-prelude
, text ^>= 1.2.4.1
executable gargantext-invitations
import:
defaults
, optimized
main-is: Main.hs
other-modules:
Paths_gargantext
hs-source-dirs:
bin/gargantext-invitations
build-depends:
extra ^>= 1.7.9
, gargantext
, gargantext-prelude
, text ^>= 1.2.4.1
executable gargantext-phylo
import:
defaults
, optimized
main-is: Main.hs
other-modules:
Paths_gargantext
Common
hs-source-dirs:
bin/gargantext-phylo bin/gargantext-phylo/Phylo
default-extensions:
DataKinds
DeriveGeneric
FlexibleContexts
FlexibleInstances
GADTs
GeneralizedNewtypeDeriving
ImportQualifiedPost
MultiParamTypeClasses
NamedFieldPuns
NoImplicitPrelude
OverloadedStrings
RankNTypes
RecordWildCards
StrictData
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -O2 -Wmissing-signatures
build-depends:
aeson ^>= 1.5.6.0
, async ^>= 2.2.4
, bytestring ^>= 0.10.12.0
, cassava ^>= 0.5.2.0
, containers ^>= 0.6.5.1
, cryptohash ^>= 0.11.9
, directory ^>= 1.3.6.0
, extra ^>= 1.7.9
, gargantext
, gargantext-prelude
, ini ^>= 0.4.1
, optparse-generic ^>= 1.4.7
, parallel ^>= 3.2.2.0
, split ^>= 0.2.3.4 , split ^>= 0.2.3.4
, text ^>= 1.2.4.1 , text ^>= 1.2.4.1
, time ^>= 1.9.3 , time ^>= 1.9.3
, tree-diff
, unordered-containers ^>= 0.2.16.0 , unordered-containers ^>= 0.2.16.0
, vector ^>= 0.7.3 , vector ^>= 0.7.3
...@@ -860,23 +764,6 @@ executable gargantext-server ...@@ -860,23 +764,6 @@ executable gargantext-server
, unordered-containers ^>= 0.2.16.0 , unordered-containers ^>= 0.2.16.0
, vector ^>= 0.7.3 , vector ^>= 0.7.3
executable gargantext-upgrade
import:
defaults
, optimized
main-is: Main.hs
other-modules:
Paths_gargantext
hs-source-dirs:
bin/gargantext-upgrade
build-depends:
cron ^>= 0.7.0
, extra ^>= 1.7.9
, gargantext
, gargantext-prelude
, postgresql-simple ^>= 0.6.4
, text ^>= 1.2.4.1
test-suite garg-test-tasty test-suite garg-test-tasty
import: import:
defaults defaults
...@@ -884,7 +771,7 @@ test-suite garg-test-tasty ...@@ -884,7 +771,7 @@ test-suite garg-test-tasty
main-is: drivers/tasty/Main.hs main-is: drivers/tasty/Main.hs
other-modules: other-modules:
Test.API.Routes Test.API.Routes
Common CLI.Phylo.Common
Test.API.Setup Test.API.Setup
Test.Core.Similarity Test.Core.Similarity
Test.Core.Text Test.Core.Text
...@@ -920,7 +807,7 @@ test-suite garg-test-tasty ...@@ -920,7 +807,7 @@ test-suite garg-test-tasty
Test.Utils.Jobs Test.Utils.Jobs
Paths_gargantext Paths_gargantext
hs-source-dirs: hs-source-dirs:
test bin/gargantext-phylo/Phylo test bin/gargantext-cli
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
build-depends: build-depends:
QuickCheck ^>= 2.14.2 QuickCheck ^>= 2.14.2
...@@ -1098,39 +985,3 @@ benchmark garg-bench ...@@ -1098,39 +985,3 @@ benchmark garg-bench
ghc-options: "-with-rtsopts=-T -A32m" ghc-options: "-with-rtsopts=-T -A32m"
if impl(ghc >= 8.6) if impl(ghc >= 8.6)
ghc-options: "-with-rtsopts=--nonmoving-gc" ghc-options: "-with-rtsopts=--nonmoving-gc"
executable gargantext-phylo-profile
main-is: Main.hs
other-modules:
Paths_gargantext
Common
hs-source-dirs:
bin/gargantext-phylo-profile bin/gargantext-phylo/Phylo
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -O2 -Wmissing-signatures
build-depends:
base
, bytestring
, gargantext
, gargantext-prelude
, shelly
, text
, async
, cryptohash
, aeson
, split
, vector
, directory
default-language: GHC2021
executable garg-golden-file-diff
import:
defaults
, optimized
main-is: Main.hs
hs-source-dirs:
bin/gargantext-golden-file-diff
build-depends:
base
, text
, tree-diff
default-language: Haskell2010
test/Test/Offline/Phylo.hs
View file @ 0ad98105
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
module Test.Offline.Phylo (tests) where module Test.Offline.Phylo (tests) where
import Common import CLI.Phylo.Common
import Data.Aeson as JSON import Data.Aeson as JSON
import Data.Aeson.Types qualified as JSON import Data.Aeson.Types qualified as JSON
import Data.GraphViz.Attributes.Complete qualified as Graphviz import Data.GraphViz.Attributes.Complete qualified as Graphviz
......
test/Test/Offline/Stemming/Lancaster.hs
View file @ 0ad98105
...@@ -8,15 +8,14 @@ import Data.Text qualified as T ...@@ -8,15 +8,14 @@ import Data.Text qualified as T
import Gargantext.Core.Text.Terms.Mono.Stem.Internal.Lancaster (stem) import Gargantext.Core.Text.Terms.Mono.Stem.Internal.Lancaster (stem)
import Gargantext.Prelude (toS) import Gargantext.Prelude (toS)
import Test.Tasty import Test.Tasty
import Test.Tasty.Golden (goldenVsStringDiff) import Test.Tasty.Golden (goldenVsString)
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding as TE
tests :: TestTree tests :: TestTree
tests = testGroup "Lancaster" [ tests = testGroup "Lancaster" [
goldenVsStringDiff "test vector works" (\ref new -> ["cabal", "v2-run", "-v0", "garg-golden-file-diff", "--", ref, new]) "test-data/stemming/lancaster.txt" mkTestVector goldenVsString "test vector works" "test-data/stemming/lancaster.txt" mkTestVector
] ]
-- | List un /unstemmed/ test words -- | List un /unstemmed/ test words
......
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