/
Storage.hs
113 lines (95 loc) · 3.89 KB
/
Storage.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
{- |
Conceptually, this library embeds a very basic key-value store
in the IO monad. Realistically, it does this by means of a
temporary directory holding files.
The API is almost too simple to bother mentioning. All operations
take a string 'Store Name', which is a namespace for keys. Keys are
always strings, and values must be members of the 'Read' and 'Show'
yypeclasses. Supported operations include storing data, getting data,
deleting keys, and destroying an entire store.
One thing to note is that the 'getValue' operation is designed to return
'IO Nothing' rather than ever allow an exception to escape. That means
that a read error will manifest as your application recieving 'Nothing'.
It is recommended that programs take care to call 'clearAll' before or
after using a store, as a precaution against the (very unlikely) situation
where a program manages to access ghost data from a previous invocation.
-}
{-# LANGUAGE CPP #-}
module System.IO.Storage
( putValue
, getValue
, delValue
, clearAll
, getValueDefault
) where
import System.IO ( readFile, writeFile )
import System.IO.Error ( try )
import System.FilePath ( (</>) )
import System.Directory ( getTemporaryDirectory, createDirectoryIfMissing
, doesFileExist, getDirectoryContents, removeFile
, removeDirectory, removeDirectoryRecursive )
import System.Environment ( getProgName )
import Data.List ( (\\) )
import Data.Maybe ( fromMaybe )
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
getIdentifier = do progName <- getProgName
return . stripChars $ "kv-store-" ++ progName ++ "-pid-hack"
where stripChars = filter (not . (`elem`"<>"))
#else
import System.Posix.Process ( getProcessID )
getIdentifier = do progName <- getProgName
procID <- getProcessID
return $ "kv-store-" ++ progName ++ "-" ++ procID
#endif
-- | We generate the storage path from the program name combined
-- with the PID. We basically just have to hope we don't get
-- the same *both* before the temp dir gets cleared.
getStoragePath :: String -> IO String
getStoragePath db = do
identifier <- getIdentifier
tempPath <- getTemporaryDirectory
return $ tempPath </> identifier </> db
-- | Stores a value
putValue :: Show a => String -> String -> a -> IO ()
putValue db key value = do
kvDir <- getStoragePath db
createDirectoryIfMissing True kvDir
let fileName = kvDir </> key
writeFile fileName $ show value
-- | Gets a value. Will return Nothing if anything goes wrong.
getValue :: Read a => String -> String -> IO (Maybe a)
getValue db key = do
kvDir <- getStoragePath db
let fileName = kvDir </> key
keyExists <- doesFileExist fileName
if keyExists
then do fileData <- readFile fileName
tryData <- try $ readIO fileData
case tryData of
Left _ -> return $ Nothing
Right v -> return $ Just v
else return Nothing
getValueDefault :: Read a => a -> String -> String -> IO a
getValueDefault v db key = fmap (fromMaybe v) (getValue db key)
-- | Delete a value from the store.
delValue :: String -> String -> IO ()
delValue db key = do
kvDir <- getStoragePath db
let fileName = kvDir </> key
tryData <- try $ removeFile key
case tryData of
Left _ -> return ()
Right _ -> return ()
-- | Clear an entire store. Try to call this before or after
-- using a store, or both if possible.
clearAll :: String -> IO ()
clearAll db = do
kvDir <- getStoragePath db
createDirectoryIfMissing True kvDir
removeDirectoryRecursive kvDir
-- Remove the program storage if necessary
progStorage <- getStoragePath ""
contents <- getDirectoryContents progStorage
if null $ contents \\ [".", ".."]
then removeDirectory progStorage
else return ()