[CLEAN] creating Prelude.GargDB file

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/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/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/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.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
+------------------------------------------------------------------------
+

src/Gargantext/Prelude/Utils.hs

@@ -16,200 +16,9 @@ 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]
@@ -217,7 +26,8 @@ shuffle ns = SRS.shuffleM ns
 --------------------------------------------------------------------------
 
 -- TODO gargDB instance for NodeType
+{-
 data NodeToHash = NodeToHash { nodeType :: NodeType
                              , nodeId   :: NodeId
                              }
-
+-}