vrt-subtitles.hs

1
import System.Environment
2
import Data.Time
3
import Text.Regex.PCRE -- Necessary for determining the type of String in the input
4
main = do
5
  args <- getArgs -- Gives list of given arguments
6
  fileContents <- readFile (head args) -- <- turns the IO String in a String
7
                  -- inside fileContents
8
  writeFile (last args) (correctFile fileContents)
9
  -- This is EVERYTHING that main is supposed to do, so it's FINISHED.
10
  -- From now the program works purely functional. Other lines on this
11
  -- indentation are for debugging.
12
13
-- | Entry function for the program. It receives the "raw" file content from
14
-- 'main', applies some necessary changes, and returns the corrected 'String',
15
-- ready for writing to a file.
16
correctFile :: String -> String
17
correctFile [] = []
18
correctFile input = unlines ("WEBVTT" : (editLines (lines input) (-60)))
19
    -- The "WEBVTT" in the front is necessary to comply with WebVTT specs
20
    -- The -60 initial seconds is necessary because the files start with an
21
    -- X-TIMESTAMP line
22
23
24
-- | Transforms the Strings from the file by inspecting the type and editing the
25
-- resulting list of Strings accordingly.
26
-- This function is applied in a recursive manner,
27
editLines :: [String] -- ^ The remaining lines of the original file
28
          -> Int      -- ^ The amount of seconds that will be added 
29
          -> [String] -- ^ The corrected lines, ready for writing
30
editLines [] _ = [] -- If the list of remaining Strings is depleted, return an empty list
31
editLines (current : remaining) seconds
32
  | current =~ "X-TIMESTAMP-MAP=MPEGTS:[0-9]+,LOCAL:[0-9:.]+" :: Bool = editLines remaining (seconds + 60)
33
  | current =~ "([0-9]{2}:)?[0-9]{2}:[0-9]{2}.[0-9]{3} --> ([0-9]{2}:)?[0-9]{2}:[0-9]{2}.[0-9]{3}" :: Bool = correctTimeString current seconds : editLines remaining seconds
34
  | current == "WEBVTT" = editLines remaining seconds
35
  | otherwise = current : editLines remaining seconds
36
37
correctTimeString :: String -> Int -> String
38
correctTimeString s 0 = s
39
correctTimeString s seconds =
40
    let start = vttTimeToUTCTime (head (words s))
41
        end = vttTimeToUTCTime (last (words s))
42
        delta = diffUTCTime end start
43
        correctStart = addOffset start seconds
44
    in uTCTimeToVttTime correctStart ++ " --> " ++ uTCTimeToVttTime (addUTCTime delta correctStart)
45
  
46
addOffset :: UTCTime -> Int -> UTCTime
47
addOffset time seconds = addUTCTime (fromInteger (toInteger (seconds)) :: NominalDiffTime) time
48
49
uTCTimeToVttTime :: UTCTime -> String
50
uTCTimeToVttTime t = formatTime defaultTimeLocale "%T%03Q" t
51
52
vttTimeToUTCTime :: String -> UTCTime
53
vttTimeToUTCTime timeString =
54
    parseTimeOrError False defaultTimeLocale "%T%Q" timeString :: UTCTime
55