src/Data/Gargantext/Utils/SaveGetHash.hs

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