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 {-# LANGUAGE     NoImplicitPrelude       #-}
  13 {-# LANGUAGE     OverloadedStrings       #-}
  14
  15 module Gargantext.Prelude.Utils
  16   where
  17
  18 import Control.Lens (view)
  19 import Control.Monad.Reader (MonadReader)
  20 import Control.Monad.IO.Class (MonadIO, liftIO)
  21 import Control.Monad.Random.Class (MonadRandom)
  22 import Data.Text (Text)
  23 import Control.Monad.Reader (ask)
  24 import GHC.IO (FilePath)
  25 import Gargantext.Prelude
  26 import Gargantext.API.Settings
  27 import System.Random (newStdGen)
  28 import qualified System.Random.Shuffle as SRS
  29 import System.Directory (createDirectoryIfMissing)
  30 import qualified Data.ByteString.Lazy.Char8  as Char
  31 import qualified Data.Digest.Pure.SHA        as SHA (sha256, showDigest)
  32 import qualified Data.Text                   as Text
  33
  34
  35 shuffle :: MonadRandom m => [a] -> m [a]
  36 shuffle ns = SRS.shuffleM ns
  37
  38
  39 type FolderPath = FilePath
  40 type FileName   = FilePath
  41
  42
  43 hash :: Text -> Text
  44 hash = Text.pack
  45      .  SHA.showDigest
  46      .  SHA.sha256
  47      . Char.pack
  48      . Text.unpack
  49
  50
  51 toPath :: Int -> Text -> (FolderPath,FileName)
  52 toPath n x = (Text.unpack $ Text.intercalate "/" [x1,x2], Text.unpack xs)
  53   where
  54     (x1,x') = Text.splitAt n x
  55     (x2,xs) = Text.splitAt n x'
  56
  57 class SaveFile a where
  58   saveFile' :: FilePath -> a -> IO ()
  59
  60 class ReadFile a where
  61   readFile' :: FilePath -> IO a
  62
  63
  64 writeFile :: (MonadReader env m, MonadIO m, HasSettings env, SaveFile a)
  65          => a -> m FilePath
  66 writeFile a = do
  67   dataPath <- view (settings . fileFolder) <$> ask
  68   (fp,fn)  <- liftIO $ (toPath 3) . hash . Text.pack . show <$> newStdGen
  69
  70   let foldPath = dataPath <> "/" <> fp
  71       filePath = foldPath <> "/" <> fn
  72
  73   _ <- liftIO $ createDirectoryIfMissing True foldPath
  74   _ <- liftIO $ saveFile' filePath a
  75
  76   pure filePath
  77
  78
  79 readFile :: (MonadReader env m, MonadIO m, HasSettings env, ReadFile a)
  80          => FilePath -> m a
  81 readFile fp = do
  82   dataPath <- view (settings . fileFolder) <$> ask
  83   liftIO $ readFile' $ dataPath <> "/" <> fp