src/Gargantext/Prelude/Utils.hs

   1 {-|
   2 Module      : Gargantext.Prelude.Utils
   3 Description : Useful Tools near Prelude of the project
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 -}
  11
  12 {-# OPTIONS_GHC -fno-warn-orphans   #-}
  13
  14 module Gargantext.Prelude.Utils
  15   where
  16
  17 import Control.Lens (view)
  18 import Control.Monad.Random.Class (MonadRandom)
  19 import Control.Monad.Reader (MonadReader)
  20 import Control.Monad.Reader (ask)
  21 import Data.Text (Text)
  22 import GHC.IO (FilePath)
  23 import Gargantext.API.Admin.Settings
  24 import Gargantext.Database.Admin.Types.Node (NodeId, NodeType)
  25 import Gargantext.Prelude
  26 import Gargantext.Core.Crypto.Hash
  27 import System.Directory (createDirectoryIfMissing)
  28 import System.Random (newStdGen)
  29 import qualified Data.Text             as Text
  30 import qualified System.Random.Shuffle as SRS
  31
  32 --------------------------------------------------------------------------
  33 shuffle :: MonadRandom m => [a] -> m [a]
  34 shuffle ns = SRS.shuffleM ns
  35
  36 --------------------------------------------------------------------------
  37 data NodeToHash = NodeToHash { nodeType :: NodeType
  38                              , nodeId   :: NodeId
  39                              }
  40
  41 type FolderPath = FilePath
  42 type FileName   = FilePath
  43
  44 toPath :: Int -> Text -> (FolderPath,FileName)
  45 toPath n x = (Text.unpack $ Text.intercalate "/" [x1,x2], Text.unpack xs)
  46   where
  47     (x1,x') = Text.splitAt n x
  48     (x2,xs) = Text.splitAt n x'
  49
  50 class SaveFile a where
  51   saveFile' :: FilePath -> a -> IO ()
  52
  53 class ReadFile a where
  54   readFile' :: FilePath -> IO a
  55
  56
  57 writeFile :: (MonadReader env m, MonadBase IO m, HasSettings env, SaveFile a)
  58          => a -> m FilePath
  59 writeFile a = do
  60   dataPath <- view (settings . fileFolder) <$> ask
  61   (fp,fn)  <- liftBase $ (toPath 3) . hash . show <$> newStdGen
  62
  63   let foldPath = dataPath <> "/" <> fp
  64       filePath = foldPath <> "/" <> fn
  65
  66   _ <- liftBase $ createDirectoryIfMissing True foldPath
  67   _ <- liftBase $ saveFile' filePath a
  68
  69   pure filePath
  70
  71
  72 readFile :: (MonadReader env m, MonadBase IO m, HasSettings env, ReadFile a)
  73          => FilePath -> m a
  74 readFile fp = do
  75   dataPath <- view (settings . fileFolder) <$> ask
  76   liftBase $ readFile' $ dataPath <> "/" <> fp