-
Notifications
You must be signed in to change notification settings - Fork 0
/
Storage.hs
50 lines (42 loc) · 1.83 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
module Storage (
store
, removeRoot
, BackupPolicy(..)
, workspace
, daily
, hourly
, weekly
, monthly
, dispatch
, backups
, dates
) where
import System.Directory (doesFileExist, createDirectoryIfMissing)
import Data.List (sort, union, nub)
import System.FilePath ((</>), takeDirectory, pathSeparator, isPathSeparator)
import System.IO (IOMode(..), readFile, writeFile)
import Control.Monad (filterM)
workspace = "/Users/nschoe/Documents/Storage" -- For my dev' purpose of course, need to be set.
daily = workspace </> "schedule" </> "daily"
hourly = workspace </> "schedule" </> "hourly"
weekly = workspace </> "schedule" </> "weekly"
monthly = workspace </> "schedule" </> "monthly"
dispatch :: [(BackupPolicy, FilePath)]
dispatch = [(Daily, daily), (Hourly, hourly), (Weekly, weekly), (Monthly, monthly)]
backups = workspace </> "backups"
dates = workspace </> "dates"
data BackupPolicy = Monthly | Weekly | Daily | Hourly
deriving (Eq, Show, Read)
-- Take a list of files, keep the existing ones, sort them, update the hierarchy, and add them to the appropriate schedule file.
store :: [FilePath] -> BackupPolicy -> IO ()
store xs pol = do
files <- filterM doesFileExist xs
let sche = maybe daily id (lookup pol dispatch)
existing <- readFile sche
let updated = unlines . sort $ files `union` lines existing
updated `seq` (updateHierarchy (lines updated) >> writeFile sche updated)
-- Update the hard disk print in the backup directory
updateHierarchy :: [FilePath] -> IO ()
updateHierarchy = mapM_ (createDirectoryIfMissing True . (</>) backups . removeRoot . takeDirectory)
removeRoot :: FilePath -> FilePath
removeRoot = dropWhile isPathSeparator