[FIX] typo
[gargantext.git] / src / Gargantext / Prelude / Utils.hs
index b3e01a66ad59f3edb6a974150f2755ed48f20f73..18dca2577df63bb6d5002f2aa20fc4e48c0c14b7 100644 (file)
@@ -9,38 +9,32 @@ Portability : POSIX
 
 -}
 
-
 module Gargantext.Prelude.Utils
   where
 
+import Control.Exception
 import Control.Lens (view)
-import Control.Monad.Random.Class (MonadRandom)
 import Control.Monad.Reader (MonadReader)
-import Control.Monad.Reader (ask)
+import Control.Monad.Random.Class (MonadRandom)
 import Data.Text (Text)
+import qualified Data.Text             as Text
 import GHC.IO (FilePath)
-import Gargantext.API.Admin.Settings
-import Gargantext.Database.Admin.Types.Node (NodeId, NodeType)
-import Gargantext.Prelude
 import System.Directory (createDirectoryIfMissing)
+import qualified System.Directory as SD
+import System.IO.Error
 import System.Random (newStdGen)
-import qualified Data.ByteString.Lazy.Char8  as Char
-import qualified Data.Digest.Pure.SHA        as SHA (sha256, showDigest)
-import qualified Data.Text                   as Text
 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
+
 --------------------------------------------------------------------------
 shuffle :: MonadRandom m => [a] -> m [a]
 shuffle ns = SRS.shuffleM ns 
 
---------------------------------------------------------------------------
-sha :: Text -> Text
-sha = Text.pack
-     . SHA.showDigest
-     . SHA.sha256
-     . Char.pack
-     . Text.unpack
-
 --------------------------------------------------------------------------
 data NodeToHash = NodeToHash { nodeType :: NodeType
                              , nodeId   :: NodeId
@@ -49,7 +43,15 @@ data NodeToHash = NodeToHash { nodeType :: NodeType
 type FolderPath = FilePath
 type FileName   = FilePath
 
-toPath :: Int -> Text -> (FolderPath,FileName)
+-- | toPath example of use:
+-- toPath 2 "gargantexthello"
+-- ("ga/rg","antexthello")
+-- 
+-- toPath 3 "gargantexthello"
+-- ("gar/gan","texthello")
+
+
+toPath :: Int -> Text -> (FolderPath, FileName)
 toPath n x = (Text.unpack $ Text.intercalate "/" [x1,x2], Text.unpack xs)
   where
     (x1,x') = Text.splitAt n x
@@ -62,23 +64,42 @@ class ReadFile a where
   readFile' :: FilePath -> IO a
 
 
-writeFile :: (MonadReader env m, MonadBase IO m, HasSettings env, SaveFile a)
-         => a -> m FilePath
+folderFilePath :: (MonadReader env m, MonadBase IO m) => m (FolderPath, FileName)
+folderFilePath = do
+  (foldPath, fileName)  <- liftBase $ (toPath 3) . hash . show <$> newStdGen
+
+  pure (foldPath, fileName)
+
+
+writeFile :: (MonadReader env m, MonadBase IO m, HasConfig env, SaveFile a)
+          => a -> m FilePath
 writeFile a = do
-  dataPath <- view (settings . fileFolder) <$> ask
-  (fp,fn)  <- liftBase $ (toPath 3) . sha . Text.pack . show <$> newStdGen
-  
-  let foldPath = dataPath <> "/" <> fp
-      filePath = foldPath <> "/" <> fn
-  
-  _ <- liftBase $ createDirectoryIfMissing True foldPath
-  _ <- liftBase $ saveFile' filePath a
-  
+  dataPath <- view $ hasConfig . gc_datafilepath
+
+  (foldPath, fileName) <- folderFilePath
+
+  let filePath = foldPath <> "/" <> fileName
+      dataFoldPath = dataPath <> "/" <> foldPath
+      dataFileName = dataPath <> "/" <> filePath
+
+  _ <- liftBase $ createDirectoryIfMissing True dataFoldPath
+  _ <- liftBase $ saveFile' dataFileName a
+
   pure filePath
 
 
-readFile :: (MonadReader env m, MonadBase IO m, HasSettings env, ReadFile a)
+readFile :: (MonadReader env m, MonadBase IO m, HasConfig env, ReadFile a)
          => FilePath -> m a
 readFile fp = do
-  dataPath <- view (settings . fileFolder) <$> ask
+  dataPath <- view $ hasConfig . gc_datafilepath
   liftBase $ readFile' $ dataPath <> "/" <> fp
+
+removeFile :: (MonadReader env m, MonadBase IO m, HasConfig env)
+           => FilePath -> m ()
+removeFile fp = do
+  dataPath <- view $ hasConfig . gc_datafilepath
+  liftBase $ SD.removeFile (dataPath <> "/" <> fp) `catch` handleExists
+    where
+      handleExists e
+        | isDoesNotExistError e = return ()
+        | otherwise = throwIO e