diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +## Cue sheet 2.0.0 + +* Uses Megaparsec 7. The `parseCueSheet` now returns `ParseErrorBundle`. + ## Cue sheet 1.0.1 * Allow Megaparsec 6.4.0. diff --git a/LICENSE.md b/LICENSE.md --- a/LICENSE.md +++ b/LICENSE.md @@ -1,4 +1,4 @@ -Copyright © 2016–2017 Mark Karpov +Copyright © 2016–2018 Mark Karpov All rights reserved. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -5,7 +5,6 @@ [![Stackage Nightly](http://stackage.org/package/cue-sheet/badge/nightly)](http://stackage.org/nightly/package/cue-sheet) [![Stackage LTS](http://stackage.org/package/cue-sheet/badge/lts)](http://stackage.org/lts/package/cue-sheet) [![Build Status](https://travis-ci.org/mrkkrp/cue-sheet.svg?branch=master)](https://travis-ci.org/mrkkrp/cue-sheet) -[![Coverage Status](https://coveralls.io/repos/mrkkrp/cue-sheet/badge.svg?branch=master&service=github)](https://coveralls.io/github/mrkkrp/cue-sheet?branch=master) The library allows to construct, render, and parse CUE sheets. @@ -39,6 +38,6 @@ ## License -Copyright © 2016–2017 Mark Karpov +Copyright © 2016–2018 Mark Karpov Distributed under BSD 3 clause license. diff --git a/Text/CueSheet.hs b/Text/CueSheet.hs --- a/Text/CueSheet.hs +++ b/Text/CueSheet.hs @@ -1,6 +1,6 @@ -- | -- Module : Text.CueSheet --- Copyright : © 2016–2017 Mark Karpov +-- Copyright : © 2016–2018 Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov diff --git a/Text/CueSheet/Parser.hs b/Text/CueSheet/Parser.hs --- a/Text/CueSheet/Parser.hs +++ b/Text/CueSheet/Parser.hs @@ -1,6 +1,6 @@ -- | -- Module : Text.CueSheet.Parser --- Copyright : © 2016–2017 Mark Karpov +-- Copyright : © 2016–2018 Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov @@ -15,6 +15,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} module Text.CueSheet.Parser ( parseCueSheet @@ -26,7 +27,7 @@ import Data.ByteString (ByteString) import Data.Data (Data) import Data.List.NonEmpty (NonEmpty (..)) -import Data.Maybe (isJust, fromMaybe) +import Data.Maybe (isJust) import Data.Set (Set) import Data.Text (Text) import Data.Typeable (Typeable) @@ -82,7 +83,7 @@ showErrorComponent = \case CueParserTrivialError us es -> init $ parseErrorTextPretty - (TrivialError undefined us es :: ParseError Word8 Eec) + (TrivialError undefined us es :: ParseError ByteString Eec) CueParserInvalidCatalog txt -> "the value \"" ++ T.unpack txt ++ "\" is not a valid Media Catalog Number" CueParserInvalidCueText txt -> @@ -131,7 +132,7 @@ parseCueSheet :: String -- ^ File name to include in error messages -> ByteString -- ^ CUE sheet to parse as a lazy 'BL.ByteString' - -> Either (ParseError Word8 Eec) CueSheet -- ^ 'ParseError' or result + -> Either (ParseErrorBundle ByteString Eec) CueSheet -- ^ 'ParseError' or result parseCueSheet = parse (contextCueSheet <$> execStateT pCueSheet initContext) where initContext = Context @@ -440,12 +441,11 @@ withCheck :: (a -> Either CueParserFailure b) -> Parser a -> Parser b withCheck check p = do - cpos <- getPosition - npos <- fromMaybe cpos <$> getNextTokenPosition + o <- getOffset r <- p case check r of Left custom -> do - setPosition npos + setOffset o (fancyFailure . E.singleton . ErrorCustom) (Eec Nothing custom) Right x -> return x diff --git a/Text/CueSheet/Render.hs b/Text/CueSheet/Render.hs --- a/Text/CueSheet/Render.hs +++ b/Text/CueSheet/Render.hs @@ -1,6 +1,6 @@ -- | -- Module : Text.CueSheet.Render --- Copyright : © 2016–2017 Mark Karpov +-- Copyright : © 2016–2018 Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov diff --git a/Text/CueSheet/Types.hs b/Text/CueSheet/Types.hs --- a/Text/CueSheet/Types.hs +++ b/Text/CueSheet/Types.hs @@ -1,6 +1,6 @@ -- | -- Module : Text.CueSheet.Types --- Copyright : © 2016–2017 Mark Karpov +-- Copyright : © 2016–2018 Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov diff --git a/cue-sheet.cabal b/cue-sheet.cabal --- a/cue-sheet.cabal +++ b/cue-sheet.cabal @@ -1,7 +1,7 @@ name: cue-sheet -version: 1.0.1 -cabal-version: >= 1.18 -tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2 +version: 2.0.0 +cabal-version: 1.18 +tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3 license: BSD3 license-file: LICENSE.md author: Mark Karpov @@ -31,13 +31,12 @@ , bytestring >= 0.10.8 && < 0.11 , containers >= 0.5.6.2 && < 0.6 , data-default-class - , exceptions >= 0.6 && < 0.9 - , megaparsec >= 6.0 && < 7.0 + , exceptions >= 0.6 && < 0.11 + , megaparsec >= 7.0 && < 8.0 , mtl >= 2.0 && < 3.0 , text >= 0.2 && < 1.3 if !impl(ghc >= 8.0) build-depends: semigroups == 0.18.* - exposed-modules: Text.CueSheet , Text.CueSheet.Types , Text.CueSheet.Parser @@ -46,6 +45,12 @@ ghc-options: -Wall -Werror else ghc-options: -O2 -Wall + if flag(dev) && impl(ghc >= 8.0) + ghc-options: -Wcompat + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wnoncanonical-monad-instances + -Wnoncanonical-monadfail-instances default-language: Haskell2010 test-suite tests @@ -59,14 +64,14 @@ , base >= 4.8 && < 5.0 , bytestring >= 0.10.8 && < 0.11 , cue-sheet - , exceptions >= 0.6 && < 0.9 + , exceptions >= 0.6 && < 0.11 , hspec >= 2.0 && < 3.0 - , hspec-megaparsec >= 1.0 && < 2.0 - , megaparsec >= 6.0 && < 7.0 + , hspec-megaparsec >= 2.0 && < 3.0 + , megaparsec >= 7.0 && < 8.0 , text >= 0.2 && < 1.3 + build-tools: hspec-discover >= 2.0 && < 3.0 if !impl(ghc >= 8.0) build-depends: semigroups == 0.18.* - if flag(dev) ghc-options: -Wall -Werror else 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,9 +5,8 @@ where import Control.Monad.Catch -import Data.Char (ord) +import Data.ByteString (ByteString) import Data.Monoid ((<>)) -import Data.Word (Word8) import Test.Hspec import Test.Hspec.Megaparsec import Text.CueSheet.Parser @@ -33,7 +32,7 @@ parseCueSheet "" bs `shouldParse` sheet it "at least one file should be declared" $ do bs <- B.readFile "cue-sheet-samples/parser-missing-file.cue" - let es = foldMap (etoks . tow) + let es = foldMap etoks [ "CATALOG" , "CDTEXTFILE" , "FILE" @@ -42,101 +41,101 @@ , "SONGWRITER" , "TITLE" ] parseCueSheet "" bs `shouldFailWith` - err (posN (70 :: Int) bs) (ueof <> es) + err 67 (ueof <> es) it "at least one track should be declared" $ do bs <- B.readFile "cue-sheet-samples/parser-missing-track.cue" parseCueSheet "" bs `shouldFailWith` - err (posN (110 :: Int) bs) (ueof <> etoks (tow "REM") <> etoks (tow "TRACK")) + err 109 (ueof <> etoks "REM" <> etoks "TRACK") it "at least one non-zero index should be declared" $ do bs <- B.readFile "cue-sheet-samples/parser-missing-index.cue" - let e = wrappedTrivial (ueof <> etoks (tow "INDEX") <> etoks (tow "REM")) + let e = wrappedTrivial (ueof <> etoks "INDEX" <> etoks "REM") parseCueSheet "" bs `shouldFailWith` - errFancy (posN (180 :: Int) bs) (cstm (Eec (Just 1) e)) + errFancy 174 (cstm (Eec (Just 1) e)) it "parses a normal CUE file without issues" $ do bs <- B.readFile "cue-sheet-samples/parser-normal.cue" sheet <- normalCueSheet parseCueSheet "" bs `shouldParse` sheet it "rejects invalid catalog number" $ do bs <- B.readFile "cue-sheet-samples/parser-invalid-catalog.cue" - parseCueSheet "" bs `shouldFailWith` errFancy (posN (8 :: Int) bs) + parseCueSheet "" bs `shouldFailWith` errFancy 8 (cstm (Eec Nothing (CueParserInvalidCatalog "123"))) it "rejects invalid CUE text" $ do bs <- B.readFile "cue-sheet-samples/parser-invalid-text.cue" - parseCueSheet "" bs `shouldFailWith` errFancy (posN (10 :: Int) bs) + parseCueSheet "" bs `shouldFailWith` errFancy 10 (cstm (Eec Nothing (CueParserInvalidCueText ""))) it "detects and reports tracks that appear out of order" $ do bs <- B.readFile "cue-sheet-samples/parser-track-out-of-order.cue" - parseCueSheet "" bs `shouldFailWith` errFancy (posN (182 :: Int) bs) + parseCueSheet "" bs `shouldFailWith` errFancy 182 (cstm (Eec Nothing CueParserTrackOutOfOrder)) it "rejects invalid ISRC values" $ do bs <- B.readFile "cue-sheet-samples/parser-invalid-isrc.cue" - parseCueSheet "" bs `shouldFailWith` errFancy (posN (161 :: Int) bs) + parseCueSheet "" bs `shouldFailWith` errFancy 161 (cstm (Eec (Just 3) (CueParserInvalidTrackIsrc "123"))) it "rejects invalid number of seconds" $ do bs <- B.readFile "cue-sheet-samples/parser-invalid-seconds.cue" - parseCueSheet "" bs `shouldFailWith` errFancy (posN (168 :: Int) bs) + parseCueSheet "" bs `shouldFailWith` errFancy 168 (cstm (Eec (Just 1) (CueParserInvalidSeconds 61))) it "rejects invalid number of frames" $ do bs <- B.readFile "cue-sheet-samples/parser-invalid-frames.cue" - parseCueSheet "" bs `shouldFailWith` errFancy (posN (171 :: Int) bs) + parseCueSheet "" bs `shouldFailWith` errFancy 171 (cstm (Eec (Just 1) (CueParserInvalidFrames 77))) it "detects and reports indices that appear out of order" $ do bs <- B.readFile "cue-sheet-samples/parser-index-out-of-order.cue" - parseCueSheet "" bs `shouldFailWith` errFancy (posN (162 :: Int) bs) + parseCueSheet "" bs `shouldFailWith` errFancy 162 (cstm (Eec (Just 1) CueParserTrackIndexOutOfOrder)) it "rejects duplicate CATALOG command" $ do bs <- B.readFile "cue-sheet-samples/parser-duplicate-catalog.cue" - let es = utoks (tow "CATA") <> foldMap (etoks . tow) + let es = utoks "CATA" <> foldMap etoks [ "CDTEXTFILE" , "FILE" , "PERFORMER" , "REM" , "SONGWRITER" , "TITLE" ] - parseCueSheet "" bs `shouldFailWith` err (posN (22 :: Int) bs) es + parseCueSheet "" bs `shouldFailWith` err 22 es it "rejects duplicate CDTEXTFILE command" $ do bs <- B.readFile "cue-sheet-samples/parser-duplicate-cdtextfile.cue" - let es = utoks (tow "CDTE") <> foldMap (etoks . tow) + let es = utoks "CDTE" <> foldMap etoks [ "CATALOG" , "FILE" , "PERFORMER" , "REM" , "SONGWRITER" , "TITLE" ] - parseCueSheet "" bs `shouldFailWith` err (posN (23 :: Int) bs) es + parseCueSheet "" bs `shouldFailWith` err 23 es it "rejects duplicate PERFORMER command" $ do bs <- B.readFile "cue-sheet-samples/parser-duplicate-performer.cue" - let es = utoks (tow "PERF") <> foldMap (etoks . tow) + let es = utoks "PERF" <> foldMap etoks [ "CATALOG" , "CDTEXTFILE" , "FILE" , "REM" , "SONGWRITER" , "TITLE" ] - parseCueSheet "" bs `shouldFailWith` err (posN (30 :: Int) bs) es + parseCueSheet "" bs `shouldFailWith` err 30 es it "rejects duplicate TITLE command" $ do bs <- B.readFile "cue-sheet-samples/parser-duplicate-title.cue" - let es = utoks (tow "TITL") <> foldMap (etoks . tow) + let es = utoks "TITL" <> foldMap etoks [ "CATALOG" , "CDTEXTFILE" , "FILE" , "PERFORMER" , "REM" , "SONGWRITER" ] - parseCueSheet "" bs `shouldFailWith` err (posN (17 :: Int) bs) es + parseCueSheet "" bs `shouldFailWith` err 17 es it "rejects duplicate SONGWRITER command" $ do bs <- B.readFile "cue-sheet-samples/parser-duplicate-songwriter.cue" - let es = utoks (tow "SONG") <> foldMap (etoks . tow) + let es = utoks "SONG" <> foldMap etoks [ "CATALOG" , "CDTEXTFILE" , "FILE" , "PERFORMER" , "REM" , "TITLE" ] - parseCueSheet "" bs `shouldFailWith` err (posN (18 :: Int) bs) es + parseCueSheet "" bs `shouldFailWith` err 18 es it "rejects duplicate FLAGS command (in track)" $ do bs <- B.readFile "cue-sheet-samples/parser-duplicate-track-flags.cue" - let es = wrappedTrivial $ utoks (tow "FLAGS") <> foldMap (etoks . tow) + let es = wrappedTrivial $ utoks "FLAGS" <> foldMap etoks [ "INDEX" , "ISRC" , "PERFORMER" @@ -145,10 +144,10 @@ , "SONGWRITER" , "TITLE" ] parseCueSheet "" bs `shouldFailWith` - errFancy (posN (144 :: Int) bs) (cstm (Eec (Just 1) es)) + errFancy 144 (cstm (Eec (Just 1) es)) it "rejects duplicate ISRC command (in track)" $ do bs <- B.readFile "cue-sheet-samples/parser-duplicate-track-isrc.cue" - let es = wrappedTrivial $ utoks (tow "ISRC ") <> foldMap (etoks . tow) + let es = wrappedTrivial $ utoks "ISRC " <> foldMap etoks [ "FLAGS" , "INDEX" , "PERFORMER" @@ -157,10 +156,10 @@ , "SONGWRITER" , "TITLE" ] parseCueSheet "" bs `shouldFailWith` - errFancy (posN (152 :: Int) bs) (cstm (Eec (Just 1) es)) + errFancy 152 (cstm (Eec (Just 1) es)) it "rejects duplicate PERFORMER command (in track)" $ do bs <- B.readFile "cue-sheet-samples/parser-duplicate-track-performer.cue" - let es = wrappedTrivial $ utoks (tow "PERFO") <> foldMap (etoks . tow) + let es = wrappedTrivial $ utoks "PERFO" <> foldMap etoks [ "FLAGS" , "INDEX" , "ISRC" @@ -169,10 +168,10 @@ , "SONGWRITER" , "TITLE" ] parseCueSheet "" bs `shouldFailWith` - errFancy (posN (156 :: Int) bs) (cstm (Eec (Just 1) es)) + errFancy 156 (cstm (Eec (Just 1) es)) it "rejects duplicate TITLE command (in track)" $ do bs <- B.readFile "cue-sheet-samples/parser-duplicate-track-title.cue" - let es = wrappedTrivial $ utoks (tow "TITLE") <> foldMap (etoks . tow) + let es = wrappedTrivial $ utoks "TITLE" <> foldMap etoks [ "FLAGS" , "INDEX" , "ISRC" @@ -181,10 +180,10 @@ , "REM" , "SONGWRITER" ] parseCueSheet "" bs `shouldFailWith` - errFancy (posN (146 :: Int) bs) (cstm (Eec (Just 1) es)) + errFancy 146 (cstm (Eec (Just 1) es)) it "rejects duplicate SONGWRITER command (in track)" $ do bs <- B.readFile "cue-sheet-samples/parser-duplicate-track-songwriter.cue" - let es = wrappedTrivial $ utoks (tow "SONGW") <> foldMap (etoks . tow) + let es = wrappedTrivial $ utoks "SONGW" <> foldMap etoks [ "FLAGS" , "INDEX" , "ISRC" @@ -193,10 +192,10 @@ , "REM" , "TITLE" ] parseCueSheet "" bs `shouldFailWith` - errFancy (posN (150 :: Int) bs) (cstm (Eec (Just 1) es)) + errFancy 150 (cstm (Eec (Just 1) es)) it "rejects duplicate PREGAP command (in track)" $ do bs <- B.readFile "cue-sheet-samples/parser-duplicate-track-pregap.cue" - let es = wrappedTrivial $ utoks (tow "PREGA") <> foldMap (etoks . tow) + let es = wrappedTrivial $ utoks "PREGA" <> foldMap etoks [ "FLAGS" , "INDEX" , "ISRC" @@ -205,15 +204,15 @@ , "SONGWRITER" , "TITLE" ] parseCueSheet "" bs `shouldFailWith` - errFancy (posN (176 :: Int) bs) (cstm (Eec (Just 1) es)) + errFancy 176 (cstm (Eec (Just 1) es)) it "rejects duplicate POSTGAP command (in track)" $ do bs <- B.readFile "cue-sheet-samples/parser-duplicate-track-postgap.cue" - let es = foldMap (etoks . tow) + let es = foldMap etoks [ "FILE" , "REM" , "TRACK" ] parseCueSheet "" bs `shouldFailWith` - err (posN (199 :: Int) bs) (utok 80 <> es <> eeof) + err 199 (utok 80 <> es <> eeof) testSheet :: MonadThrow m => m CueSheet testSheet = do @@ -389,17 +388,11 @@ -- | Construct 'CueParserFailure' from given @'ET' 'Word8'@ thing. -wrappedTrivial :: ET Word8 -> CueParserFailure +wrappedTrivial :: ET ByteString -> CueParserFailure wrappedTrivial xs = - case err posI xs of + case err 0 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.