src/Data/Gargantext/Utils/SaveGetHash_hs

   1 module Data.Gargantext.Utils.SaveGetHash where
   2
   3 import System.FilePath (addExtension, joinPath)
   4 import Data.ByteString.Lazy.Internal (ByteString)
   5 import Data.List (elem, intersperse, insert)
   6 import Data.List.Extra (chunksOf)
   7 import Data.Digest.Pure.MD5 (md5)
   8 import System.Directory (getDirectoryContents, createDirectory, findFile, createDirectoryIfMissing)
   9 import Control.Monad (foldM)
  10
  11 import Data.List (splitAt)
  12 import Data.ByteString.Lazy.Internal (packChars)
  13 import qualified Data.ByteString.Lazy as BL
  14
  15 import Codec.Compression.Zlib (compress, decompress)
  16
  17 data Config = Config {
  18       root          :: String
  19     , chunkSize     :: Int
  20     , compression   :: Bool
  21     } deriving Show
  22
  23 conf = Config {
  24       root="/tmp/robot"
  25     , chunkSize=2
  26     , compression = True
  27               }
  28
  29 chunkUrl :: Int -> ByteString -> [[Char]]
  30 chunkUrl a url = chunksOf a $ show $ md5 url
  31
  32 -- replace it with createDirectoryIfMissing
  33 existOrCreate :: [[Char]] -> FilePath -> IO [[Char]]
  34 existOrCreate path_ dir = do
  35     let path = joinPath path_
  36     let returnPath = return $ path_ ++ [dir]
  37
  38     is <- elem dir <$> getDirectoryContents path  -- ?
  39     case is of
  40       True  -> do
  41           returnPath
  42       False -> do
  43           createDirectory $ path ++ "/" ++ dir
  44           returnPath
  45
  46 doPath :: [[Char]] -> [FilePath] -> IO [[Char]]
  47 doPath root path = foldM (\x y -> existOrCreate x y) root path
  48
  49
  50 splitAt' :: Int -> Int -> [Char] -> ([Char], [Char], [Char])
  51 splitAt' i1 i2 x = (a, b, c) where
  52     (a, a') = splitAt i1 x
  53     (b, c)  = splitAt i2 a'
  54
  55
  56 -- ne pas écraser le fichier s'il existe
  57 -- spliter l'url proprement
  58 saveFile :: ByteString -> String -> IO String
  59 saveFile url'' file = do
  60     let url' = chunkUrl (chunkSize conf) url''
  61     let url = init url'
  62
  63     -- add extension according to the filetype
  64     let filename = Prelude.foldl addExtension (last url') ["html", "zlib"]
  65
  66     doPath [(root conf)] url
  67
  68     let path = (root conf) ++ "/" ++ joinPath url ++ "/" ++ filename
  69
  70     --case (findFile ["/tmp/sdfs"] "file.hmtl.zib"
  71     -- Nothing -> create
  72     -- _ -> change name
  73     case (compression conf) of
  74       True  -> BL.writeFile path (compress $ packChars file)
  75       False -> writeFile path file
  76     return path
  77
  78
  79 getFile :: FilePath -> IO ByteString
  80 getFile path = do
  81     case (compression conf) of
  82       True  -> decompress <$> BL.readFile path
  83       False -> packChars  <$> Prelude.readFile path
  84
  85
  86 -- resources
  87 -- add Resource
  88
  89
  90 -- levensthein distance...