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 Data.Text (Text)
  22 import Control.Monad.Reader (ask)
  23 import GHC.IO (FilePath)
  24 import Gargantext.Prelude
  25 import Gargantext.API.Settings
  26 import System.Random (newStdGen)
  27 import System.Directory (createDirectoryIfMissing)
  28 import qualified Data.ByteString.Lazy.Char8  as Char
  29 import qualified Data.Digest.Pure.SHA        as SHA (sha256, showDigest)
  30 import qualified Data.Text                   as Text
  31
  32 type FolderPath = FilePath
  33 type FileName   = FilePath
  34
  35
  36 hash :: Text -> Text
  37 hash = Text.pack
  38      .  SHA.showDigest
  39      .  SHA.sha256
  40      . Char.pack
  41      . Text.unpack
  42
  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, MonadIO m, HasSettings env, SaveFile a)
  58          => a -> m FilePath
  59 writeFile a = do
  60   dataPath <- view (settings . fileFolder) <$> ask
  61   (fp,fn)  <- liftIO $ (toPath 3) . hash . Text.pack . show <$> newStdGen
  62
  63   let foldPath = dataPath <> "/" <> fp
  64       filePath = foldPath <> "/" <> fn
  65
  66   _ <- liftIO $ createDirectoryIfMissing True foldPath
  67   _ <- liftIO $ saveFile' filePath a
  68
  69   pure filePath
  70
  71
  72 readFile :: (MonadReader env m, MonadIO m, HasSettings env, ReadFile a)
  73          => FilePath -> m a
  74 readFile fp = do
  75   dataPath <- view (settings . fileFolder) <$> ask
  76   liftIO $ readFile' $ dataPath <> "/" <> fp