module Time ( parseRecordingName, timeLabels, parseLog, LogEntry(..), Hour(..), hours, formatHour, parseHour, splitHour, nextHour, ) where import qualified Data.Time.Format as TimeFormat import qualified Data.Time.LocalTime as LocalTime import qualified Data.Time.Clock as Clock import Data.Time.LocalTime (LocalTime, TimeOfDay) import Data.Time.Calendar (Day, addDays) import qualified LabelChain import qualified System.Path as Path import Control.DeepSeq (NFData, rnf) import Control.Monad (guard) import qualified Data.List.Reverse.StrictElement as Rev import qualified Data.List.HT as ListHT import Data.Maybe (listToMaybe) import Data.Char (isSpace) {- | Parse time from file names like @T2014-03-11_18-01-27_0000111.WAV@. -} parseRecordingName :: Path.RelFile -> Maybe LocalTime parseRecordingName = TimeFormat.parseTimeM True TimeFormat.defaultTimeLocale "T%Y-%m-%d_%H-%M-%S_" . take (length "T2014-03-11_18-01-27_") . Path.toString timeLabels :: Double -> TimeOfDay -> LabelChain.T Double String timeLabels duration = fmap (TimeFormat.formatTime TimeFormat.defaultTimeLocale "%H:%M:%S") . LabelChain.fromAdjacentChunks . zip (chopDuration duration) . iterate nextSecond chopDuration :: Double -> [Double] chopDuration = let go dur = if dur>1 then 1 : go (dur-1) else [dur] in go nextSecond :: TimeOfDay -> TimeOfDay nextSecond = LocalTime.timeToTimeOfDay . (Clock.secondsToDiffTime 1 +) . LocalTime.timeOfDayToTime parseLogTime :: (String,String) -> Maybe LocalTime parseLogTime (date,time) = TimeFormat.parseTimeM True TimeFormat.defaultTimeLocale "%m/%d/%y %H:%M:%S" $ date ++ " " ++ time data LogEntry = Start FilePath | Stop | Recording Path.RelFile Double deriving Show parseLog :: String -> [Either String (LocalTime, LogEntry)] parseLog = filter (either (not . null) (const True)) . mergeAdjacent (\row0 row1 -> case (row0,row1) of ((fileName, Nothing), (_, Just (time, ["Monitoring_started"]))) -> Just $ Right (time, Start fileName) _ -> Nothing) (\(row,remd) -> maybe (Left row) Right $ do (time, ss) <- remd fmap ((,) time) $ case ss of ["Monitoring_stopped"] -> Just Stop [fileName, durStr] -> do path <- Path.maybe fileName listToMaybe $ do (dur, seconds) <- reads durStr guard (dropWhile isSpace seconds == "s") return $ Recording path dur _ -> Nothing) . map (\row -> (,) row $ do s0:s1:ss <- Just $ ListHT.chop ('\t'==) row dateTime <- parseLogTime (s0,s1) return (dateTime, ss)) . map (Rev.dropWhile ('\r'==)) . lines mergeAdjacent :: (a -> a -> Maybe b) -> (a -> b) -> [a] -> [b] mergeAdjacent g f = let go [] = [] go [x] = [f x] go (x0:x0s@(x1:x1s)) = case g x0 x1 of Nothing -> f x0 : go x0s Just y -> y : go x1s in go data Hour = Hour {hourDay :: Day, hourOfDay :: Int} deriving (Eq, Ord, Show) instance NFData Hour where rnf (Hour day hour) = rnf (day, hour) hours :: LocalTime -> LabelChain.T Double Hour hours start = let (h,s) = splitHour start in LabelChain.fromAdjacentChunks . zip (max 0 (3600 - s) : repeat 3600) . iterate nextHour $ h formatHour :: String -> Hour -> String formatHour fmt = TimeFormat.formatTime TimeFormat.defaultTimeLocale fmt . localTimeFromHour localTimeFromHour :: Hour -> LocalTime localTimeFromHour (Hour day hour) = LocalTime.LocalTime { LocalTime.localDay = day, LocalTime.localTimeOfDay = LocalTime.midnight{LocalTime.todHour = hour} } parseHour :: String -> String -> Maybe Hour parseHour fmt = fmap hourFromLocalTime . TimeFormat.parseTimeM True TimeFormat.defaultTimeLocale fmt hourFromLocalTime :: LocalTime -> Hour hourFromLocalTime time = Hour (LocalTime.localDay time) (LocalTime.todHour $ LocalTime.localTimeOfDay time) splitHour :: LocalTime -> (Hour, Double) splitHour (LocalTime.LocalTime { LocalTime.localDay = day, LocalTime.localTimeOfDay = tod }) = (Hour day (LocalTime.todHour tod), fromIntegral (LocalTime.todMin tod) * 60 + realToFrac (LocalTime.todSec tod)) nextHour :: Hour -> Hour nextHour (Hour day hour0) = let (dayInc, hour1) = divMod (hour0+1) 24 in Hour (addDays (fromIntegral dayInc) day) hour1