cue-sheet 0.1.1 → 1.0.0

raw patch · 7 files changed

+183/−176 lines, 7 filesdep ~QuickCheckdep ~exceptionsdep ~hspec-megaparsecPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: QuickCheck, exceptions, hspec-megaparsec, megaparsec

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• Text/CueSheet/Parser.hs +57/−65
• Text/CueSheet/Types.hs +3/−18
• cue-sheet.cabal +5/−4
• tests/Text/CueSheet/ParserSpec.hs +100/−83
• tests/Text/CueSheet/RenderSpec.hs +1/−1
• tests/Text/CueSheet/TypesSpec.hs +8/−5

@@ -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.

@@ -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

@@ -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,

@@ -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.*

@@ -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 #-}

@@ -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.

@@ -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