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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
{-
srem --- Timed reminders as notifications
Copyright (C) 2015 Sean Whitton
This file is part of srem.
srem is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
srem is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with srem. If not, see <http://www.gnu.org/licenses/>.
-}
module Utility.EventCache ( purgeOldEventCaches
, appendManualEventCache
, refreshEmacsEventCache
, readEmacsEventCache
, readManualEventCache
) where
import Control.Applicative ((<$>))
import Control.Exception (IOException, catch)
import Control.Monad (filterM, forM_, when)
import qualified Control.SremConfig as SremConfig
import Data.List.Split (splitOn, splitOneOf)
import Data.Maybe.Read
import Data.Time.Calendar
import Data.Time.LocalTime
import System.Directory (createDirectoryIfMissing, doesFileExist,
getDirectoryContents, removeFile)
import System.FilePath ((</>))
import Types.Reminder
import Utility.Emacs
-- TODO: lockfiles?
-- #### User interface functions
purgeOldEventCaches :: IO ()
purgeOldEventCaches = do
dir <- SremConfig.getCacheDirectory
files <- getDirectoryContents dir
`catch` ((\_ -> return []) :: IOException -> IO [FilePath])
today <- localDay . zonedTimeToLocalTime <$> getZonedTime
forM_ files $ \file ->
when (fileIsOldCache today file) $ removeFile (dir </> file)
appendManualEventCache :: Reminder -> Day -> IO ()
appendManualEventCache r d = do
dir <- SremConfig.getCacheDirectory
createDirectoryIfMissing True dir
let path = dir </> "manual_" ++ (showGregorian d) ++ ".csv"
appendFile path $ makeEventsCSV [r]
refreshEmacsEventCache :: IO ()
refreshEmacsEventCache = do
date <- todaysCacheFileDateString
dir <- SremConfig.getCacheDirectory
let path = dir </> "emacs_" ++ date ++ ".csv"
removeFile path
`catch` ((\_ -> return ()) :: IOException -> IO ())
readEmacsEventCache :: IO [Reminder]
readEmacsEventCache = do
date <- todaysCacheFileDateString
dir <- SremConfig.getCacheDirectory
createDirectoryIfMissing True dir
let path = dir </> "emacs_" ++ date ++ ".csv"
doesFileExist path >>= \alreadyThere ->
if alreadyThere
then readEventsCSV path
else do
rems <- parseEmacsOutput <$> getEmacsOutput
writeFile path $ makeEventsCSV rems
return rems
readManualEventCache :: IO [Reminder]
readManualEventCache = do
date <- todaysCacheFileDateString
dir <- SremConfig.getCacheDirectory
let path = dir </> "manual_" ++ date ++ ".csv"
doesFileExist path >>= \alreadyThere ->
if alreadyThere
then readEventsCSV path
else return []
-- #### Internal functions
readEventsCSV :: FilePath -> IO [Reminder]
readEventsCSV f = readFile f >>= return . parseEventsCSV
parseEventsCSV :: String -> [Reminder]
parseEventsCSV = foldr step [] . lines
where
step r rs = maybe rs (: rs) $ parseEventCSV r
parseEventCSV :: String -> Maybe Reminder
parseEventCSV line = do
hourString:minuteString:text:[] <- return $ splitOn "," line
hour <- readMaybe hourString
minute <- readMaybe minuteString
makeReminder' hour minute text
makeEventsCSV :: [Reminder] -> String
makeEventsCSV = unlines . foldr ((:) . makeEventCSV) []
makeEventCSV :: Reminder -> String
makeEventCSV r = (show . getReminderHour $ r) ++ "," ++
(show . getReminderMinute $ r) ++ ","
++ getReminderText r
todaysCacheFileDateString :: IO String
todaysCacheFileDateString = showGregorian . localDay . zonedTimeToLocalTime
<$> getZonedTime
fileIsOldCache :: Day -> FilePath -> Bool
fileIsOldCache today file = length splitFile == 3
&& splitFile !! 0 `elem` ["manual", "emacs"]
&& (maybe False (< today) $ readDay $ splitFile !! 1)
&& splitFile !! 2 == "csv"
where
splitFile = splitOneOf "_." file
readDay :: String -> Maybe Day
readDay s = do
yearString:monthString:dayString:[] <- return $ splitOn "-" s
year <- readMaybe yearString
month <- readMaybe monthString
day <- readMaybe dayString
return $ fromGregorian year month day
|
