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 example of use:
  45 -- toPath 2 "gargantexthello"
  46 -- ("ga/rg","antexthello")
  47 --
  48 -- toPath 3 "gargantexthello"
  49 -- ("gar/gan","texthello")
  50
  51
  52 toPath :: Int -> Text -> (FolderPath,FileName)
  53 toPath n x = (Text.unpack $ Text.intercalate "/" [x1,x2], Text.unpack xs)
  54   where
  55     (x1,x') = Text.splitAt n x
  56     (x2,xs) = Text.splitAt n x'
  57
  58 class SaveFile a where
  59   saveFile' :: FilePath -> a -> IO ()
  60
  61 class ReadFile a where
  62   readFile' :: FilePath -> IO a
  63
  64
  65 writeFile :: (MonadReader env m, MonadBase IO m, HasSettings env, SaveFile a)
  66          => a -> m FilePath
  67 writeFile a = do
  68   dataPath <- view (settings . fileFolder) <$> ask
  69   (fp,fn)  <- liftBase $ (toPath 3) . hash . show <$> newStdGen
  70
  71   let foldPath = dataPath <> "/" <> fp
  72       filePath = foldPath <> "/" <> fn
  73
  74   _ <- liftBase $ createDirectoryIfMissing True foldPath
  75   _ <- liftBase $ saveFile' filePath a
  76
  77   pure filePath
  78
  79
  80 readFile :: (MonadReader env m, MonadBase IO m, HasSettings env, ReadFile a)
  81          => FilePath -> m a
  82 readFile fp = do
  83   dataPath <- view (settings . fileFolder) <$> ask
  84   liftBase $ readFile' $ dataPath <> "/" <> fp