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.Config
  24 import Gargantext.API.Admin.Settings
  25 import Gargantext.Database.Admin.Types.Node (NodeId, NodeType)
  26 import Gargantext.Prelude
  27 import Gargantext.Core.Crypto.Hash
  28 import System.Directory (createDirectoryIfMissing)
  29 import System.Random (newStdGen)
  30 import qualified Data.Text             as Text
  31 import qualified System.Random.Shuffle as SRS
  32
  33 --------------------------------------------------------------------------
  34 shuffle :: MonadRandom m => [a] -> m [a]
  35 shuffle ns = SRS.shuffleM ns
  36
  37 --------------------------------------------------------------------------
  38 data NodeToHash = NodeToHash { nodeType :: NodeType
  39                              , nodeId   :: NodeId
  40                              }
  41
  42 type FolderPath = FilePath
  43 type FileName   = FilePath
  44
  45 -- | toPath example of use:
  46 -- toPath 2 "gargantexthello"
  47 -- ("ga/rg","antexthello")
  48 --
  49 -- toPath 3 "gargantexthello"
  50 -- ("gar/gan","texthello")
  51
  52
  53 toPath :: Int -> Text -> (FolderPath,FileName)
  54 toPath n x = (Text.unpack $ Text.intercalate "/" [x1,x2], Text.unpack xs)
  55   where
  56     (x1,x') = Text.splitAt n x
  57     (x2,xs) = Text.splitAt n x'
  58
  59 class SaveFile a where
  60   saveFile' :: FilePath -> a -> IO ()
  61
  62 class ReadFile a where
  63   readFile' :: FilePath -> IO a
  64
  65
  66 writeFile :: (MonadReader env m, MonadBase IO m, HasSettings env, SaveFile a)
  67          => a -> m FilePath
  68 writeFile a = do
  69   dataPath <- view (settings . config . gc_datafilepath) <$> ask
  70   (fp,fn)  <- liftBase $ (toPath 3) . hash . show <$> newStdGen
  71
  72   let foldPath = dataPath <> "/" <> fp
  73       filePath = foldPath <> "/" <> fn
  74
  75   _ <- liftBase $ createDirectoryIfMissing True foldPath
  76   _ <- liftBase $ saveFile' filePath a
  77
  78   pure filePath
  79
  80
  81 readFile :: (MonadReader env m, MonadBase IO m, HasSettings env, ReadFile a)
  82          => FilePath -> m a
  83 readFile fp = do
  84   dataPath <- view (settings . config . gc_datafilepath) <$> ask
  85   liftBase $ readFile' $ dataPath <> "/" <> fp