diff --git a/src/SubFix.hs b/src/SubFix.hs index c36c50b..344ecc0 100644 --- a/src/SubFix.hs +++ b/src/SubFix.hs @@ -20,6 +20,8 @@ along with this program. If not, see . -} +{-# LANGUAGE LambdaCase, RecordWildCards #-} + module SubFix ( -- * Data Types Caption (..), @@ -29,8 +31,12 @@ module SubFix ( encode, ) where +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.State (StateT, evalStateT, get, put) import Data.Char (chr) +import SubFix.Internal (decodeTime) + -- | Defines a caption group data Caption = Caption { capID :: Int @@ -54,7 +60,7 @@ decode -> Either String [Caption] -- ^ The resulting caption list, or a message describing the error -- that occured. -decode = undefined +decode = evalStateT decodeLoop . lines -- | Encodes a list of caption groups encode :: [Caption] -> String @@ -72,4 +78,58 @@ checkNotes "" = "" checkNotes ('#' : '#' : str) = chr 0x2669 : checkNotes str checkNotes (ch : str) = ch : checkNotes str +decodeLoop :: StateT [String] (Either String) [Caption] +decodeLoop = get >>= \case + [] -> return [] + _ -> do + caption <- decodeNextCaption + captions <- decodeLoop + return $ caption : captions + +decodeNextCaption :: StateT [String] (Either String) Caption +decodeNextCaption = do + capID <- decodeID + (capStart, capEnd) <- decodeTimes + capText <- decodeText + return $ Caption {..} + +decodeID :: StateT [String] (Either String) Int +decodeID = do + line <- nextLine + case reads line of + [(val, "")] -> return val + _ -> lift $ Left "invalid caption ID" + +decodeTimes :: StateT [String] (Either String) (Integer, Integer) +decodeTimes = do + line <- nextLine + case words line of + [startStr, "-->", endStr] -> do + start <- case decodeTime startStr of + Just (val, "") -> return val + _ -> lift $ Left "invalid start time" + end <- case decodeTime endStr of + Just (val, "") -> return val + _ -> lift $ Left "invalid end time" + return (start, end) + _ -> lift $ Left "invalid time signature" + +decodeText :: StateT [String] (Either String) String +decodeText = get >>= \case + [] -> return "" + _ -> do + line <- nextLine + if line == "" + then return "" + else do + next <- decodeText + return $ line ++ "\n" ++ next + +nextLine :: StateT [String] (Either String) String +nextLine = get >>= \case + (line : remaining) -> do + put remaining + return line + [] -> lift $ Left "missing line" + --jl diff --git a/subfix.cabal b/subfix.cabal index de55d88..f97865e 100644 --- a/subfix.cabal +++ b/subfix.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 475ccf2c735b96ddd94fc9281d9e8e97ecf64c4b60cd6645112a6ffb72165873 +-- hash: ce33ad286b77569617c489030c5bec8597e68ad69f7a34c12d95ad54614a59f2 name: subfix version: 0.0.0 @@ -58,6 +58,7 @@ test-suite subfix-test main-is: Spec.hs other-modules: SubFix.ConvertSpec + SubFix.DecodeSpec SubFix.Internal.DecodeTimeSpec SubFix.Internal.TimestampSpec SubFix.InternalSpec diff --git a/test/SubFix/DecodeSpec.hs b/test/SubFix/DecodeSpec.hs new file mode 100644 index 0000000..87c922c --- /dev/null +++ b/test/SubFix/DecodeSpec.hs @@ -0,0 +1,160 @@ +{- + +subfix +Copyright (C) Jonathan Lamothe + +This program is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +This program is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program. If not, see . + +-} + +module SubFix.DecodeSpec (spec) where + +import Test.Hspec (Spec, context, describe, it, shouldBe) + +import SubFix (Caption (..), decode) +import SubFix.Internal (timestamp) + +spec :: Spec +spec = describe "decode" $ do + context "valid inputs" $ mapM_ + ( \(label, input, expected) -> + context label $ do + let Right results = decode input + + context "number of results" $ let + rlen = length results + elen = length expected + in it ("should be " ++ show elen) $ + rlen `shouldBe` elen + + mapM_ + ( \(num, r, e) -> + context ("result #" ++ show num) $ + it ("should be " ++ show e) $ + r `shouldBe` e + ) $ zip3 [(1::Int)..] results expected + ) + + -- label, input, expected + [ ( "empty", "", [] ) + , ( "one caption", oneCaption, oneCaption' ) + , ( "two captions", twoCaptions, twoCaptions' ) + , ( "three captions", threeCaptions, threeCaptions' ) + , ( "multi-line", multiLine, multiLine' ) + ] + + context "invalid inputs" $ mapM_ + ( \(label, input, expected) -> + context label $ let + Left result = decode input + in it ("should be: " ++ expected) $ + result `shouldBe` expected + ) + + -- label, input, expected + [ ( "bad ID", badID, badID' ) + , ( "bad start time", badStart, badStart' ) + , ( "bad end time", badEnd, badEnd' ) + , ( "bad separator", badSep, badSep' ) + ] + + where + oneCaption = unlines + [ "1" + , "01:02:03,004 --> 05:06:07,008" + , "foo" + ] + + oneCaption' = + [ Caption + { capID = 1 + , capStart = timestamp 1 2 3 4 + , capEnd = timestamp 5 6 7 8 + , capText = "foo\n" + } + ] + + twoCaptions = oneCaption ++ unlines + [ "" + , "2" + , "09:10:11,012 --> 13:14:15,016" + , "bar" + ] + + twoCaptions' = oneCaption' ++ + [ Caption + { capID = 2 + , capStart = timestamp 9 10 11 12 + , capEnd = timestamp 13 14 15 16 + , capText = "bar\n" + } + ] + + threeCaptions = twoCaptions ++ unlines + [ "" + , "3" + , "17:18:19,020 --> 21:22:23,024" + , "baz" + ] + + threeCaptions' = twoCaptions' ++ + [ Caption + { capID = 3 + , capStart = timestamp 17 18 19 20 + , capEnd = timestamp 21 22 23 24 + , capText = "baz\n" + } + ] + + multiLine = unlines + [ "1" + , "01:02:03,004 --> 05:06:07,008" + , "foo" + , "bar" + ] + + multiLine' = + [ Caption + { capID = 1 + , capStart = timestamp 1 2 3 4 + , capEnd = timestamp 5 6 7 8 + , capText = "foo\nbar\n" + } + ] + + badID = "asdf" + badID' = "invalid caption ID" + + badStart = unlines + [ "1" + , "asdf --> 01:02:03,004" + ] + + badStart' = "invalid start time" + + badEnd = unlines + [ "1" + , "01:02:03,004 --> asdf" + ] + + badEnd' = "invalid end time" + + badSep = unlines + [ "1" + , "01:02:03,004 asdf 05:06:07,008" + ] + + badSep' = "invalid time signature" + +--jl diff --git a/test/SubFixSpec.hs b/test/SubFixSpec.hs index 7a30e16..ffb3b65 100644 --- a/test/SubFixSpec.hs +++ b/test/SubFixSpec.hs @@ -23,12 +23,13 @@ module SubFixSpec (spec) where import Test.Hspec (Spec, describe) import qualified SubFix.InternalSpec as Internal - +import qualified SubFix.DecodeSpec as Decode import qualified SubFix.ConvertSpec as Convert spec :: Spec spec = describe "SubFix" $ do Internal.spec + Decode.spec Convert.spec --jl