ParserSpec.hs

{-# LANGUAGE OverloadedStrings #-}

module Text.CueSheet.ParserSpec
  ( spec )
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 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 <- B.readFile "cue-sheet-samples/parser-whitespace.cue"
      sheet <- testSheet
      parseCueSheet "" bs `shouldParse` sheet
    it "parses commands case-insensitively" $ do
      bs <- B.readFile "cue-sheet-samples/parser-case-insensitivity.cue"
      sheet <- testSheet
      parseCueSheet "" bs `shouldParse` sheet
    it "handles comments properly" $ do
      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 <- B.readFile "cue-sheet-samples/parser-missing-file.cue"
      let es = foldMap (etoks . tow)
            [ "CATALOG"
            , "CDTEXTFILE"
            , "FILE"
            , "PERFORMER"
            , "REM"
            , "SONGWRITER"
            , "TITLE" ]
      parseCueSheet "" bs `shouldFailWith`
        err (posN (70 :: Int) bs) (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"))
    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"))
      parseCueSheet "" bs `shouldFailWith`
        errFancy (posN (180 :: Int) bs) (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)
        (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)
        (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)
        (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)
        (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)
        (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)
        (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)
        (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)
            [ "CDTEXTFILE"
            , "FILE"
            , "PERFORMER"
            , "REM"
            , "SONGWRITER"
            , "TITLE" ]
      parseCueSheet "" bs `shouldFailWith` err (posN (22 :: Int) bs) 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)
            [ "CATALOG"
            , "FILE"
            , "PERFORMER"
            , "REM"
            , "SONGWRITER"
            , "TITLE" ]
      parseCueSheet "" bs `shouldFailWith` err (posN (23 :: Int) bs) 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)
            [ "CATALOG"
            , "CDTEXTFILE"
            , "FILE"
            , "REM"
            , "SONGWRITER"
            , "TITLE" ]
      parseCueSheet "" bs `shouldFailWith` err (posN (30 :: Int) bs) 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)
            [ "CATALOG"
            , "CDTEXTFILE"
            , "FILE"
            , "PERFORMER"
            , "REM"
            , "SONGWRITER" ]
      parseCueSheet "" bs `shouldFailWith` err (posN (17 :: Int) bs) 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)
            [ "CATALOG"
            , "CDTEXTFILE"
            , "FILE"
            , "PERFORMER"
            , "REM"
            , "TITLE" ]
      parseCueSheet "" bs `shouldFailWith` err (posN (18 :: Int) bs) 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)
            [ "INDEX"
            , "ISRC"
            , "PERFORMER"
            , "PREGAP"
            , "REM"
            , "SONGWRITER"
            , "TITLE" ]
      parseCueSheet "" bs `shouldFailWith`
        errFancy (posN (144 :: Int) bs) (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)
            [ "FLAGS"
            , "INDEX"
            , "PERFORMER"
            , "PREGAP"
            , "REM"
            , "SONGWRITER"
            , "TITLE" ]
      parseCueSheet "" bs `shouldFailWith`
        errFancy (posN (152 :: Int) bs) (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)
            [ "FLAGS"
            , "INDEX"
            , "ISRC"
            , "PREGAP"
            , "REM"
            , "SONGWRITER"
            , "TITLE" ]
      parseCueSheet "" bs `shouldFailWith`
        errFancy (posN (156 :: Int) bs) (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)
            [ "FLAGS"
            , "INDEX"
            , "ISRC"
            , "PERFORMER"
            , "PREGAP"
            , "REM"
            , "SONGWRITER" ]
      parseCueSheet "" bs `shouldFailWith`
        errFancy (posN (146 :: Int) bs) (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)
            [ "FLAGS"
            , "INDEX"
            , "ISRC"
            , "PERFORMER"
            , "PREGAP"
            , "REM"
            , "TITLE" ]
      parseCueSheet "" bs `shouldFailWith`
        errFancy (posN (150 :: Int) bs) (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)
            [ "FLAGS"
            , "INDEX"
            , "ISRC"
            , "PERFORMER"
            , "REM"
            , "SONGWRITER"
            , "TITLE" ]
      parseCueSheet "" bs `shouldFailWith`
        errFancy (posN (176 :: Int) bs) (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)
            [ "FILE"
            , "REM"
            , "TRACK" ]
      parseCueSheet "" bs `shouldFailWith`
        err (posN (199 :: Int) bs) (utok 80 <> es <> eeof)

testSheet :: MonadThrow m => m CueSheet
testSheet = do
  performer  <- mkCueText "Faithless"
  title      <- mkCueText "Live in Berlin"
  trackTitle <- mkCueText "Reverence"
  return CueSheet
    { cueCatalog    = Nothing
    , cueCdTextFile = Nothing
    , cuePerformer  = Just performer
    , cueTitle      = Just title
    , cueSongwriter = Nothing
    , cueFirstTrackNumber = 1
    , cueFiles      = NE.fromList
      [ CueFile
        { cueFileName = "Faithless - Live in Berlin.mp3"
        , cueFileType = MP3
        , cueFileTracks = NE.fromList
          [ CueTrack
            { cueTrackDigitalCopyPermitted = False
            , cueTrackFourChannelAudio     = False
            , cueTrackPreemphasisEnabled   = False
            , cueTrackSerialCopyManagement = False
            , cueTrackType                 = CueTrackAudio
            , cueTrackIsrc                 = Nothing
            , cueTrackTitle                = Just trackTitle
            , cueTrackPerformer            = Just performer
            , cueTrackSongwriter           = Nothing
            , cueTrackPregap               = Nothing
            , cueTrackPregapIndex          = Nothing
            , cueTrackIndices              = NE.fromList
              [CueTime 3, CueTime 151]
            , cueTrackPostgap              = Nothing } ] } ] }

normalCueSheet :: MonadThrow m => m CueSheet
normalCueSheet = do
  performer   <- mkCueText "Faithless"
  catalog     <- mkMcn "1112223334445"
  title       <- mkCueText "Live in Berlin"
  track1Title <- mkCueText "Reverence"
  track2Title <- mkCueText "She's My Baby"
  track3Title <- mkCueText "Take the Long Way Home"
  track4Title <- mkCueText "Insomnia"
  track5Title <- mkCueText "Bring the Family Back"
  track6Title <- mkCueText "Salva Mea"
  track7Title <- mkCueText "Dirty Old Man"
  track8Title <- mkCueText "God Is a DJ"
  return CueSheet
    { cueCatalog    = Just catalog
    , cueCdTextFile = Just "blah-blah.txt"
    , cuePerformer  = Just performer
    , cueTitle      = Just title
    , cueSongwriter = Nothing
    , cueFirstTrackNumber = 1
    , cueFiles      = NE.fromList
      [ CueFile
        { cueFileName = "Faithless - Live in Berlin.mp3"
        , cueFileType = MP3
        , cueFileTracks = NE.fromList
          [ CueTrack
            { cueTrackDigitalCopyPermitted = False
            , cueTrackFourChannelAudio     = False
            , cueTrackPreemphasisEnabled   = False
            , cueTrackSerialCopyManagement = False
            , cueTrackType                 = CueTrackAudio
            , cueTrackIsrc                 = Nothing
            , cueTrackTitle                = Just track1Title
            , cueTrackPerformer            = Just performer
            , cueTrackSongwriter           = Nothing
            , cueTrackPregap               = Just (CueTime 75)
            , cueTrackPregapIndex          = Nothing
            , cueTrackIndices              = NE.fromList [CueTime 0]
            , cueTrackPostgap              = Nothing }
          , CueTrack
            { cueTrackDigitalCopyPermitted = False
            , cueTrackFourChannelAudio     = False
            , cueTrackPreemphasisEnabled   = False
            , cueTrackSerialCopyManagement = False
            , cueTrackType                 = CueTrackAudio
            , cueTrackIsrc                 = Nothing
            , cueTrackTitle                = Just track2Title
            , cueTrackPerformer            = Just performer
            , cueTrackSongwriter           = Nothing
            , cueTrackPregap               = Nothing
            , cueTrackPregapIndex          = Nothing
            , cueTrackIndices              = NE.fromList [CueTime 30150]
            , cueTrackPostgap              = Nothing }
          , CueTrack
            { cueTrackDigitalCopyPermitted = False
            , cueTrackFourChannelAudio     = False
            , cueTrackPreemphasisEnabled   = False
            , cueTrackSerialCopyManagement = False
            , cueTrackType                 = CueTrackAudio
            , cueTrackIsrc                 = Nothing
            , cueTrackTitle                = Just track3Title
            , cueTrackPerformer            = Just performer
            , cueTrackSongwriter           = Nothing
            , cueTrackPregap               = Nothing
            , cueTrackPregapIndex          = Nothing
            , cueTrackIndices              = NE.fromList [CueTime 49050]
            , cueTrackPostgap              = Just (CueTime 76) }
          , CueTrack
            { cueTrackDigitalCopyPermitted = False
            , cueTrackFourChannelAudio     = False
            , cueTrackPreemphasisEnabled   = False
            , cueTrackSerialCopyManagement = False
            , cueTrackType                 = CueTrackAudio
            , cueTrackIsrc                 = Nothing
            , cueTrackTitle                = Just track4Title
            , cueTrackPerformer            = Just performer
            , cueTrackSongwriter           = Nothing
            , cueTrackPregap               = Nothing
            , cueTrackPregapIndex          = Nothing
            , cueTrackIndices              = NE.fromList
              [CueTime 76800, CueTime 76805]
            , cueTrackPostgap              = Nothing }
          , CueTrack
            { cueTrackDigitalCopyPermitted = False
            , cueTrackFourChannelAudio     = False
            , cueTrackPreemphasisEnabled   = True
            , cueTrackSerialCopyManagement = False
            , cueTrackType                 = CueTrackAudio
            , cueTrackIsrc                 = Nothing
            , cueTrackTitle                = Just track5Title
            , cueTrackPerformer            = Just performer
            , cueTrackSongwriter           = Nothing
            , cueTrackPregap               = Nothing
            , cueTrackPregapIndex          = Nothing
            , cueTrackIndices              = NE.fromList [CueTime 115800]
            , cueTrackPostgap              = Nothing }
          , CueTrack
            { cueTrackDigitalCopyPermitted = False
            , cueTrackFourChannelAudio     = False
            , cueTrackPreemphasisEnabled   = False
            , cueTrackSerialCopyManagement = False
            , cueTrackType                 = CueTrackAudio
            , cueTrackIsrc                 = Nothing
            , cueTrackTitle                = Just track6Title
            , cueTrackPerformer            = Just performer
            , cueTrackSongwriter           = Nothing
            , cueTrackPregap               = Nothing
            , cueTrackPregapIndex          = Nothing
            , cueTrackIndices              = NE.fromList [CueTime 138750]
            , cueTrackPostgap              = Nothing }
          , CueTrack
            { cueTrackDigitalCopyPermitted = False
            , cueTrackFourChannelAudio     = False
            , cueTrackPreemphasisEnabled   = False
            , cueTrackSerialCopyManagement = False
            , cueTrackType                 = CueTrackAudio
            , cueTrackIsrc                 = Nothing
            , cueTrackTitle                = Just track7Title
            , cueTrackPerformer            = Just performer
            , cueTrackSongwriter           = Nothing
            , cueTrackPregap               = Nothing
            , cueTrackPregapIndex          = Nothing
            , cueTrackIndices              = NE.fromList [CueTime 172800]
            , cueTrackPostgap              = Nothing }
          , CueTrack
            { cueTrackDigitalCopyPermitted = False
            , cueTrackFourChannelAudio     = False
            , cueTrackPreemphasisEnabled   = False
            , cueTrackSerialCopyManagement = False
            , cueTrackType                 = CueTrackAudio
            , cueTrackIsrc                 = Nothing
            , cueTrackTitle                = Just track8Title
            , cueTrackPerformer            = Just performer
            , cueTrackSongwriter           = Nothing
            , cueTrackPregap               = Nothing
            , 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 #-}