]> Git — Sourcephile - gargantext.git/blob - src/Data/Gargantext/Utils/SaveGetHash_hs
[FIX] hpack-convert for automatic gargantext.cabal updates (thx yann).
[gargantext.git] / 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...