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
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
|
import Control.Applicative( (<$>), (<*>) )
import Control.Monad( when, unless )
import Data.DateTime( diffSeconds )
import Data.List.Split( splitOn )
import Data.List( zipWith4, intercalate )
import qualified Data.Map as Map
import Data.Maybe( fromMaybe, fromJust )
import Data.Time.Clock( UTCTime(..) )
import Data.Time.Format( parseTime, formatTime )
import Data.Time.LocalTime( LocalTime(..), ZonedTime(..), TimeZone(..), zonedTimeToUTC, utcToZonedTime, midnight, localDay )
import Diddo( DiddoEntry(..), DiddoEntry2(..), LogEntry(..), LogLine(..), parseDiddoLogline, formatDiddoEntry, timestamp, logToDiddoEntry )
import HMSTime( secondsToHMS )
import System.Console.GetOpt
import System.Environment( getArgs )
import System.Exit( exitSuccess, exitFailure )
import System.IO( stdin, stdout, stderr, hPutStr, hPutStrLn )
import System.Locale
data Opt = Opt
{ optVerbose :: Bool
, optVersion :: Bool
, optHelp :: Bool
, optInputFiles :: [String]
, optOutputFile :: String
, optInputFormat :: String
, optOutputFormat :: String
, optStartDate :: String
, optEndDate :: String
}
defaultOpts :: Opt
defaultOpts = Opt
{ optVerbose = False
, optVersion = False
, optHelp = False
, optInputFiles = []
, optOutputFile = ""
, optInputFormat = "%FT%T%z"
, optOutputFormat = "%FT%T%z"
, optStartDate = ""
, optEndDate = ""
}
availableOptions :: [OptDescr (Opt -> IO Opt)]
availableOptions =
[ Option ['h'] ["help"]
(NoArg (\_ -> putStrLn (usageInfo "Usage: diddohs [OPTION...]" availableOptions) >> exitSuccess))
"Display program help"
, Option ['v'] ["verbose"]
(NoArg (\opts -> return opts { optVerbose = True }))
"More detailed output"
, Option ['V'] ["version"]
(NoArg (\opts -> return opts { optVersion = True }))
"Display program version"
, Option ['f'] ["file"]
(ReqArg (\arg opts -> return opts { optInputFiles = optInputFiles opts ++ [arg]}) "FILE" )
"Read from FILE"
, Option ['w'] ["output"]
(ReqArg (\arg opts -> return opts { optOutputFile = arg }) "FILE")
"Write to FILE"
, Option ['i'] ["informat"]
(ReqArg (\arg opts -> return opts { optInputFormat = arg }) "FORMAT")
"Timeformat used in input"
, Option ['o'] ["outformat"]
(ReqArg (\arg opts -> return opts { optOutputFormat = arg }) "FORMAT")
"Timeformat used in output"
, Option ['s'] ["start"]
(ReqArg (\arg opts -> return opts { optStartDate = arg }) "DATE")
"Start of reporting period"
, Option ['e'] ["end"]
(ReqArg (\arg opts -> return opts { optEndDate = arg }) "DATE")
"End of reporting period"
]
-- SECTION: parsing to ZonedTime
parseToZonedTime :: String -> String -> ZonedTime
parseToZonedTime format string = fromMaybe (error $ "Input data broken: " ++ string) $ parseTime defaultTimeLocale format string
parseISOsecondsTime :: String -> ZonedTime
parseISOsecondsTime = parseToZonedTime $ iso8601DateFormat $ Just "%T%z"
parseRFC822Time :: String -> ZonedTime
parseRFC822Time = parseToZonedTime rfc822DateFormat
-- SECTION: parsing to ZonedTime
-- SECTION: handling ZonedTime
formatZonedTime :: String -> ZonedTime -> String
formatZonedTime = formatTime defaultTimeLocale
startOfDay :: ZonedTime -> ZonedTime
startOfDay time = ZonedTime (LocalTime day midnight) $ zonedTimeZone time
where
day = localDay $ zonedTimeToLocalTime time
startOfMonth :: ZonedTime -> ZonedTime
startOfMonth time = ZonedTime (LocalTime day midnight) $ zonedTimeZone time
where
day = localDay $ zonedTimeToLocalTime time
-- SECTION: handling ZonedTime
-- SECTION: handling UTCTime
utcTimesDeltas :: [UTCTime] -> [Integer]
utcTimesDeltas [] = error "Function utcTimesDeltas called with no argument"
utcTimesDeltas [_] = error "Function utcTimesDeltas called with bougus argument"
utcTimesDeltas (x:y:[]) = [diffSeconds y x]
utcTimesDeltas (x:y:xs) = diffSeconds y x : utcTimesDeltas (y:xs)
--deltaAndEntry :: Map UTCTime Diddo.LogLine -> DiddoEntry2
--deltaAndEntry dddLoglineMap = Map.mapWithKey findDeltaEntry dddLoglineMap
-- where
-- precEntry = case Map.lookupLT (Diddo.timestamp logentry) dddLoglineMap of
-- Just x -> x
-- Nothing -> Diddo.timestamp logentry
-- end = utcToZonedTime (Diddo.timezone logentry) (Diddo.timestamp logentry)
-- start = utcToZonedTime (Diddo.timezone logentry) (fst precEntry)
-- delta = diffSeconds end start
-- comment = Diddo.text logentry
--
--findDeltaEntry timestamp logentry = Diddo.DiddoEntry2 start end delta comment
mapToDiddoEntries :: Map.Map UTCTime Diddo.LogEntry -> Map.Map UTCTime Diddo.DiddoEntry2
mapToDiddoEntries logmap = Map.mapWithKey toDddEntry logmap
where
toDddEntry timestamp logentry = Diddo.logToDiddoEntry (preceedingTimestamp timestamp) logentry
preceedingTimestamp x = case Map.lookupLT x logmap of
Just y -> fst y
Nothing -> fst $ Map.findMin logmap
-- SECTION: handling UTCTime
-- SECTION: handling rawinput
splitToMapOn :: String -> [String] -> Map.Map String [String]
splitToMapOn sep loglines = Map.fromList $ map (listToTuple . splitOn sep) loglines
where listToTuple (x:xs) = (x, xs)
listToTuple [] = ("",[""])
logLinesToDiddohs :: String -> [String] -> [DiddoEntry]
logLinesToDiddohs inDateFmt logLines =
let
loglineMap = splitToMapOn ";" logLines
zonedtimeEntryMap = Map.mapKeysMonotonic (parseToZonedTime inDateFmt) loglineMap
utctimeEntryMap = Map.mapKeys zonedTimeToUTC zonedtimeEntryMap
timeStamps = Map.keys loglineMap
entryTexts = map (intercalate ";") $ Map.elems loglineMap
parsedTimes = Map.keys zonedtimeEntryMap
deltasHMS = map secondsToHMS $ utcTimesDeltas ((zonedTimeToUTC $ startOfDay $ head parsedTimes) : Map.keys utctimeEntryMap)
in
zipWith4 DiddoEntry (formatZonedTime inDateFmt (startOfDay $ head parsedTimes) : init timeStamps)
timeStamps deltasHMS entryTexts
-- SECTION: handling rawinput
main :: IO ()
main = do
-- SECTION: option processing
(givenOptions,args,errs) <- getArgs >>= return . getOpt Permute availableOptions
unless (null errs) $ do
mapM_ (hPutStr stderr) errs
exitFailure
effectiveOptions <- foldl (>>=) (return defaultOpts) givenOptions
-- SECTION: option processing
dddLines <-
map Diddo.LogLine <$> case optInputFiles effectiveOptions of
files@(_:_) -> lines . concat <$> mapM readFile files
[] -> lines <$> getContents
dddLogEntries <-
map Diddo.parseDiddoLogline <$> case optInputFiles effectiveOptions of
files@(_:_) -> lines . concat <$> mapM readFile files
[] -> lines <$> getContents
let
dddLogEntryMap = Map.fromList $ map (\diddo -> (Diddo.timestamp diddo, diddo)) dddLogEntries
diddoEntriesMap = mapToDiddoEntries dddLogEntryMap
inDateFmt = optInputFormat effectiveOptions
outDateFmt = optOutputFormat effectiveOptions
-- DEBUG
mapM_ putStrLn args
-- DEBUG
mapM_ print $ logLinesToDiddohs inDateFmt (map show dddLines)
-- putStrLn "new code output following"
-- mapM_ (print . snd) $ Map.toAscList diddoEntriesMap
putStrLn "new code output following"
mapM_ (putStrLn . snd) $ Map.toAscList $ Map.map (Diddo.formatDiddoEntry outDateFmt) diddoEntriesMap
|
