/
InjectEvent.hs
133 lines (108 loc) · 5.38 KB
/
InjectEvent.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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
-- Copyright 2010 Leonid Movshovich <event.riga@gmail.com>
-- This file is part of SPIM.
-- SPIM is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
-- SPIM 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 Affero General Public License for more details.
-- You should have received a copy of the GNU Affero General Public License
-- along with SPIM. If not, see <http://www.gnu.org/licenses/>.
module Main where
import IO
import qualified System.Environment as SysEnv
import qualified System.Directory as SysDir
import qualified System.Exit as Exit
import qualified System.Locale as Locale
import qualified SpimCommon as Spim
import qualified MIMEDir as MD
import qualified Data.Map as Map
import qualified Data.List as List
import qualified Data.Time.Format as TimeFormat
import qualified Data.Time.LocalTime as Time
import qualified Data.Time.Clock as Clock
import qualified Data.Time.Calendar as Cal
import Data.Time.LocalTime (LocalTime)
import Data.Ratio ((%))
--default (Int)
eventTypes = Map.fromList [("TIME", processTimeUpdate), ("GEO", processGeoUpdate)]
main :: IO()
main = do repoDir:eventType:params <- SysEnv.getArgs
isRepo <- Spim.isSpimRepo repoDir
if not isRepo
then do putStr ("Error: '" ++ repoDir ++ "' is not a spim repository")
Exit.exitWith (Exit.ExitFailure Spim.badRepoEC)
else do oldDir <- SysDir.getCurrentDirectory
SysDir.setCurrentDirectory repoDir
case Map.lookup eventType eventTypes of
Just f -> do f params
Nothing ->
do putStr ("Event type '" ++ eventType ++ "' is not supported")
do SysDir.setCurrentDirectory oldDir
{-
time in index must fall in this bounds comparing to time submitted from command line
for corresponding object to be triggered
-}
secDiffToTrigger = (-6, 6)
-- longMin longMax latMin latMax
degreeDiffToTrigger = ((-0.000001, 0.000001), (-0.000001, 0.000001))
processTimeUpdate :: [String] -> IO ()
processTimeUpdate (localTs:[]) = do
let newTime = case TimeFormat.parseTime Locale.defaultTimeLocale MD.dateFormat localTs of
Just t -> t
Nothing -> error "Failed to parse time"
alarmIdx:[] <- Spim.loadIndicesByKinds ["VALARM"]
curTZ <- Time.getCurrentTimeZone
let triggeredObjects = findTimeTriggeredObjects newTime secDiffToTrigger curTZ alarmIdx
returnObjects triggeredObjects
returnObjects :: [String] -> IO ()
returnObjects = putStr . show
findTimeTriggeredObjects :: LocalTime -> (Int, Int) -> Time.TimeZone -> MD.MIMEDir -> [String]
findTimeTriggeredObjects now (lowBound, highBound) tz
= MD.filterValuesWProps (\ pN props -> isTimeWithinBounds (incTime now lowBound)
(incTime now highBound) tz pN)
incTime :: LocalTime -> Int -> LocalTime
incTime base diff
= let resFrac = ((Time.timeOfDayToDayFraction . Time.localTimeOfDay) base)
+ ((toInteger diff) % secInDay) where secInDay = 24*60*60
d = Time.localDay base
in
if resFrac < 1 then
Time.LocalTime d (Time.dayFractionToTimeOfDay resFrac)
else
Time.LocalTime (Cal.addDays 1 d) (Time.dayFractionToTimeOfDay (resFrac - 1))
isTimeWithinBounds :: LocalTime -> LocalTime -> Time.TimeZone -> MD.PropName -> Bool
isTimeWithinBounds lowTime highTime tz trgTime
= let alarmTime = getLocalFromUTC trgTime tz in
(alarmTime > lowTime) && (alarmTime < highTime)
getLocalFromUTC :: MD.PropName -> Time.TimeZone -> LocalTime
getLocalFromUTC strTimeUTC tz
= case TimeFormat.parseTime Locale.defaultTimeLocale MD.dateFormat strTimeUTC of
Just utcTime -> Time.utcToLocalTime tz utcTime
Nothing -> error ("time string '" ++ strTimeUTC ++ "' is not a valid iCal time")
processGeoUpdate :: [String] -> IO ()
processGeoUpdate (lo:la:[]) = do
let longitude = read lo
latitude = read la
alarmIdx:[] <- Spim.loadIndicesByKinds ["X-SPIM-VGEOALARM"]
let triggeredObjects = findGeoTriggeredObjects (longitude, latitude) alarmIdx
returnObjects triggeredObjects
findGeoTriggeredObjects :: (Float, Float) -> MD.MIMEDir -> [String]
findGeoTriggeredObjects (long, lat) idx
= let longMin = long + ((fst . fst) degreeDiffToTrigger)
longMax = long + ((snd . fst) degreeDiffToTrigger)
latMin = lat + ((fst . snd) degreeDiffToTrigger)
latMax = lat + ((snd . snd) degreeDiffToTrigger)
in
MD.filterValues
(\ pN -> isGeoWithinBounds (longMin, longMax) (latMin, latMax) (toLongLat pN)) idx
isGeoWithinBounds :: (Float, Float) -> (Float, Float) -> (Float, Float) -> Bool
isGeoWithinBounds longBounds latBounds (long, lat)
= long `between` longBounds && lat `between` latBounds
where between :: (Ord a) => a -> (a, a) -> Bool
between v (low, high) = v > low && v < high
toLongLat :: String -> (Float, Float)
toLongLat s = let (strLong, 'x':strLat) = break (== 'x') s in
(read strLong, read strLat)