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