summaryrefslogtreecommitdiff
path: root/diddohs.hs
blob: 21bae077a49ed1008ba6827183398b91f9cb19e6 (plain)
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
import Control.Applicative( (<$>), (<*>) )
import Data.DateTime( diffSeconds )
import Data.List.Split( splitOn )
import Data.List( zipWith4, transpose )
import qualified Data.Map as Map
import Data.Maybe( fromJust, fromMaybe )
import Data.Time.Clock( UTCTime(..), secondsToDiffTime )
import Data.Time.Format( parseTime, formatTime )
import Data.Time.LocalTime( LocalTime(..), ZonedTime(..), zonedTimeToUTC, midnight, localDay )
import Diddo.Entry( DiddoEntry(..) )
import Diddo.Log( DiddoLogline(..) )
import HMSTime( HMSTime(..), secondsToHMS )
import System.Console.GetOpt
import System.Environment( getArgs )
import System.Exit
import System.IO( stderr, hPutStr, hPutStrLn )
import System.Locale

data Flag
  = Verbose         | Version
  | Help
  | InputFile String   | OutputFile String
  | InputFormat String | OutputFormat String
    deriving Show

options :: [OptDescr Flag]
options =
  [ Option "v"      ["verbose"]     (NoArg Verbose)                           "More detailed output"
  , Option "V"      ["version"]     (NoArg Version)                           "Display program version"
  , Option "h"      ["help"]        (NoArg Help)                              "Display program version"
  , Option "f"      ["file"]        (ReqArg InputFile "FILE")                 "Read from FILE"
  , Option "w"      ["output"]      (ReqArg OutputFile "FILE")                "Write to FILE"
  , Option "i"      ["informat"]    (ReqArg InputFormat "FORMAT")             "Parse dates in the given FORMAT"
  , Option "o"      ["outformat"]   (ReqArg OutputFormat "FORMAT")            "Output dates in the given FORMAT"
  ]

parseToZonedTime :: String -> String -> ZonedTime
parseToZonedTime format = fromMaybe (error "Input data broken.") . parseTime defaultTimeLocale format

parseISOsecondsTime :: String -> ZonedTime
parseISOsecondsTime = parseToZonedTime $ iso8601DateFormat $ Just "%T%z"

parseRFC822Time :: String -> ZonedTime
parseRFC822Time = parseToZonedTime rfc822DateFormat

formatZonedTime :: String -> ZonedTime -> String
formatZonedTime = formatTime defaultTimeLocale

utcTimesDeltas :: ZonedTime -> [UTCTime] -> [Integer]
utcTimesDeltas startTime timestamps =
  let
    startTimeUTC        = zonedTimeToUTC startTime
    relevantTimestamps  = dropWhile (< startTimeUTC) timestamps
  in
    zipWith diffSeconds relevantTimestamps $ startTimeUTC : init relevantTimestamps

startOfDay :: ZonedTime -> ZonedTime
startOfDay time = ZonedTime (LocalTime day midnight) $ zonedTimeZone time
  where
    day = localDay $ zonedTimeToLocalTime time

parseToUTCFromZonedString :: String -> String -> UTCTime
parseToUTCFromZonedString fmt time = zonedTimeToUTC $ parseToZonedTime fmt time

splitToMapOn :: String -> [String] -> Map.Map String [String]
splitToMapOn sep lines = Map.fromList $ map (listToTuple . splitOn sep) lines
  where listToTuple (x:xs) = (x, xs)

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 head $ Map.elems loglineMap
      parsedTimes           = Map.keys zonedtimeEntryMap

      deltasHMS             = map secondsToHMS $ utcTimesDeltas (startOfDay $ head parsedTimes) $ Map.keys utctimeEntryMap
    in
      zipWith4 DiddoEntry (formatZonedTime inDateFmt (startOfDay $ head parsedTimes) : init timeStamps)
                          timeStamps deltasHMS entryTexts

readFilesToLines :: [String] -> IO [String]
readFilesToLines filenames = lines . concat <$> mapM readFile filenames

main :: IO ()
main = do
  argv <- getArgs

  case getOpt Permute options argv of
    (opts,args,[])    -> do
      let
        logFileNames          = [file | InputFile file <- opts]
        inDateFmt             = head [fmt | InputFormat fmt <- opts]

      logLines                <- readFilesToLines logFileNames

      mapM_ print $ logLinesToDiddohs inDateFmt logLines

    (_,_,errs)        -> do
      hPutStr stderr $ usageInfo header options
      ioError (userError ('\n' : concat errs))
        where header = "Usage: diddohs [OPTION...]"