玩具:haskell写一个srt字幕时间轴偏移工具

**原创内容, 转载请注明
接受的srt字幕时间格式: 00:00:00,000 --> 00:00:00,000

不过接近0秒的地方往回调时会不会出错还没有测试,估计是得手动去掉不对的行,不过不影响观看.

module Main where
import Text.Parsec
import Text.Parsec.Prim
import Text.Parsec.Language
import qualified Text.Parsec.Token as P
import Control.Applicative hiding ((<|>))
import Text.Printf
import System.Environment

lxr = P.makeTokenParser emptyDef
integer = P.integer lxr
colon = P.colon lxr
symbol = P.symbol lxr
comma = P.comma lxr

data TT = TT Integer Integer Integer Integer Integer Integer Integer Integer
        | TX

instance Show TT where
  show (TT a b c d e f g h) =
    printf "%02u:%02u:%02u,%03u --> %02u:%02u:%02u,%03u" a b c d e f g h

timeLine =
 try (TT <$> integer <* colon
         <*> integer <* colon
         <*> integer <* comma
         <*> integer
         <* symbol "-->"
         <*> integer <* colon
         <*> integer <* colon
         <*> integer <* comma
         <*> integer)
 <|> return TX

main :: IO ()
main = do
  { args <- System.Environment.getArgs
  ; if args == [] then
      do { putStrLn "<(C)WuXingbo> Usage: SrtShift.exe '<' in.srt '>' out.srt"
         ; putStrLn " :: 1000 : delay 1000ms"
         ; putStrLn "                -1000 : forward 1000ms"
         ; putStrLn " redirect STDIN/STDOUT"
         ; return ()
         }
    else
      do {
         ; let a = head args
         ; let i = read a :: Integer
         ; interact $ shiftSrt i
         ; return ()
         }
  }

shiftSrt :: Integer -> String -> String
shiftSrt i ss = unlines $ map (tryShift i) (lines ss)

tryShift :: Integer -> String -> String
tryShift i s =
  case parse timeLine [] s of
    Right t@(TT a b c d e f g h) ->
      show $ shiftTime t i
    _ -> s

shiftTime :: TT -> Integer -> TT
shiftTime (TT a b c d e f g h) i =
  let (cd, d') = fullAdd 1000 (d, i)
      (cc, c') = fullAdd 60 (c, cd)
      (cb, b') = fullAdd 60 (b, cc)
      a' = a + cb
      (ch, h') = fullAdd 1000 (h, i)
      (cg, g') = fullAdd 60 (g, ch)
      (cf, f') = fullAdd 60 (f, cg)
      e' = e + cf
  in  TT a' b' c' d' e' f' g' h'

fullAdd :: Integer -> (Integer,Integer) -> (Integer,Integer)
fullAdd i (a,b) =
  let x = a + b
  in  (x `div` i, x `mod` i)