diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,12 @@ +## Cue sheet 1.0.0 + +* Uses Megaparsec 6. + +* Adjusted the `Eec` type to use it with Megaparsec 6. + +* The `parseCueSheet` function now accepts strict `ByteString` instead of + lazy one. + ## CUE sheet 0.1.1 * Improved documentation. diff --git a/Text/CueSheet/Parser.hs b/Text/CueSheet/Parser.hs --- a/Text/CueSheet/Parser.hs +++ b/Text/CueSheet/Parser.hs @@ -24,22 +24,24 @@ import Control.Applicative import Control.Monad.State.Strict +import Data.ByteString (ByteString) import Data.Data (Data) import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (isJust, fromMaybe) +import Data.Set (Set) import Data.Text (Text) import Data.Typeable (Typeable) +import Data.Word (Word8) import GHC.Generics import Numeric.Natural import Text.CueSheet.Types import Text.Megaparsec -import qualified Data.ByteString.Char8 as B8 -import qualified Data.ByteString.Lazy as BL -import qualified Data.List.NonEmpty as NE -import qualified Data.Set as E -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Text.Megaparsec.Lexer as L +import Text.Megaparsec.Byte +import qualified Data.List.NonEmpty as NE +import qualified Data.Set as E +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Text.Megaparsec.Byte.Lexer as L ---------------------------------------------------------------------------- -- Types @@ -47,28 +49,20 @@ -- | Extended error component with support for storing number of track -- declaration in which a parsing error has occurred. -data Eec = Eec (Maybe Natural) (Maybe CueParserFailure) +data Eec = Eec (Maybe Natural) CueParserFailure deriving (Show, Eq, Ord, Data, Typeable, Generic) -instance ErrorComponent Eec where - representFail = - Eec Nothing . Just . CueParserFail - representIndentation ord p0 p1 = - (Eec Nothing . Just) (CueParserIndentation ord p0 p1) - instance ShowErrorComponent Eec where - showErrorComponent (Eec mtrack mfailure) = - maybe "" ((++ "\n") . showErrorComponent) mfailure ++ + showErrorComponent (Eec mtrack failure') = + showErrorComponent failure' ++ "\n" ++ maybe "" (\n -> "in declaration of the track " ++ show n) mtrack -- | The enumeration of all failures that may happen during running of -- 'parseCueSheet'. data CueParserFailure - = CueParserFail String - -- ^ 'fail' was used (should not happen) - | CueParserIndentation Ordering Pos Pos - -- ^ Incorrect indentation (should not happen) + = CueParserTrivialError (Maybe (ErrorItem Word8)) (Set (ErrorItem Word8)) + -- ^ A wrapper for a trivial error | CueParserInvalidCatalog Text -- ^ We ran into an invalid media catalog number | CueParserInvalidCueText Text @@ -87,10 +81,9 @@ instance ShowErrorComponent CueParserFailure where showErrorComponent = \case - CueParserFail msg -> - showErrorComponent (DecFail msg) - CueParserIndentation ord p0 p1 -> - showErrorComponent (DecIndentation ord p0 p1) + CueParserTrivialError us es -> + init $ parseErrorTextPretty + (TrivialError undefined us es :: ParseError Word8 Eec) CueParserInvalidCatalog txt -> "the value \"" ++ T.unpack txt ++ "\" is not a valid Media Catalog Number" CueParserInvalidCueText txt -> @@ -104,11 +97,11 @@ CueParserInvalidFrames n -> "\"" ++ show n ++ "\" is not a valid number of frames" CueParserTrackIndexOutOfOrder -> - "this index apprears out of order" + "this index appears out of order" -- | Type of parser we use here, it's not public. -type Parser a = StateT Context (Parsec Eec BL.ByteString) a +type Parser a = StateT Context (Parsec Eec ByteString) a -- | Context of parsing. This is passed around in 'StateT'. We need all of -- this to signal parse errors on duplicate declarations of things that @@ -138,8 +131,8 @@ parseCueSheet :: String -- ^ File name to include in error messages - -> BL.ByteString -- ^ CUE sheet to parse as a lazy 'BL.ByteString' - -> Either (ParseError Char Eec) CueSheet -- ^ 'ParseError' or result + -> ByteString -- ^ CUE sheet to parse as a lazy 'BL.ByteString' + -> Either (ParseError Word8 Eec) CueSheet -- ^ 'ParseError' or result parseCueSheet = parse (contextCueSheet <$> execStateT pCueSheet initContext) where initContext = Context @@ -183,7 +176,7 @@ pCatalog :: Parser () pCatalog = do already <- gets (isJust . cueCatalog . contextCueSheet) - let f x' = let x = decodeUtf8 x' in + let f x' = let x = T.decodeUtf8 x' in case mkMcn x of Nothing -> Left (CueParserInvalidCatalog x) Just mcn -> Right mcn @@ -194,14 +187,14 @@ pCdTextFile :: Parser () pCdTextFile = do already <- gets (isJust . cueCdTextFile . contextCueSheet) - cdTextFile <- decodeUtf8 <$> labelledLit already Right "CDTEXTFILE" + cdTextFile <- T.decodeUtf8 <$> labelledLit already Right "CDTEXTFILE" modify $ \x -> x { contextCueSheet = (contextCueSheet x) { cueCdTextFile = Just (T.unpack cdTextFile) } } pPerformer :: Parser () pPerformer = do already <- gets (isJust . cuePerformer . contextCueSheet) - let f x' = let x = decodeUtf8 x' in + let f x' = let x = T.decodeUtf8 x' in case mkCueText x of Nothing -> Left (CueParserInvalidCueText x) Just txt -> Right txt @@ -212,7 +205,7 @@ pTitle :: Parser () pTitle = do already <- gets (isJust . cueTitle . contextCueSheet) - let f x' = let x = decodeUtf8 x' in + let f x' = let x = T.decodeUtf8 x' in case mkCueText x of Nothing -> Left (CueParserInvalidCueText x) Just txt -> Right txt @@ -223,7 +216,7 @@ pSongwriter :: Parser () pSongwriter = do already <- gets (isJust . cueSongwriter . contextCueSheet) - let f x' = let x = decodeUtf8 x' in + let f x' = let x = T.decodeUtf8 x' in case mkCueText x of Nothing -> Left (CueParserInvalidCueText x) Just txt -> Right txt @@ -234,12 +227,12 @@ pRem :: Parser () pRem = do void (symbol "REM") - manyTill anyChar eol *> scn + takeWhileP (Just "character") (/= 10) *> char 10 *> scn pFile :: Parser () pFile = do void (symbol "FILE") - filename <- decodeUtf8 <$> lexeme stringLit + filename <- T.decodeUtf8 <$> lexeme stringLit let pFiletype = choice [ Binary <$ symbol "BINARY" , Motorola <$ symbol "MOTOROLA" @@ -267,7 +260,7 @@ if firstTrack || x == trackOffset + trackCount then Right x else Left CueParserTrackOutOfOrder - n <- withCheck f (fromIntegral <$> lexeme L.integer) + n <- withCheck f (lexeme L.decimal) let pTrackType = choice [ CueTrackAudio <$ symbol "AUDIO" , CueTrackCdg <$ symbol "CDG" @@ -345,7 +338,7 @@ pIsrc :: Parser () pIsrc = do already <- gets (isJust . cueTrackIsrc . head . contextTracks) - let f x' = let x = T.pack x' in + let f x' = let x = T.decodeUtf8 x' in case mkIsrc x of Nothing -> Left (CueParserInvalidTrackIsrc x) Just isrc -> Right isrc @@ -357,7 +350,7 @@ pTrackPerformer :: Parser () pTrackPerformer = do already <- gets (isJust . cueTrackPerformer . head . contextTracks) - let f x' = let x = decodeUtf8 x' in + let f x' = let x = T.decodeUtf8 x' in case mkCueText x of Nothing -> Left (CueParserInvalidCueText x) Just txt -> Right txt @@ -369,7 +362,7 @@ pTrackTitle :: Parser () pTrackTitle = do already <- gets (isJust . cueTrackTitle . head . contextTracks) - let f x' = let x = decodeUtf8 x' in + let f x' = let x = T.decodeUtf8 x' in case mkCueText x of Nothing -> Left (CueParserInvalidCueText x) Just txt -> Right txt @@ -381,7 +374,7 @@ pTrackSongwriter :: Parser () pTrackSongwriter = do already <- gets (isJust . cueTrackSongwriter . head . contextTracks) - let f x' = let x = decodeUtf8 x' in + let f x' = let x = T.decodeUtf8 x' in case mkCueText x of Nothing -> Left (CueParserInvalidCueText x) Just txt -> Right txt @@ -421,7 +414,7 @@ cueTime :: Parser CueTime cueTime = do minutes <- naturalLit - void (char ':') + void (char 58) let checkSeconds n = if n < 60 then Right n @@ -431,7 +424,7 @@ then Right n else Left (CueParserInvalidFrames n) seconds <- withCheck checkSeconds naturalLit - void (char ':') + void (char 58) frames <- withCheck checkFrames naturalLit case fromMmSsFf minutes seconds frames of Nothing -> empty -- NOTE must be always valid, we checked already @@ -454,15 +447,14 @@ case check r of Left custom -> do setPosition npos - failure E.empty E.empty $ - E.singleton (Eec Nothing (Just custom)) + (fancyFailure . E.singleton . ErrorCustom) (Eec Nothing custom) Right x -> return x -- | If the first argument is 'True' and we can parse the given command, -- fail pointing at the beginning of the command and report it as something -- unexpected. -failAtIf :: Bool -> String -> Parser () +failAtIf :: Bool -> ByteString -> Parser () failAtIf shouldFail command = do let p = void (symbol command) lookAhead p @@ -477,18 +469,18 @@ inTrack :: Natural -> Parser a -> Parser a inTrack n = region f where - f e@ParseError {..} = - if E.null errorCustom - then e { errorCustom = E.singleton (Eec (Just n) Nothing) } - else e { errorCustom = E.map g errorCustom } - g (Eec mn x) = Eec (mn <|> Just n) x + f (TrivialError pos us es) = FancyError pos . E.singleton $ + ErrorCustom (Eec (Just n) (CueParserTrivialError us es)) + f (FancyError pos xs) = FancyError pos (E.map g xs) + g (ErrorCustom (Eec mn x)) = ErrorCustom (Eec (mn <|> Just n) x) + g e = e -- | A labelled literal (a helper for common case). labelledLit :: Bool -- ^ Should we instantly fail when command is parsed? - -> (String -> Either CueParserFailure a) -- ^ How to judge the result - -> String -- ^ Name of the command to grab + -> (ByteString -> Either CueParserFailure a) -- ^ How to judge the result + -> ByteString -- ^ Name of the command to grab -> Parser a labelledLit shouldFail check command = do failAtIf shouldFail command @@ -496,20 +488,23 @@ -- | String literal with support for quotation. -stringLit :: Parser String -stringLit = quoted <|> unquoted +stringLit :: Parser ByteString +stringLit = (quoted "quoted string literal") + <|> (unquoted "unquoted string literal") where - quoted = char '\"' *> manyTill (noneOf ("\n" :: String)) (char '\"') - unquoted = many (noneOf ("\n\t\r " :: String)) + quoted = char 34 *> takeWhileP Nothing f <* char 34 + unquoted = takeWhileP Nothing g + f x = x /= 10 && x /= 34 + g x = x /= 10 && x /= 9 && x /= 13 && x /= 32 -- | Parse a 'Natural'. naturalLit :: Parser Natural -naturalLit = fromIntegral <$> L.integer +naturalLit = L.decimal -- | Case-insensitive symbol parser. -symbol :: String -> Parser String +symbol :: ByteString -> Parser ByteString symbol s = string' s <* notFollowedBy alphaNumChar <* sc -- | A wrapper for lexemes. @@ -520,12 +515,14 @@ -- | Space consumer (eats newlines). scn :: Parser () -scn = L.space (void spaceChar) empty empty +scn = L.space space1 empty empty -- | Space consumer (does not eat newlines). sc :: Parser () -sc = L.space (void $ oneOf ("\t " :: String)) empty empty +sc = L.space (void $ takeWhile1P Nothing f) empty empty + where + f x = x == 32 || x == 9 -- | Determine by 'CueTrack' if we have already parsed FLAGS command. @@ -541,11 +538,6 @@ changingFirstOf :: [a] -> (a -> a) -> [a] changingFirstOf [] _ = [] changingFirstOf (x:xs) f = f x : xs - --- | Decode UTF-8 encoded 'B.ByteString' represented as a 'String'. - -decodeUtf8 :: String -> Text -decodeUtf8 = T.decodeUtf8 . B8.pack ---------------------------------------------------------------------------- -- Dummies diff --git a/Text/CueSheet/Types.hs b/Text/CueSheet/Types.hs --- a/Text/CueSheet/Types.hs +++ b/Text/CueSheet/Types.hs @@ -44,11 +44,8 @@ import Numeric.Natural import Test.QuickCheck import Text.Printf (printf) -import qualified Data.Text as T - -#if !MIN_VERSION_QuickCheck(2,9,0) import qualified Data.List.NonEmpty as NE -#endif +import qualified Data.Text as T -- | Entire CUE sheet, contains one or more files (see 'CueFile'). @@ -77,12 +74,8 @@ <*> arbitrary <*> arbitrary <*> arbitrary - <*> (arbitrary `suchThat` (> 0)) -#if MIN_VERSION_QuickCheck(2,9,0) - <*> scaleDown arbitrary -#else + <*> (fromInteger . getPositive <$> arbitrary) <*> scaleDown (NE.fromList . getNonEmpty <$> arbitrary) -#endif -- | A file to be written. Single file can be divided into one or more -- tracks (see 'CueTrack'). @@ -100,11 +93,7 @@ arbitrary = CueFile <$> filepath <*> arbitrary -#if MIN_VERSION_QuickCheck(2,9,0) - <*> scaleDown arbitrary -#else <*> scaleDown (NE.fromList . getNonEmpty <$> arbitrary) -#endif -- | Enumeration of audio or file's data types. @@ -173,11 +162,7 @@ <*> arbitrary <*> arbitrary <*> arbitrary -#if MIN_VERSION_QuickCheck(2,9,0) - <*> scaleDown arbitrary -#else <*> scaleDown (NE.fromList . getNonEmpty <$> arbitrary) -#endif <*> arbitrary -- | Track datatype. @@ -203,7 +188,7 @@ deriving (Show, Read, Eq, Ord, Generic) instance Arbitrary CueTime where - arbitrary = CueTime <$> arbitrary + arbitrary = CueTime . fromInteger . getNonNegative <$> arbitrary -- | Construct 'CueTime' from minutes, seconds, and frames. There are 75 -- frames per second. If number of seconds or frames is invalid, diff --git a/cue-sheet.cabal b/cue-sheet.cabal --- a/cue-sheet.cabal +++ b/cue-sheet.cabal @@ -1,6 +1,6 @@ name: cue-sheet -version: 0.1.1 -cabal-version: >= 1.10 +version: 1.0.0 +cabal-version: >= 1.18 tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.1 license: BSD3 license-file: LICENSE.md @@ -32,7 +32,7 @@ , containers >= 0.5.6.2 && < 0.6 , data-default-class , exceptions >= 0.6 && < 0.9 - , megaparsec >= 5.3 && < 6.0 + , megaparsec >= 6.0 && < 7.0 , mtl >= 2.0 && < 3.0 , text >= 0.2 && < 1.3 if !impl(ghc >= 8.0) @@ -61,7 +61,8 @@ , cue-sheet , exceptions >= 0.6 && < 0.9 , hspec >= 2.0 && < 3.0 - , hspec-megaparsec >= 0.3 && < 0.4 + , hspec-megaparsec >= 1.0 && < 2.0 + , megaparsec >= 6.0 && < 7.0 , text >= 0.2 && < 1.3 if !impl(ghc >= 8.0) build-depends: semigroups == 0.18.* diff --git a/tests/Text/CueSheet/ParserSpec.hs b/tests/Text/CueSheet/ParserSpec.hs --- a/tests/Text/CueSheet/ParserSpec.hs +++ b/tests/Text/CueSheet/ParserSpec.hs @@ -5,32 +5,35 @@ where import Control.Monad.Catch +import Data.Char (ord) import Data.Monoid ((<>)) +import Data.Word (Word8) import Test.Hspec import Test.Hspec.Megaparsec import Text.CueSheet.Parser import Text.CueSheet.Types -import qualified Data.ByteString.Lazy as BL -import qualified Data.List.NonEmpty as NE +import Text.Megaparsec +import qualified Data.ByteString as B +import qualified Data.List.NonEmpty as NE spec :: Spec spec = describe "parseCueSheet" $ do it "correctly deals with whitespace" $ do - bs <- BL.readFile "cue-sheet-samples/parser-whitespace.cue" + bs <- B.readFile "cue-sheet-samples/parser-whitespace.cue" sheet <- testSheet parseCueSheet "" bs `shouldParse` sheet it "parses commands case-insensitively" $ do - bs <- BL.readFile "cue-sheet-samples/parser-case-insensitivity.cue" + bs <- B.readFile "cue-sheet-samples/parser-case-insensitivity.cue" sheet <- testSheet parseCueSheet "" bs `shouldParse` sheet it "handles comments properly" $ do - bs <- BL.readFile "cue-sheet-samples/parser-comments.cue" + bs <- B.readFile "cue-sheet-samples/parser-comments.cue" sheet <- testSheet parseCueSheet "" bs `shouldParse` sheet it "at least one file should be declared" $ do - bs <- BL.readFile "cue-sheet-samples/parser-missing-file.cue" - let es = foldMap etoks + bs <- B.readFile "cue-sheet-samples/parser-missing-file.cue" + let es = foldMap (etoks . tow) [ "CATALOG" , "CDTEXTFILE" , "FILE" @@ -41,105 +44,99 @@ parseCueSheet "" bs `shouldFailWith` err (posN (70 :: Int) bs) (ueof <> es) it "at least one track should be declared" $ do - bs <- BL.readFile "cue-sheet-samples/parser-missing-track.cue" + bs <- B.readFile "cue-sheet-samples/parser-missing-track.cue" parseCueSheet "" bs `shouldFailWith` - err (posN (110 :: Int) bs) (ueof <> etoks "REM" <> etoks "TRACK") + err (posN (110 :: Int) bs) (ueof <> etoks (tow "REM") <> etoks (tow "TRACK")) it "at least one non-zero index should be declared" $ do - bs <- BL.readFile "cue-sheet-samples/parser-missing-index.cue" - let inTrack1 = cstm (Eec (Just 1) Nothing) + bs <- B.readFile "cue-sheet-samples/parser-missing-index.cue" + let e = wrappedTrivial (ueof <> etoks (tow "INDEX") <> etoks (tow "REM")) parseCueSheet "" bs `shouldFailWith` - err (posN (180 :: Int) bs) - (ueof <> etoks "INDEX" <> etoks "REM" <> inTrack1) + errFancy (posN (180 :: Int) bs) (cstm (Eec (Just 1) e)) it "parses a normal CUE file without issues" $ do - bs <- BL.readFile "cue-sheet-samples/parser-normal.cue" + bs <- B.readFile "cue-sheet-samples/parser-normal.cue" sheet <- normalCueSheet parseCueSheet "" bs `shouldParse` sheet it "rejects invalid catalog number" $ do - bs <- BL.readFile "cue-sheet-samples/parser-invalid-catalog.cue" - parseCueSheet "" bs `shouldFailWith` err (posN (8 :: Int) bs) - (cstm (Eec Nothing (Just $ CueParserInvalidCatalog "123"))) + bs <- B.readFile "cue-sheet-samples/parser-invalid-catalog.cue" + parseCueSheet "" bs `shouldFailWith` errFancy (posN (8 :: Int) bs) + (cstm (Eec Nothing (CueParserInvalidCatalog "123"))) it "rejects invalid CUE text" $ do - bs <- BL.readFile "cue-sheet-samples/parser-invalid-text.cue" - parseCueSheet "" bs `shouldFailWith` err (posN (10 :: Int) bs) - (cstm (Eec Nothing (Just $ CueParserInvalidCueText ""))) + bs <- B.readFile "cue-sheet-samples/parser-invalid-text.cue" + parseCueSheet "" bs `shouldFailWith` errFancy (posN (10 :: Int) bs) + (cstm (Eec Nothing (CueParserInvalidCueText ""))) it "detects and reports tracks that appear out of order" $ do - bs <- BL.readFile "cue-sheet-samples/parser-track-out-of-order.cue" - parseCueSheet "" bs `shouldFailWith` err (posN (182 :: Int) bs) - (cstm (Eec Nothing (Just CueParserTrackOutOfOrder))) + bs <- B.readFile "cue-sheet-samples/parser-track-out-of-order.cue" + parseCueSheet "" bs `shouldFailWith` errFancy (posN (182 :: Int) bs) + (cstm (Eec Nothing CueParserTrackOutOfOrder)) it "rejects invalid ISRC values" $ do - bs <- BL.readFile "cue-sheet-samples/parser-invalid-isrc.cue" - parseCueSheet "" bs `shouldFailWith` err (posN (161 :: Int) bs) - (cstm (Eec (Just 3) (Just (CueParserInvalidTrackIsrc "123")))) + bs <- B.readFile "cue-sheet-samples/parser-invalid-isrc.cue" + parseCueSheet "" bs `shouldFailWith` errFancy (posN (161 :: Int) bs) + (cstm (Eec (Just 3) (CueParserInvalidTrackIsrc "123"))) it "rejects invalid number of seconds" $ do - bs <- BL.readFile "cue-sheet-samples/parser-invalid-seconds.cue" - parseCueSheet "" bs `shouldFailWith` err (posN (168 :: Int) bs) - (cstm (Eec (Just 1) (Just (CueParserInvalidSeconds 61)))) + bs <- B.readFile "cue-sheet-samples/parser-invalid-seconds.cue" + parseCueSheet "" bs `shouldFailWith` errFancy (posN (168 :: Int) bs) + (cstm (Eec (Just 1) (CueParserInvalidSeconds 61))) it "rejects invalid number of frames" $ do - bs <- BL.readFile "cue-sheet-samples/parser-invalid-frames.cue" - parseCueSheet "" bs `shouldFailWith` err (posN (171 :: Int) bs) - (cstm (Eec (Just 1) (Just (CueParserInvalidFrames 77)))) + bs <- B.readFile "cue-sheet-samples/parser-invalid-frames.cue" + parseCueSheet "" bs `shouldFailWith` errFancy (posN (171 :: Int) bs) + (cstm (Eec (Just 1) (CueParserInvalidFrames 77))) it "detects and reports indices that appear out of order" $ do - bs <- BL.readFile "cue-sheet-samples/parser-index-out-of-order.cue" - parseCueSheet "" bs `shouldFailWith` err (posN (162 :: Int) bs) - (cstm (Eec (Just 1) (Just CueParserTrackIndexOutOfOrder))) + bs <- B.readFile "cue-sheet-samples/parser-index-out-of-order.cue" + parseCueSheet "" bs `shouldFailWith` errFancy (posN (162 :: Int) bs) + (cstm (Eec (Just 1) CueParserTrackIndexOutOfOrder)) it "rejects duplicate CATALOG command" $ do - bs <- BL.readFile "cue-sheet-samples/parser-duplicate-catalog.cue" - let es = foldMap etoks + bs <- B.readFile "cue-sheet-samples/parser-duplicate-catalog.cue" + let es = utoks (tow "CATA") <> foldMap (etoks . tow) [ "CDTEXTFILE" , "FILE" , "PERFORMER" , "REM" , "SONGWRITER" , "TITLE" ] - parseCueSheet "" bs `shouldFailWith` err (posN (22 :: Int) bs) - (utok 'C' <> es) + parseCueSheet "" bs `shouldFailWith` err (posN (22 :: Int) bs) es it "rejects duplicate CDTEXTFILE command" $ do - bs <- BL.readFile "cue-sheet-samples/parser-duplicate-cdtextfile.cue" - let es = foldMap etoks + bs <- B.readFile "cue-sheet-samples/parser-duplicate-cdtextfile.cue" + let es = utoks (tow "CDTE") <> foldMap (etoks . tow) [ "CATALOG" , "FILE" , "PERFORMER" , "REM" , "SONGWRITER" , "TITLE" ] - parseCueSheet "" bs `shouldFailWith` err (posN (23 :: Int) bs) - (utok 'C' <> es) + parseCueSheet "" bs `shouldFailWith` err (posN (23 :: Int) bs) es it "rejects duplicate PERFORMER command" $ do - bs <- BL.readFile "cue-sheet-samples/parser-duplicate-performer.cue" - let es = foldMap etoks + bs <- B.readFile "cue-sheet-samples/parser-duplicate-performer.cue" + let es = utoks (tow "PERF") <> foldMap (etoks . tow) [ "CATALOG" , "CDTEXTFILE" , "FILE" , "REM" , "SONGWRITER" , "TITLE" ] - parseCueSheet "" bs `shouldFailWith` err (posN (30 :: Int) bs) - (utok 'P' <> es) + parseCueSheet "" bs `shouldFailWith` err (posN (30 :: Int) bs) es it "rejects duplicate TITLE command" $ do - bs <- BL.readFile "cue-sheet-samples/parser-duplicate-title.cue" - let es = foldMap etoks + bs <- B.readFile "cue-sheet-samples/parser-duplicate-title.cue" + let es = utoks (tow "TITL") <> foldMap (etoks . tow) [ "CATALOG" , "CDTEXTFILE" , "FILE" , "PERFORMER" , "REM" , "SONGWRITER" ] - parseCueSheet "" bs `shouldFailWith` err (posN (17 :: Int) bs) - (utok 'T' <> es) + parseCueSheet "" bs `shouldFailWith` err (posN (17 :: Int) bs) es it "rejects duplicate SONGWRITER command" $ do - bs <- BL.readFile "cue-sheet-samples/parser-duplicate-songwriter.cue" - let es = foldMap etoks + bs <- B.readFile "cue-sheet-samples/parser-duplicate-songwriter.cue" + let es = utoks (tow "SONG") <> foldMap (etoks . tow) [ "CATALOG" , "CDTEXTFILE" , "FILE" , "PERFORMER" , "REM" , "TITLE" ] - parseCueSheet "" bs `shouldFailWith` err (posN (18 :: Int) bs) - (utok 'S' <> es) + parseCueSheet "" bs `shouldFailWith` err (posN (18 :: Int) bs) es it "rejects duplicate FLAGS command (in track)" $ do - bs <- BL.readFile "cue-sheet-samples/parser-duplicate-track-flags.cue" - let es = foldMap etoks + bs <- B.readFile "cue-sheet-samples/parser-duplicate-track-flags.cue" + let es = wrappedTrivial $ utoks (tow "FLAGS") <> foldMap (etoks . tow) [ "INDEX" , "ISRC" , "PERFORMER" @@ -147,11 +144,11 @@ , "REM" , "SONGWRITER" , "TITLE" ] - parseCueSheet "" bs `shouldFailWith` err (posN (144 :: Int) bs) - (utok 'F' <> es <> cstm (Eec (Just 1) Nothing)) + parseCueSheet "" bs `shouldFailWith` + errFancy (posN (144 :: Int) bs) (cstm (Eec (Just 1) es)) it "rejects duplicate ISRC command (in track)" $ do - bs <- BL.readFile "cue-sheet-samples/parser-duplicate-track-isrc.cue" - let es = foldMap etoks + bs <- B.readFile "cue-sheet-samples/parser-duplicate-track-isrc.cue" + let es = wrappedTrivial $ utoks (tow "ISRC ") <> foldMap (etoks . tow) [ "FLAGS" , "INDEX" , "PERFORMER" @@ -159,11 +156,11 @@ , "REM" , "SONGWRITER" , "TITLE" ] - parseCueSheet "" bs `shouldFailWith` err (posN (152 :: Int) bs) - (utok 'I' <> utoks "IS" <> es <> cstm (Eec (Just 1) Nothing)) + parseCueSheet "" bs `shouldFailWith` + errFancy (posN (152 :: Int) bs) (cstm (Eec (Just 1) es)) it "rejects duplicate PERFORMER command (in track)" $ do - bs <- BL.readFile "cue-sheet-samples/parser-duplicate-track-performer.cue" - let es = foldMap etoks + bs <- B.readFile "cue-sheet-samples/parser-duplicate-track-performer.cue" + let es = wrappedTrivial $ utoks (tow "PERFO") <> foldMap (etoks . tow) [ "FLAGS" , "INDEX" , "ISRC" @@ -171,11 +168,11 @@ , "REM" , "SONGWRITER" , "TITLE" ] - parseCueSheet "" bs `shouldFailWith` err (posN (156 :: Int) bs) - (utok 'P' <> es <> cstm (Eec (Just 1) Nothing)) + parseCueSheet "" bs `shouldFailWith` + errFancy (posN (156 :: Int) bs) (cstm (Eec (Just 1) es)) it "rejects duplicate TITLE command (in track)" $ do - bs <- BL.readFile "cue-sheet-samples/parser-duplicate-track-title.cue" - let es = foldMap etoks + bs <- B.readFile "cue-sheet-samples/parser-duplicate-track-title.cue" + let es = wrappedTrivial $ utoks (tow "TITLE") <> foldMap (etoks . tow) [ "FLAGS" , "INDEX" , "ISRC" @@ -183,11 +180,11 @@ , "PREGAP" , "REM" , "SONGWRITER" ] - parseCueSheet "" bs `shouldFailWith` err (posN (146 :: Int) bs) - (utok 'T' <> es <> cstm (Eec (Just 1) Nothing)) + parseCueSheet "" bs `shouldFailWith` + errFancy (posN (146 :: Int) bs) (cstm (Eec (Just 1) es)) it "rejects duplicate SONGWRITER command (in track)" $ do - bs <- BL.readFile "cue-sheet-samples/parser-duplicate-track-songwriter.cue" - let es = foldMap etoks + bs <- B.readFile "cue-sheet-samples/parser-duplicate-track-songwriter.cue" + let es = wrappedTrivial $ utoks (tow "SONGW") <> foldMap (etoks . tow) [ "FLAGS" , "INDEX" , "ISRC" @@ -195,11 +192,11 @@ , "PREGAP" , "REM" , "TITLE" ] - parseCueSheet "" bs `shouldFailWith` err (posN (150 :: Int) bs) - (utok 'S' <> es <> cstm (Eec (Just 1) Nothing)) + parseCueSheet "" bs `shouldFailWith` + errFancy (posN (150 :: Int) bs) (cstm (Eec (Just 1) es)) it "rejects duplicate PREGAP command (in track)" $ do - bs <- BL.readFile "cue-sheet-samples/parser-duplicate-track-pregap.cue" - let es = foldMap etoks + bs <- B.readFile "cue-sheet-samples/parser-duplicate-track-pregap.cue" + let es = wrappedTrivial $ utoks (tow "PREGA") <> foldMap (etoks . tow) [ "FLAGS" , "INDEX" , "ISRC" @@ -207,16 +204,16 @@ , "REM" , "SONGWRITER" , "TITLE" ] - parseCueSheet "" bs `shouldFailWith` err (posN (176 :: Int) bs) - (utok 'P' <> es <> cstm (Eec (Just 1) Nothing)) + parseCueSheet "" bs `shouldFailWith` + errFancy (posN (176 :: Int) bs) (cstm (Eec (Just 1) es)) it "rejects duplicate POSTGAP command (in track)" $ do - bs <- BL.readFile "cue-sheet-samples/parser-duplicate-track-postgap.cue" - let es = foldMap etoks + bs <- B.readFile "cue-sheet-samples/parser-duplicate-track-postgap.cue" + let es = foldMap (etoks . tow) [ "FILE" , "REM" , "TRACK" ] - parseCueSheet "" bs `shouldFailWith` err (posN (199 :: Int) bs) - (utok 'P' <> es <> eeof) + parseCueSheet "" bs `shouldFailWith` + err (posN (199 :: Int) bs) (utok 80 <> es <> eeof) testSheet :: MonadThrow m => m CueSheet testSheet = do @@ -389,3 +386,23 @@ , cueTrackPregapIndex = Nothing , cueTrackIndices = NE.fromList [CueTime 191625] , cueTrackPostgap = Nothing } ] } ] } + +-- | Construct 'CueParserFailure' from given @'ET' 'Word8'@ thing. + +wrappedTrivial :: ET Word8 -> CueParserFailure +wrappedTrivial xs = + case err posI xs of + TrivialError _ us es -> CueParserTrivialError us es + _ -> error "Ooops!" + +-- | Convert 'String' to a list of bytes. + +tow :: String -> [Word8] +tow = fmap (fromIntegral . ord) +{-# INLINE tow #-} + +-- | Quickly make a custom error component. + +cstm :: e -> EF e +cstm = fancy . ErrorCustom +{-# INLINE cstm #-} diff --git a/tests/Text/CueSheet/RenderSpec.hs b/tests/Text/CueSheet/RenderSpec.hs --- a/tests/Text/CueSheet/RenderSpec.hs +++ b/tests/Text/CueSheet/RenderSpec.hs @@ -34,7 +34,7 @@ renderCueSheet False cueSheet `shouldBe` expected it "produces content that can be correctly parsed back" $ property $ \csrf cueSheet -> - parseCueSheet "" (renderCueSheet csrf cueSheet) + parseCueSheet "" (BL.toStrict $ renderCueSheet csrf cueSheet) `shouldBe` Right cueSheet -- | A manually constructed testing CUE sheet. diff --git a/tests/Text/CueSheet/TypesSpec.hs b/tests/Text/CueSheet/TypesSpec.hs --- a/tests/Text/CueSheet/TypesSpec.hs +++ b/tests/Text/CueSheet/TypesSpec.hs @@ -14,14 +14,17 @@ describe "fromMmSsFf" $ do context "if number of seconds is greater than 59" $ it "throws the correct exception" $ - property $ \mm ss' ff -> do - let ss = ss' + 60 + property $ \(NonNegative mm') (NonNegative ss') (NonNegative ff') -> do + let mm = fromInteger mm' + ss = fromInteger ss' + 60 + ff = fromInteger ff' fromMmSsFf mm ss ff `shouldThrow` (== InvalidSeconds ss) context "if number of frames is greater than 74" $ it "throws the correct exception" $ - property $ \mm ss' ff' -> do - let ss = ss' `rem` 60 - ff = ff' + 75 + property $ \(NonNegative mm') (NonNegative ss') (NonNegative ff') -> do + let mm = fromInteger mm' + ss = fromInteger ss' `rem` 60 + ff = fromInteger ff' + 75 fromMmSsFf mm ss ff `shouldThrow` (== InvalidFrames ff) context "if all input values are valid" $ it "produces the correct result" $ do