Commit 082be2c7 authored by Grégoire Locqueville's avatar Grégoire Locqueville

Remove some more dead code, update `weeder.toml` again

parent 4366cb29
......@@ -19,8 +19,6 @@ module Gargantext.API.Admin.Settings
where
import Codec.Serialise (Serialise(), serialise)
import Data.ByteString.Lazy qualified as L
import Data.Pool (Pool)
import Data.Pool qualified as Pool
import Database.PostgreSQL.Simple (Connection, connect, close, ConnectInfo)
......@@ -34,9 +32,6 @@ import Gargantext.Core.NodeStory (fromDBNodeStoryEnv)
import Gargantext.Prelude
import Gargantext.System.Logging (Logger)
import Network.HTTP.Client.TLS (newTlsManager)
import System.Directory (renameFile)
import System.IO (hClose)
import System.IO.Temp (withTempFile)
newtype IniFile = IniFile { _IniFile :: FilePath }
......@@ -46,20 +41,6 @@ newtype IniFile = IniFile { _IniFile :: FilePath }
-- | RepoDir FilePath configuration
type RepoDirFilePath = FilePath
repoSnapshot :: RepoDirFilePath -> FilePath
repoSnapshot repoDir = repoDir <> "/repo.cbor"
-- This assumes we own the lock on repoSnapshot.
repoSaverAction :: RepoDirFilePath -> Serialise a => a -> IO ()
repoSaverAction repoDir a = do
withTempFile repoDir "tmp-repo.cbor" $ \fp h -> do
-- printDebug "repoSaverAction" fp
L.hPut h $ serialise a
hClose h
renameFile fp (repoSnapshot repoDir)
newEnv :: Logger (GargM Env BackendInternalError) -> GargConfig -> D.Dispatcher -> IO Env
newEnv logger config dispatcher = do
......
......@@ -34,8 +34,6 @@ module Gargantext.API.Auth.PolicyCheck (
, moveChecks
, publishChecks
, userMe
, alwaysAllow
, alwaysDeny
) where
import Control.Lens (view)
......@@ -274,11 +272,6 @@ publishChecks :: NodeId -> BoolExpr AccessCheck
publishChecks nodeId =
(nodeUser nodeId `BOr` nodeSuper nodeId)
alwaysAllow :: BoolExpr AccessCheck
alwaysAllow = BConst . Positive $ AC_always_allow
alwaysDeny :: BoolExpr AccessCheck
alwaysDeny = BConst . Positive $ AC_always_deny
-------------------------------------------------------------------------------
-- Instances
......
type-class-roots = true
roots = [ '^Main\.main$'
, '^Paths_.*'
# I'm keeping definitions whose name starts with `test`, in order to
# avoid removing something that might have value, but we should clarify
# what the purpose of each is, and whether the main source tree is the
# right place for them (rather than, say, in the tests)
# avoid removing something that might have value, but TODO we should
# clarify what the purpose of each is, and whether the main source tree
# is the right place for them (rather than, say, in the tests)
, 'CLI.FilterTermsAndCooc.testCorpus'
, 'CLI.FilterTermsAndCooc.testTermList'
# Useful in the REPL. TODO go through each function in this module ---
# I don't think we need that many variations around `runCmd`?
, 'Gargantext.API.Dev.*'
]
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