[CLEAN] sugared funs

src/Gargantext/Database/Action/Delete.hs

@@ -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.removeFile $ unpack path
+      GPU.rmFile $ unpack path
       N.deleteNode nodeId
     _                             -> N.deleteNode nodeId
    

src/Gargantext/Prelude/Utils.hs

@@ -7,45 +7,87 @@ Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
+TODO_1: qualitative  tests (human)
+TODO_2: quantitative tests (coded)
 -}
 
 module Gargantext.Prelude.Utils
   where
 
-import Data.Tuple.Extra (both)
+
 import Control.Exception
 import Control.Lens (view)
-import Control.Monad.Reader (MonadReader)
 import Control.Monad.Random.Class (MonadRandom)
+import Control.Monad.Reader (MonadReader)
+import Data.Aeson (ToJSON, toJSON)
 import Data.Text (Text)
-import qualified Data.Text             as 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 qualified System.Directory as SD
 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
 
-import Gargantext.Prelude.Config
-import Gargantext.Prelude.Crypto.Hash
-import Gargantext.Database.Prelude (HasConfig(..))
-import Gargantext.Database.Admin.Types.Node (NodeId, NodeType)
-import Gargantext.Prelude
+-------------------------------------------------------------------
+-- | Main Class to use (just declare needed functions)
+class GargDB a where
+  write :: a        -> IO ()
+  read  :: FilePath -> IO a
 
---------------------------------------------------------------------------
-shuffle :: MonadRandom m => [a] -> m [a]
-shuffle ns = SRS.shuffleM ns 
+  rm    :: (a, FilePath) -> IO ()
+  mv    :: (a, FilePath) -> FilePath -> IO ()
 
---------------------------------------------------------------------------
-data NodeToHash = NodeToHash { nodeType :: NodeType
-                             , nodeId   :: NodeId
-                             }
+
+-- | 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
 
--- | toPath' example of use:
-{-
+           --------------------------------
+
+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")
 
@@ -55,9 +97,8 @@ type FileName   = FilePath
 >>> toPath' (2,3) ("","helloword")
 ("/hel/low","ord")
 -}
-
-toPath :: Int -> Text -> (FolderPath, FileName)
-toPath n tx = both Text.unpack $ toPath' (2,n) ("", tx)
+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]
@@ -66,53 +107,116 @@ toPath'' :: Int -> (Text, Text) -> (Text, Text)
 toPath'' n (fp,fn) = (fp'',fn')
   where
     (fp',fn') = Text.splitAt n fn
-    fp''       = Text.intercalate "/" [fp,fp']
+    fp''      = Text.intercalate "/" [fp,fp']
 
 -------------------------------------------------------------------
--------------------------------------------------------------------
-class SaveFile a where
-  saveFile' :: FilePath -> a -> IO ()
-
-class ReadFile a where
-  readFile' :: FilePath -> IO a
-
-
-folderFilePath :: (MonadReader env m, MonadBase IO m) => m (FolderPath, FileName)
-folderFilePath = do
-  (foldPath, fileName)  <- liftBase $ (toPath 3) . hash . show <$> newStdGen
-
-  pure (foldPath, fileName)
+type DataPath   = FilePath
+toFilePath :: FilePath -> FilePath -> FilePath
+toFilePath fp1 fp2 = fp1 <> "/" <> fp2
 
+-------------------------------------------------------------------
 
-writeFile :: (MonadReader env m, MonadBase IO m, HasConfig env, SaveFile a)
+-- | 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) <- folderFilePath
+  (foldPath, fileName) <- randomFilePath
 
-  let filePath = foldPath <> "/" <> fileName
-      dataFoldPath = dataPath <> "/" <> foldPath
-      dataFileName = dataPath <> "/" <> filePath
+  let filePath     = toFilePath foldPath fileName
+      dataFoldPath = toFilePath dataPath foldPath
+      dataFileName = toFilePath dataPath filePath
 
   _ <- liftBase $ createDirectoryIfMissing True dataFoldPath
   _ <- liftBase $ saveFile' dataFileName a
 
   pure filePath
 
+---
 
-readFile :: (MonadReader env m, MonadBase IO m, HasConfig env, ReadFile a)
+-- | 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' $ dataPath <> "/" <> fp
+  liftBase $ readFile' $ toFilePath dataPath fp
 
-removeFile :: (MonadReader env m, MonadBase IO m, HasConfig env)
+---
+
+rmFile :: ( MonadReader env m
+              , MonadBase IO m
+              , HasConfig env
+              )
            => FilePath -> m ()
-removeFile fp = do
+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 $ SD.removeFile (dataPath <> "/" <> fp) `catch` handleExists
+  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]
+shuffle ns = SRS.shuffleM ns 
+--------------------------------------------------------------------------
+
+-- TODO gargDB instance for NodeType
+data NodeToHash = NodeToHash { nodeType :: NodeType
+                             , nodeId   :: NodeId
+                             }
+