diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +## CUE sheet 0.1.0 + +* Initial release. diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,28 @@ +Copyright © 2016 Mark Karpov + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + +* Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +* Neither the name Mark Karpov nor the names of contributors may be used to + endorse or promote products derived from this software without specific + prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY EXPRESS +OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN +NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, +OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, +EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,38 @@ +# CUE sheet + +[![License BSD3](https://img.shields.io/badge/license-BSD3-brightgreen.svg)](http://opensource.org/licenses/BSD-3-Clause) +[![Hackage](https://img.shields.io/hackage/v/cue-sheet.svg?style=flat)](https://hackage.haskell.org/package/cue-sheet) +[![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. + +## What is CUE sheet? + +> A cue sheet, or cue file, is a metadata file which describes how the +> tracks of a CD or DVD are laid out. Cue sheets are stored as plain text +> files and commonly have a “.cue” filename extension. CDRWIN first +> introduced cue sheets, which are now supported by many optical disc +> authoring applications and media players. + +[Read more on Wikipedia](https://en.wikipedia.org/wiki/Cue_sheet_(computing)). +The description of the format can be +found +[here](https://wayback.archive.org/web/20070614044112/http://www.goldenhawk.com/download/cdrwin.pdf), +scroll to Appendix A (it's closest we get to a “specification”). + +## Quick start + +[Read the Haddocks](https://hackage.haskell.org/package/cue-sheet). In +short, you parse a `CueSheet` with `parseCueSheet` function and render a +`CueSheet` with `renderCueSheet` function, pretty straightforward, eh? Of +course you still can construct a `CueSheet` manually. The data types are +defined in such a way that incorrect CUE sheets are impossible to represent. + +## License + +Copyright © 2016 Mark Karpov + +Distributed under BSD 3 clause license. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Distribution.Simple + +main :: IO () +main = defaultMain diff --git a/Text/CueSheet.hs b/Text/CueSheet.hs new file mode 100644 --- /dev/null +++ b/Text/CueSheet.hs @@ -0,0 +1,49 @@ +-- | +-- Module : Text.CueSheet +-- Copyright : © 2016 Mark Karpov +-- License : BSD 3 clause +-- +-- Maintainer : Mark Karpov +-- Stability : experimental +-- Portability : portable +-- +-- The module allows to construct, read, and write CUE sheets. The data +-- types are defined in such a way that incorrect CUE sheets are impossible +-- to represent. See 'parseCueSheet' for parsing of plain text CUE sheet +-- files and 'renderCueSheet' for rendering. +-- +-- If you need to embed\/extract a CUE sheet in a FLAC file, see the @flac@ +-- package . + +module Text.CueSheet + ( -- * Types + CueSheet (..) + , CueFile (..) + , CueFileType (..) + , CueTrack (..) + , CueTrackType (..) + , CueTime (..) + , fromMmSsFf + , toMmSsFf + , showMmSsFf + , Mcn + , mkMcn + , unMcn + , CueText + , mkCueText + , unCueText + , Isrc + , mkIsrc + , unIsrc + , CueSheetException (..) + -- * Parsing + , parseCueSheet + , CueParserFailure (..) + , Eec (..) + -- * Rendering + , renderCueSheet ) +where + +import Text.CueSheet.Parser +import Text.CueSheet.Render +import Text.CueSheet.Types diff --git a/Text/CueSheet/Parser.hs b/Text/CueSheet/Parser.hs new file mode 100644 --- /dev/null +++ b/Text/CueSheet/Parser.hs @@ -0,0 +1,569 @@ +-- | +-- Module : Text.CueSheet.Parser +-- Copyright : © 2016 Mark Karpov +-- License : BSD 3 clause +-- +-- Maintainer : Mark Karpov +-- Stability : experimental +-- Portability : portable +-- +-- The modules contains just CUE sheet parser. You probably want to import +-- "Text.CueSheet" instead. + +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Text.CueSheet.Parser + ( parseCueSheet + , CueParserFailure (..) + , Eec (..) ) +where + +import Control.Applicative +import Control.Monad.State.Strict +import Data.Data (Data) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Maybe (isJust) +import Data.Text (Text) +import Data.Typeable (Typeable) +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 + +---------------------------------------------------------------------------- +-- Types + +-- | 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) + 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 ++ + maybe "" (\n -> "in declaration of the track " ++ show n) mtrack + +-- | Enumeration of all failures that may happen during run of +-- 'parseCueSheet'. + +data CueParserFailure + = CueParserFail String + | CueParserIndentation Ordering Pos Pos + | CueParserInvalidCatalog Text + | CueParserInvalidCueText Text + | CueParserTrackOutOfOrder + | CueParserInvalidTrackIsrc Text + | CueParserInvalidSeconds Natural + | CueParserInvalidFrames Natural + | CueParserTrackIndexOutOfOrder + deriving (Show, Eq, Ord, Data, Typeable, Generic) + +instance ShowErrorComponent CueParserFailure where + showErrorComponent = \case + CueParserFail msg -> + showErrorComponent (DecFail msg) + CueParserIndentation ord p0 p1 -> + showErrorComponent (DecIndentation ord p0 p1) + CueParserInvalidCatalog txt -> + "the value \"" ++ T.unpack txt ++ "\" is not a valid Media Catalog Number" + CueParserInvalidCueText txt -> + "the value \"" ++ T.unpack txt ++ "\" is not a valid CUE text literal" + CueParserTrackOutOfOrder -> + "this track appears out of order" + CueParserInvalidTrackIsrc txt -> + "\"" ++ T.unpack txt ++ "\" is not a valid ISRC" + CueParserInvalidSeconds n -> + "\"" ++ show n ++ "\" is not a valid number of seconds" + CueParserInvalidFrames n -> + "\"" ++ show n ++ "\" is not a valid number of frames" + CueParserTrackIndexOutOfOrder -> + "this index apprears out of order" + +-- | Type of parser we use here, it's not public. + +type Parser a = StateT Context (Parsec Eec BL.ByteString) a + +-- | Context of parsing. This is passed around in 'StateT'. We need all of +-- this to signal parse errors on duplicate declaration of things that +-- should only be declared once according to description of the format, to +-- validate track numbers, etc. + +data Context = Context + { contextCueSheet :: !CueSheet + -- ^ Current state of CUE sheet we parse. When a part\/parameter of CUE + -- sheet is parsed, this thing is updated. + , contextFiles :: ![CueFile] + -- ^ Temporary storage for parsed files (we can't store it in the + -- 'CueSheet' because it does not allow empty list of files). + , contextTracks :: ![CueTrack] + -- ^ Similar to 'contextFiles', collection of tracks but for current + -- file. + , contextTrackCount :: !Natural + -- ^ Number of tracks we have parsed so far, to avoid traversing lists + -- again and again. + , contextIndices :: ![CueTime] + -- ^ Temporary storage for collection indices for current track. + , contextIndexCount :: !Natural + -- ^ Similarly for indices. + } + +-- | Parse a CUE sheet from a lazy 'BL.ByteString'. + +parseCueSheet + :: String -- ^ File name to include in error messages + -> BL.ByteString -- ^ CUE sheet to parsec as a lazy 'BL.ByteString' + -> Either (ParseError Char Eec) CueSheet -- ^ 'ParseError' or result +parseCueSheet = parse (contextCueSheet <$> execStateT pCueSheet initContext) + where + initContext = Context + { contextCueSheet = CueSheet + { cueCatalog = Nothing + , cueCdTextFile = Nothing + , cuePerformer = Nothing + , cueTitle = Nothing + , cueSongwriter = Nothing + , cueFirstTrackNumber = 0 + , cueFiles = dummyFile :| [] } + , contextFiles = [] + , contextTracks = [] + , contextTrackCount = 0 + , contextIndices = [] + , contextIndexCount = 0 } + +-- | Parse a 'CueSheet'. The result is not returned, but written in +-- 'Context'. + +pCueSheet :: Parser () +pCueSheet = do + scn + void (many pHeaderItem) + void (some pFile) + -- NOTE Lens would help here, but let's keep this vanilla. + modify $ \x -> x { contextCueSheet = + (contextCueSheet x) + { cueFiles = (NE.fromList . reverse . contextFiles) x } } + eof + +pHeaderItem :: Parser () +pHeaderItem = choice + [ pCatalog + , pCdTextFile + , pPerformer + , pTitle + , pSongwriter + , pRem ] + +pCatalog :: Parser () +pCatalog = do + already <- gets (isJust . cueCatalog . contextCueSheet) + let f x' = let x = decodeUtf8 x' in + case mkMcn x of + Nothing -> Left (CueParserInvalidCatalog x) + Just mcn -> Right mcn + mcn <- labelledLit already f "CATALOG" + modify $ \x -> x { contextCueSheet = + (contextCueSheet x) { cueCatalog = Just mcn } } + +pCdTextFile :: Parser () +pCdTextFile = do + already <- gets (isJust . cueCdTextFile . contextCueSheet) + cdTextFile <- 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 + case mkCueText x of + Nothing -> Left (CueParserInvalidCueText x) + Just txt -> Right txt + performer <- labelledLit already f "PERFORMER" + modify $ \x -> x { contextCueSheet = + (contextCueSheet x) { cuePerformer = Just performer } } + +pTitle :: Parser () +pTitle = do + already <- gets (isJust . cueTitle . contextCueSheet) + let f x' = let x = decodeUtf8 x' in + case mkCueText x of + Nothing -> Left (CueParserInvalidCueText x) + Just txt -> Right txt + title <- labelledLit already f "TITLE" + modify $ \x -> x { contextCueSheet = + (contextCueSheet x) { cueTitle = Just title } } + +pSongwriter :: Parser () +pSongwriter = do + already <- gets (isJust . cueSongwriter . contextCueSheet) + let f x' = let x = decodeUtf8 x' in + case mkCueText x of + Nothing -> Left (CueParserInvalidCueText x) + Just txt -> Right txt + songwriter <- labelledLit already f "SONGWRITER" + modify $ \x -> x { contextCueSheet = + (contextCueSheet x) { cueSongwriter = Just songwriter } } + +pRem :: Parser () +pRem = do + void (symbol "REM") + manyTill anyChar eol *> scn + +pFile :: Parser () +pFile = do + void (symbol "FILE") + filename <- decodeUtf8 <$> lexeme stringLit + let pFiletype = choice + [ Binary <$ symbol "BINARY" + , Motorola <$ symbol "MOTOROLA" + , Aiff <$ symbol "AIFF" + , Wave <$ symbol "WAVE" + , MP3 <$ symbol "MP3" ] + filetype <- pFiletype <* eol <* scn + void (some (pTrack <|> pRem)) + tracks <- gets contextTracks + let newFile = CueFile + { cueFileName = T.unpack filename + , cueFileType = filetype + , cueFileTracks = NE.fromList (reverse tracks) } + modify $ \x -> x + { contextFiles = newFile : contextFiles x + , contextTracks = [] } + +pTrack :: Parser () +pTrack = do + void (symbol "TRACK") + trackOffset <- gets (cueFirstTrackNumber . contextCueSheet) + trackCount <- gets contextTrackCount + let firstTrack = trackCount == 0 + f x = + if firstTrack || x == trackOffset + trackCount + then Right x + else Left CueParserTrackOutOfOrder + n <- withCheck f (fromIntegral <$> lexeme L.integer) + let pTrackType = choice + [ CueTrackAudio <$ symbol "AUDIO" + , CueTrackCdg <$ symbol "CDG" + , CueTrackMode1_2048 <$ symbol "MODE1/2048" + , CueTrackMode1_2352 <$ symbol "MODE1/2352" + , CueTrackMode2_2336 <$ symbol "MODE2/2336" + , CueTrackMode2_2352 <$ symbol "MODE2/2352" + , CueTrackCdi2336 <$ symbol "CDI/2336" + , CueTrackCdi2352 <$ symbol "CDI/2352" ] + trackType <- pTrackType <* eol <* scn + let newTrack = dummyTrack { cueTrackType = trackType } + modify $ \x -> x + { contextTracks = newTrack : contextTracks x + , contextTrackCount = trackCount + 1 + , contextCueSheet = let old = contextCueSheet x in + if firstTrack + then old { cueFirstTrackNumber = n } + else old } + inTrack n $ do + void (many pTrackHeaderItem) + index0 <- (optional . try . pIndex) 0 + modify $ \x -> x + { contextTracks = changingFirstOf (contextTracks x) $ \t -> + t { cueTrackPregapIndex = index0 } } + modify $ \x -> x + { contextIndices = [] + , contextIndexCount = 0 } + let grabIndex = do + next <- (+ 1) <$> gets contextIndexCount + nextIndex <- pIndex next + modify $ \x -> x + { contextIndices = nextIndex : contextIndices x + , contextIndexCount = next } + void (some (grabIndex <|> pRem)) + modify $ \x -> x + { contextTracks = changingFirstOf (contextTracks x) $ \t -> + t { cueTrackIndices = (NE.fromList . reverse . contextIndices) x } } + void (optional pPostgap) + +pTrackHeaderItem :: Parser () +pTrackHeaderItem = choice + [ pFlags + , pIsrc + , pTrackPerformer + , pTrackTitle + , pTrackSongwriter + , pRem + , pPregap ] + +pFlags :: Parser () +pFlags = do + already <- gets (seenFlags . head . contextTracks) + failAtIf already "FLAGS" + void (some pFlag) <* eol <* scn + +-- | A helper data type. + +data CueTrackFlag = DCP | FourCH | PRE | SCMS + +pFlag :: Parser () +pFlag = do + flag <- choice + [ DCP <$ symbol "DCP" + , FourCH <$ symbol "4CH" + , PRE <$ symbol "PRE" + , SCMS <$ symbol "SCMS" ] + modify $ \x -> x + { contextTracks = changingFirstOf (contextTracks x) $ \t -> + case flag of + DCP -> t { cueTrackDigitalCopyPermitted = True } + FourCH -> t { cueTrackFourChannelAudio = True } + PRE -> t { cueTrackPreemphasisEnabled = True } + SCMS -> t { cueTrackSerialCopyManagement = True } } + +pIsrc :: Parser () +pIsrc = do + already <- gets (isJust . cueTrackIsrc . head . contextTracks) + let f x' = let x = T.pack x' in + case mkIsrc x of + Nothing -> Left (CueParserInvalidTrackIsrc x) + Just isrc -> Right isrc + isrc <- labelledLit already f "ISRC" + modify $ \x -> x + { contextTracks = changingFirstOf (contextTracks x) $ \t -> + t { cueTrackIsrc = Just isrc } } + +pTrackPerformer :: Parser () +pTrackPerformer = do + already <- gets (isJust . cueTrackPerformer . head . contextTracks) + let f x' = let x = decodeUtf8 x' in + case mkCueText x of + Nothing -> Left (CueParserInvalidCueText x) + Just txt -> Right txt + performer <- labelledLit already f "PERFORMER" + modify $ \x -> x + { contextTracks = changingFirstOf (contextTracks x) $ \t -> + t { cueTrackPerformer = Just performer } } + +pTrackTitle :: Parser () +pTrackTitle = do + already <- gets (isJust . cueTrackTitle . head . contextTracks) + let f x' = let x = decodeUtf8 x' in + case mkCueText x of + Nothing -> Left (CueParserInvalidCueText x) + Just txt -> Right txt + title <- labelledLit already f "TITLE" + modify $ \x -> x + { contextTracks = changingFirstOf (contextTracks x) $ \t -> + t { cueTrackTitle = Just title } } + +pTrackSongwriter :: Parser () +pTrackSongwriter = do + already <- gets (isJust . cueTrackSongwriter . head . contextTracks) + let f x' = let x = decodeUtf8 x' in + case mkCueText x of + Nothing -> Left (CueParserInvalidCueText x) + Just txt -> Right txt + songwriter <- labelledLit already f "SONGWRITER" + modify $ \x -> x + { contextTracks = changingFirstOf (contextTracks x) $ \t -> + t { cueTrackSongwriter = Just songwriter } } + +pPregap :: Parser () +pPregap = do + already <- gets (isJust . cueTrackPregap . head . contextTracks) + failAtIf already "PREGAP" + time <- lexeme cueTime <* eol <* scn + modify $ \x -> x + { contextTracks = changingFirstOf (contextTracks x) $ \t -> + t { cueTrackPregap = Just time } } + +pPostgap :: Parser () +pPostgap = do + already <- gets (isJust . cueTrackPostgap . head . contextTracks) + failAtIf already "POSTGAP" + time <- lexeme cueTime <* eol <* scn + modify $ \x -> x + { contextTracks = changingFirstOf (contextTracks x) $ \t -> + t { cueTrackPostgap = Just time } } + +pIndex :: Natural -> Parser CueTime +pIndex n = do + void (symbol "INDEX") + let f x = + if x == n + then Right () + else Left CueParserTrackIndexOutOfOrder + withCheck f (lexeme naturalLit) + lexeme cueTime <* eol <* scn + +cueTime :: Parser CueTime +cueTime = do + minutes <- naturalLit + void (char ':') + let checkSeconds n = + if n < 60 + then Right n + else Left (CueParserInvalidSeconds n) + checkFrames n = + if n < 75 + then Right n + else Left (CueParserInvalidFrames n) + seconds <- withCheck checkSeconds naturalLit + void (char ':') + frames <- withCheck checkFrames naturalLit + case fromMmSsFf minutes seconds frames of + Nothing -> empty -- NOTE must be always valid, we checked already + Just x -> return x + +---------------------------------------------------------------------------- +-- Helpers + +-- | Parse a thing and then check if it's OK conceptually. If it's not OK, +-- the error will be reported with position at the start of offending +-- lexeme, otherwise the lexeme is parsed as usual. Of course if the lexeme +-- has incorrect format, that is just reported and no additional check +-- happens. + +withCheck :: (a -> Either CueParserFailure b) -> Parser a -> Parser b +withCheck check p = do + r <- lookAhead p + case check r of + Left custom -> failure E.empty E.empty $ + E.singleton (Eec Nothing (Just custom)) + Right x -> x <$ p + +-- | 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 shouldFail command = do + let p = void (symbol command) + lookAhead p + if shouldFail + then empty + else p + +-- | Indicate that the inner parser belongs to declaration of track with +-- given index. The index of the track will be added to 'ParseError's to +-- help user find where the error happened. + +inTrack :: Natural -> Parser a -> Parser a +inTrack n m = do + r <- observing m + case r of + Left ParseError {..} -> + failure errorUnexpected errorExpected $ + if E.null errorCustom + then E.singleton (Eec (Just n) Nothing) + else E.map f errorCustom + where + f (Eec mn x) = Eec (mn <|> Just n) x + Right x -> return x + +-- | 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 + -> Parser a +labelledLit shouldFail check command = do + failAtIf shouldFail command + withCheck check (lexeme stringLit) <* eol <* scn + +-- | String literal with support for quotation. + +stringLit :: Parser String +stringLit = quoted <|> unquoted + where + quoted = char '\"' *> manyTill (noneOf ("\n" :: String)) (char '\"') + unquoted = many (noneOf ("\n\t\r " :: String)) + +-- | Parse a 'Natural'. + +naturalLit :: Parser Natural +naturalLit = fromIntegral <$> L.integer + +-- | Case-insensitive symbol parser. + +symbol :: String -> Parser String +symbol s = string' s <* notFollowedBy alphaNumChar <* sc + +-- | A wrapper for lexemes. + +lexeme :: Parser a -> Parser a +lexeme = L.lexeme sc + +-- | Space consumer (eats newlines). + +scn :: Parser () +scn = L.space (void spaceChar) empty empty + +-- | Space consumer (does not eat newlines). + +sc :: Parser () +sc = L.space (void $ oneOf ("\t " :: String)) empty empty + +-- | Determine by 'CueTrack' if we have already parsed FLAGS command. + +seenFlags :: CueTrack -> Bool +seenFlags CueTrack {..} = or + [ cueTrackDigitalCopyPermitted + , cueTrackFourChannelAudio + , cueTrackPreemphasisEnabled + , cueTrackSerialCopyManagement ] + +-- | Apply given function to the first element of the list. + +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 + +-- | A dummy file. It's only here because 'CueSheet' can't have an empty +-- list of files and it cannot be a bottom either. + +dummyFile :: CueFile +dummyFile = CueFile + { cueFileName = "" + , cueFileType = Wave + , cueFileTracks = dummyTrack :| [] } + +-- | A dummy track, see 'dummyFile'. + +dummyTrack :: CueTrack +dummyTrack = CueTrack + { cueTrackDigitalCopyPermitted = False + , cueTrackFourChannelAudio = False + , cueTrackPreemphasisEnabled = False + , cueTrackSerialCopyManagement = False + , cueTrackType = CueTrackAudio + , cueTrackIsrc = Nothing + , cueTrackTitle = Nothing + , cueTrackPerformer = Nothing + , cueTrackSongwriter = Nothing + , cueTrackPregap = Nothing + , cueTrackPregapIndex = Nothing + , cueTrackIndices = CueTime 0 :| [] + , cueTrackPostgap = Nothing } diff --git a/Text/CueSheet/Render.hs b/Text/CueSheet/Render.hs new file mode 100644 --- /dev/null +++ b/Text/CueSheet/Render.hs @@ -0,0 +1,158 @@ +-- | +-- Module : Text.CueSheet.Render +-- Copyright : © 2016 Mark Karpov +-- License : BSD 3 clause +-- +-- Maintainer : Mark Karpov +-- Stability : experimental +-- Portability : portable +-- +-- The module contains just CUE sheet render. You probably want to import +-- "Text.CueSheet" instead. + +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Text.CueSheet.Render + ( renderCueSheet ) +where + +import Control.Monad +import Control.Monad.State +import Control.Monad.Writer.Lazy +import Data.Char (isSpace, chr) +import Data.Maybe (catMaybes) +import Data.Text (Text) +import Numeric.Natural +import Text.CueSheet.Types +import Text.Printf (printf) +import qualified Data.ByteString as B +import qualified Data.ByteString.Builder as BB +import qualified Data.ByteString.Lazy as BL +import qualified Data.List.NonEmpty as NE +import qualified Data.Text as T +import qualified Data.Text.Encoding as T + +-- | Render a CUE sheet to a lazy 'BL.ByteString'. All 'Text' values in the +-- 'CueSheet' will be UTF-8 encoded. + +renderCueSheet + :: Bool -- ^ Use CRLF sequence as “end of line” separator + -> CueSheet -- ^ The 'CueSheet' to render + -> BL.ByteString -- ^ The result +renderCueSheet csrf CueSheet {..} = + BB.toLazyByteString . execWriter . flip evalStateT (max cueFirstTrackNumber 1) $ do + let eol = tell (if csrf then "\r\n" else "\n") + tellText x = + let raw = T.encodeUtf8 x + in tell . BB.byteString $ + if B.any (isSpace . chr . fromIntegral) raw || B.null raw + then "\"" <> raw <> "\"" + else raw + forM_ cueCatalog $ \x -> do + tell "CATALOG " + tellText (unMcn x) + eol + forM_ cueCdTextFile $ \x -> do + tell "CDTEXTFILE " + tellText (T.pack x) + eol + forM_ cuePerformer $ \x -> do + tell "PERFORMER " + tellText (unCueText x) + eol + forM_ cueTitle $ \x -> do + tell "TITLE " + tellText (unCueText x) + eol + forM_ cueSongwriter $ \x -> do + tell "SONGWRITER " + tellText (unCueText x) + eol + forM_ cueFiles $ \CueFile {..} -> do + tell "FILE " + tellText (T.pack cueFileName) + tell " " + tellText (renderFileType cueFileType) + eol + forM_ cueFileTracks $ \CueTrack {..} -> do + currentTrack <- get + modify succ + tell " TRACK " + tellText (formatNat currentTrack) + tell " " + tellText (renderTrackType cueTrackType) + eol + let flags = catMaybes + [ if cueTrackDigitalCopyPermitted then Just "DCP" else Nothing + , if cueTrackFourChannelAudio then Just "4CH" else Nothing + , if cueTrackPreemphasisEnabled then Just "PRE" else Nothing + , if cueTrackSerialCopyManagement then Just "SCMS" else Nothing ] + unless (null flags) $ do + tell " FLAGS " + (tell . BB.byteString) (B.intercalate " " flags) + eol + forM_ cueTrackIsrc $ \x -> do + tell " ISRC " + tellText (unIsrc x) + eol + forM_ cueTrackTitle $ \x -> do + tell " TITLE " + tellText (unCueText x) + eol + forM_ cueTrackPerformer $ \x -> do + tell " PERFORMER " + tellText (unCueText x) + eol + forM_ cueTrackSongwriter $ \x -> do + tell " SONGWRITER " + tellText (unCueText x) + eol + forM_ cueTrackPregap $ \x -> do + tell " PREGAP " + tellText (showMmSsFf x) + eol + forM_ cueTrackPregapIndex $ \x -> do + tell " INDEX 00 " + tellText (showMmSsFf x) + eol + forM_ (NE.zip (NE.fromList [1..]) cueTrackIndices) $ \(n, index) -> do + tell " INDEX " + tellText (formatNat n) + tell " " + tellText (showMmSsFf index) + eol + forM_ cueTrackPostgap $ \x -> do + tell " POSTGAP " + tellText (showMmSsFf x) + eol + +---------------------------------------------------------------------------- +-- Helpers + +-- | Format a 'Natural' padding it with zeros to 2 digits. + +formatNat :: Natural -> Text +formatNat = T.pack . printf "%02d" + +-- | Render file type as per the CUE specs. + +renderFileType :: CueFileType -> Text +renderFileType Binary = "BINARY" +renderFileType Motorola = "MOTOROLA" +renderFileType Aiff = "AIFF" +renderFileType Wave = "WAVE" +renderFileType MP3 = "MP3" + +-- | Render track type as per the CUE specs. + +renderTrackType :: CueTrackType -> Text +renderTrackType CueTrackAudio = "AUDIO" +renderTrackType CueTrackCdg = "CDG" +renderTrackType CueTrackMode1_2048 = "MODE1/2048" +renderTrackType CueTrackMode1_2352 = "MODE1/2352" +renderTrackType CueTrackMode2_2336 = "MODE2/2336" +renderTrackType CueTrackMode2_2352 = "MODE2/2352" +renderTrackType CueTrackCdi2336 = "CDI/2336" +renderTrackType CueTrackCdi2352 = "CDI/2352" diff --git a/Text/CueSheet/Types.hs b/Text/CueSheet/Types.hs new file mode 100644 --- /dev/null +++ b/Text/CueSheet/Types.hs @@ -0,0 +1,380 @@ +-- | +-- Module : Text.CueSheet.Types +-- Copyright : © 2016 Mark Karpov +-- License : BSD 3 clause +-- +-- Maintainer : Mark Karpov +-- Stability : experimental +-- Portability : portable +-- +-- Types describing structure of a CUE sheet. You probably want to import +-- "Text.CueSheet" instead. + +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} + +module Text.CueSheet.Types + ( CueSheet (..) + , CueFile (..) + , CueFileType (..) + , CueTrack (..) + , CueTrackType (..) + , CueTime (..) + , fromMmSsFf + , toMmSsFf + , showMmSsFf + , Mcn + , mkMcn + , unMcn + , CueText + , mkCueText + , unCueText + , Isrc + , mkIsrc + , unIsrc + , CueSheetException (..) ) +where + +import Control.Monad.Catch +import Data.Char (isDigit, isAscii, isLetter) +import Data.Data (Data) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Monoid ((<>)) +import Data.Text (Text) +import Data.Typeable (Typeable) +import GHC.Generics +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 + +-- | Entire CUE sheet, contains one or more files (see 'CueFile'). + +data CueSheet = CueSheet + { cueCatalog :: !(Maybe Mcn) + -- ^ Disc's Media Catalog Number (see 'Mcn'). + , cueCdTextFile :: !(Maybe FilePath) + -- ^ Name of the file that contains the encoded CD-Text information for + -- the disc. + , cuePerformer :: !(Maybe CueText) + -- ^ Performer of the entire disc. + , cueTitle :: !(Maybe CueText) + -- ^ Title of the entire disc. + , cueSongwriter :: !(Maybe CueText) + -- ^ Songwriter of the entire disc. + , cueFirstTrackNumber :: !Natural + -- ^ Number of the first track. Typically 1, but may be greater than 1. + , cueFiles :: !(NonEmpty CueFile) + -- ^ Collection of files to be written. + } deriving (Show, Eq, Ord, Data, Typeable, Generic) + +instance Arbitrary CueSheet where + arbitrary = CueSheet + <$> arbitrary + <*> oneof [pure Nothing, Just <$> filepath] + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> (arbitrary `suchThat` (> 0)) +#if MIN_VERSION_QuickCheck(2,9,0) + <*> scaleDown arbitrary +#else + <*> scaleDown (NE.fromList . getNonEmpty <$> arbitrary) +#endif + +-- | A file to be written. Single file can be divided into one or more +-- tracks (see 'CueTrack'). + +data CueFile = CueFile + { cueFileName :: !FilePath + -- ^ Name of file. + , cueFileType :: !CueFileType + -- ^ Type of file. + , cueFileTracks :: !(NonEmpty CueTrack) + -- ^ Collection of tracks in the file. + } deriving (Show, Eq, Ord, Data, Typeable, Generic) + +instance Arbitrary CueFile where + 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. + +data CueFileType + = Binary + -- ^ Intel binary file (least significant byte first). Use for data + -- files. + | Motorola + -- ^ Motorola binary file (most significant file first). Use for data + -- files. + | Aiff + -- ^ Audio AIFF file (44.1 kHz, 16 bit stereo). + | Wave + -- ^ Audio WAVE file (44.1 kHz, 16 bit stereo). + | MP3 + -- ^ Audio MP3 file (44.1 kHz 16 bit stereo). + deriving (Show, Read, Eq, Ord, Bounded, Enum, Data, Typeable, Generic) + +instance Arbitrary CueFileType where + arbitrary = elements [minBound..maxBound] + +-- | A track. Single track can have one or more indices. + +data CueTrack = CueTrack + { cueTrackDigitalCopyPermitted :: !Bool + -- ^ Flag: digital copy permitted. + , cueTrackFourChannelAudio :: !Bool + -- ^ Flag: four channel audio. + , cueTrackPreemphasisEnabled :: !Bool + -- ^ Flag: pre-emphasis enabled (audio track only). + , cueTrackSerialCopyManagement :: !Bool + -- ^ Flag: serial copy management system (not supported by all + -- recorders). + , cueTrackType :: !CueTrackType + -- ^ Type datatype. + , cueTrackIsrc :: !(Maybe Isrc) + -- ^ The track's International Standard Recording Code (ISRC). + , cueTrackTitle :: !(Maybe CueText) + -- ^ Title of the track. + , cueTrackPerformer :: !(Maybe CueText) + -- ^ Performer of the track. + , cueTrackSongwriter :: !(Maybe CueText) + -- ^ Songwriter of the track. + , cueTrackPregap :: !(Maybe CueTime) + -- ^ Track's pregap. + , cueTrackPregapIndex :: !(Maybe CueTime) + -- ^ Starting time of track pregap, a.k.a. INDEX 0. + , cueTrackIndices :: !(NonEmpty CueTime) + -- ^ Collection of indices for the track starting with index 1. The + -- index specifies the starting time of the track data. Index 1 is the + -- only index that's stored in the disc's table of contents. + , cueTrackPostgap :: !(Maybe CueTime) + -- ^ Track's postgap. + } deriving (Show, Eq, Ord, Data, Typeable, Generic) + +instance Arbitrary CueTrack where + arbitrary = CueTrack + <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary +#if MIN_VERSION_QuickCheck(2,9,0) + <*> scaleDown arbitrary +#else + <*> scaleDown (NE.fromList . getNonEmpty <$> arbitrary) +#endif + <*> arbitrary + +-- | Track datatype. + +data CueTrackType + = CueTrackAudio -- ^ Audio\/Music (2352). + | CueTrackCdg -- ^ Karaoke CD+G (2448). + | CueTrackMode1_2048 -- ^ CD-ROM Mode1 data (cooked). + | CueTrackMode1_2352 -- ^ CD-ROM Mode1 data (raw). + | CueTrackMode2_2336 -- ^ CD-ROM XA Mode2 data. + | CueTrackMode2_2352 -- ^ CD-ROM XA Mode2 data. + | CueTrackCdi2336 -- ^ CD-I Mode2 data. + | CueTrackCdi2352 -- ^ CD-I Mode2 data. + deriving (Show, Read, Eq, Ord, Bounded, Enum, Data, Typeable, Generic) + +instance Arbitrary CueTrackType where + arbitrary = elements [minBound..maxBound] + +-- | This datatype is used to indicate duration and position in time. It +-- contains number of frames. There is 75 frames in one second. + +newtype CueTime = CueTime Natural + deriving (Show, Read, Eq, Ord, Data, Typeable, Generic) + +instance Arbitrary CueTime where + arbitrary = CueTime <$> arbitrary + +-- | Construct 'CueTime' from minutes, seconds, and frames. There are 75 +-- frames per second. If number of seconds or frames is invalid, +-- 'InvalidSeconds' or 'InvalidFrames' will be thrown. + +fromMmSsFf :: MonadThrow m + => Natural -- ^ Number of minutes, no limit here + -> Natural -- ^ Number of seconds, 0–59 inclusive + -> Natural -- ^ Number of frames, 0–74 inclusive + -> m CueTime -- ^ The result +fromMmSsFf mm ss ff + | ss >= 60 = throwM (InvalidSeconds ss) + | ff >= 75 = throwM (InvalidFrames ff) + | otherwise = + let ss' = mm * 60 + ss + ff' = ss' * 75 + ff + in return (CueTime ff') + +-- | Get minutes, seconds, and frames from a 'CueTime' value. + +toMmSsFf :: CueTime -> (Natural, Natural, Natural) +toMmSsFf (CueTime ff') = (mm,ss,ff) + where + (ss', ff) = ff' `quotRem` 75 + (mm, ss) = ss' `quotRem` 60 + +-- | Render representation of 'CueTime' in @mm:ss:ff@ format. + +showMmSsFf :: CueTime -> Text +showMmSsFf x = T.pack (printf "%02d:%02d:%02d" mm ss ff) + where + (mm,ss,ff) = toMmSsFf x + +-- | Disc's Media Catalog Number (MCN), must be 13 characters long, all the +-- characters must be numeric. + +newtype Mcn = Mcn Text + deriving (Eq, Ord, Data, Typeable, Generic) + +instance Show Mcn where + show = show . unMcn + +instance Arbitrary Mcn where + arbitrary = Mcn . T.pack <$> vectorOf 13 (arbitrary `suchThat` isDigit) + +-- | Make a 'Mcn'. If the provided 'Text' value is not a valid MCN, throw +-- the 'InvalidMcnException'. + +mkMcn :: MonadThrow m => Text -> m Mcn +mkMcn x = + if isValidMcn x + then return (Mcn x) + else throwM (InvalidMcn x) + +-- | Get 'Text' from 'Mcn'. + +unMcn :: Mcn -> Text +unMcn (Mcn x) = x + +-- | A type for things like title or performer that should have length +-- between 1 and 80 characters as per spec. We also demand that it does not +-- contain @\"@ and newline characters, as it's not clear from the spec how +-- to escape them properly. + +newtype CueText = CueText Text + deriving (Eq, Ord, Data, Typeable, Generic) + +instance Show CueText where + show = show . unCueText + +instance Arbitrary CueText where + arbitrary = CueText <$> ((T.pack <$> arbitrary) `suchThat` isValidCueText) + +-- | Make a 'CueText'. If the provided 'Text' value is not a valid CUE text, +-- throw the 'InvalidCueText' exception. + +mkCueText :: MonadThrow m => Text -> m CueText +mkCueText x = + if isValidCueText x + then return (CueText x) + else throwM (InvalidCueText x) + +-- | Get 'Text' from 'CueText'. + +unCueText :: CueText -> Text +unCueText (CueText x) = x + +-- | The track's International Standard Recording Code (ISRC). It must be 12 +-- characters in length. The first five characters are alphanumeric, the +-- last seven are numeric only. + +newtype Isrc = Isrc Text + deriving (Eq, Ord, Data, Typeable, Generic) + +instance Show Isrc where + show = show . unIsrc + +instance Arbitrary Isrc where + arbitrary = do + pre <- vectorOf 5 (arbitrary `suchThat` isAlphaNum) + post <- vectorOf 7 (arbitrary `suchThat` isDigit) + (return . Isrc . T.pack) (pre <> post) + +-- | Make a 'Isrc', if the provided 'Text' value is not a valid ISRC, throw +-- the 'InvalidIsrc' exception. + +mkIsrc :: MonadThrow m => Text -> m Isrc +mkIsrc x = + if T.length x == 12 && + T.all isAlphaNum (T.take 5 x) && + T.all isDigit (T.drop 5 x) + then return (Isrc x) + else throwM (InvalidIsrc x) + +-- | Get 'Text' from 'Isrc'. + +unIsrc :: Isrc -> Text +unIsrc (Isrc x) = x + +-- | Exception type for bad things that may happen while you use the +-- library. + +data CueSheetException + = InvalidSeconds Natural + -- ^ The value is greater than 59 and thus is invalid for 'fromMmSsFf'. + | InvalidFrames Natural + -- ^ The value is greater than 74 and thus is invalid for 'fromMmSsFf'. + | InvalidMcn Text + -- ^ Provided text wasn't a correct media catalog number (MCN). + | InvalidCueText Text + -- ^ Provided text wasn't a valid CUE text. + | InvalidIsrc Text + -- ^ Provided text wasn't a valid ISRC. + deriving (Eq, Ord, Show, Read, Data, Typeable, Generic) + +instance Exception CueSheetException + +---------------------------------------------------------------------------- +-- Helpers + +-- | Check if given 'Text' is a valid MCN. + +isValidMcn :: Text -> Bool +isValidMcn x = T.length x == 13 && T.all isDigit x + +-- | Check if given 'Text' has valid length to be used in a CUE sheet as +-- performer, title, etc. + +isValidCueText :: Text -> Bool +isValidCueText x = l >= 1 && l <= 80 && T.all f x + where + l = T.length x + f c = c /= '\"' && c /= '\n' + +-- | A variant of 'Data.Char.IsAlphaNum' that only permits ASCII letter +-- chars. + +isAlphaNum :: Char -> Bool +isAlphaNum a = isAscii a && (isDigit a || isLetter a) + +-- | Scale down size of 'arbitrary'-generated stuff. + +scaleDown :: Gen a -> Gen a +scaleDown = scale (`quot` 3) + +-- | File path generator. + +filepath :: Gen FilePath +filepath = listOf (arbitrary `suchThat` windowsLikesIt) + where + windowsLikesIt = (`notElem` "?%*:<>#|\"\\\n") diff --git a/cue-sheet-samples/parser-case-insensitivity.cue b/cue-sheet-samples/parser-case-insensitivity.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-case-insensitivity.cue @@ -0,0 +1,9 @@ +perFORmer "Faithless" +rem GENRE Electronica +title "Live in Berlin" +file "Faithless - Live in Berlin.mp3" MP3 + TRack 01 AUDIO + TITLE "Reverence" + performer "Faithless" + Index 01 00:00:03 + inDex 02 00:02:01 diff --git a/cue-sheet-samples/parser-comments.cue b/cue-sheet-samples/parser-comments.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-comments.cue @@ -0,0 +1,26 @@ +REM Foo +REM Foo +PERFORMER "Faithless" +REM Bar +REM Bar +TITLE "Live in Berlin" +REM Baz +REM Baz +FILE "Faithless - Live in Berlin.mp3" MP3 + REM Quux + REM Quux + TRACK 01 AUDIO + REM Fuux + REM Fuux + TITLE "Reverence" + REM Doox + REM Doox + PERFORMER "Faithless" + REM Loox + REM Loox + INDEX 01 00:00:03 + REM Goox + REM Goox + INDEX 02 00:02:01 +REM Yay! +REM Yay! diff --git a/cue-sheet-samples/parser-duplicate-catalog.cue b/cue-sheet-samples/parser-duplicate-catalog.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-duplicate-catalog.cue @@ -0,0 +1,2 @@ +CATALOG 1112223334445 +CATALOG 1112223334445 diff --git a/cue-sheet-samples/parser-duplicate-cdtextfile.cue b/cue-sheet-samples/parser-duplicate-cdtextfile.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-duplicate-cdtextfile.cue @@ -0,0 +1,2 @@ +CDTEXTFILE my-file.txt +CDTEXTFILE my-file.txt diff --git a/cue-sheet-samples/parser-duplicate-performer.cue b/cue-sheet-samples/parser-duplicate-performer.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-duplicate-performer.cue @@ -0,0 +1,2 @@ +PERFORMER "Captain Beefheart" +PERFORMER "Captain Beefheart" diff --git a/cue-sheet-samples/parser-duplicate-songwriter.cue b/cue-sheet-samples/parser-duplicate-songwriter.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-duplicate-songwriter.cue @@ -0,0 +1,2 @@ +SONGWRITER Foobar +SONGWRITER Foobar diff --git a/cue-sheet-samples/parser-duplicate-title.cue b/cue-sheet-samples/parser-duplicate-title.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-duplicate-title.cue @@ -0,0 +1,2 @@ +TITLE "My title" +TITLE "My title" diff --git a/cue-sheet-samples/parser-duplicate-track-flags.cue b/cue-sheet-samples/parser-duplicate-track-flags.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-duplicate-track-flags.cue @@ -0,0 +1,9 @@ +PERFORMER "Faithless" +REM GENRE Electronica +TITLE "Live in Berlin" +FILE "Faithless - Live in Berlin.mp3" MP3 + TRACK 01 AUDIO + FLAGS 4CH + FLAGS 4CH + PERFORMER "Faithless" + INDEX 02 00:00:01 diff --git a/cue-sheet-samples/parser-duplicate-track-isrc.cue b/cue-sheet-samples/parser-duplicate-track-isrc.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-duplicate-track-isrc.cue @@ -0,0 +1,9 @@ +PERFORMER "Faithless" +REM GENRE Electronica +TITLE "Live in Berlin" +FILE "Faithless - Live in Berlin.mp3" MP3 + TRACK 01 AUDIO + ISRC aaabb1231231 + ISRC aaabb1231231 + PERFORMER "Faithless" + INDEX 02 00:00:01 diff --git a/cue-sheet-samples/parser-duplicate-track-performer.cue b/cue-sheet-samples/parser-duplicate-track-performer.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-duplicate-track-performer.cue @@ -0,0 +1,8 @@ +PERFORMER "Faithless" +REM GENRE Electronica +TITLE "Live in Berlin" +FILE "Faithless - Live in Berlin.mp3" MP3 + TRACK 01 AUDIO + PERFORMER "Faithless" + PERFORMER "Faithless" + INDEX 02 00:00:01 diff --git a/cue-sheet-samples/parser-duplicate-track-postgap.cue b/cue-sheet-samples/parser-duplicate-track-postgap.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-duplicate-track-postgap.cue @@ -0,0 +1,9 @@ +PERFORMER "Faithless" +REM GENRE Electronica +TITLE "Live in Berlin" +FILE "Faithless - Live in Berlin.mp3" MP3 + TRACK 01 AUDIO + PERFORMER "Faithless" + INDEX 01 00:00:01 + POSTGAP 00:01:00 + POSTGAP 00:01:00 diff --git a/cue-sheet-samples/parser-duplicate-track-pregap.cue b/cue-sheet-samples/parser-duplicate-track-pregap.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-duplicate-track-pregap.cue @@ -0,0 +1,9 @@ +PERFORMER "Faithless" +REM GENRE Electronica +TITLE "Live in Berlin" +FILE "Faithless - Live in Berlin.mp3" MP3 + TRACK 01 AUDIO + PERFORMER "Faithless" + PREGAP 00:01:00 + PREGAP 00:01:00 + INDEX 02 00:00:01 diff --git a/cue-sheet-samples/parser-duplicate-track-songwriter.cue b/cue-sheet-samples/parser-duplicate-track-songwriter.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-duplicate-track-songwriter.cue @@ -0,0 +1,9 @@ +PERFORMER "Faithless" +REM GENRE Electronica +TITLE "Live in Berlin" +FILE "Faithless - Live in Berlin.mp3" MP3 + TRACK 01 AUDIO + SONGWRITER Boba + SONGWRITER Boba + PERFORMER "Faithless" + INDEX 02 00:00:01 diff --git a/cue-sheet-samples/parser-duplicate-track-title.cue b/cue-sheet-samples/parser-duplicate-track-title.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-duplicate-track-title.cue @@ -0,0 +1,9 @@ +PERFORMER "Faithless" +REM GENRE Electronica +TITLE "Live in Berlin" +FILE "Faithless - Live in Berlin.mp3" MP3 + TRACK 01 AUDIO + TITLE "Foo" + TITLE "Foo" + PERFORMER "Faithless" + INDEX 02 00:00:01 diff --git a/cue-sheet-samples/parser-index-out-of-order.cue b/cue-sheet-samples/parser-index-out-of-order.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-index-out-of-order.cue @@ -0,0 +1,7 @@ +PERFORMER "Faithless" +REM GENRE Electronica +TITLE "Live in Berlin" +FILE "Faithless - Live in Berlin.mp3" MP3 + TRACK 01 AUDIO + PERFORMER "Faithless" + INDEX 02 00:00:01 diff --git a/cue-sheet-samples/parser-invalid-catalog.cue b/cue-sheet-samples/parser-invalid-catalog.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-invalid-catalog.cue @@ -0,0 +1,1 @@ +CATALOG 123 diff --git a/cue-sheet-samples/parser-invalid-frames.cue b/cue-sheet-samples/parser-invalid-frames.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-invalid-frames.cue @@ -0,0 +1,7 @@ +PERFORMER "Faithless" +REM GENRE Electronica +TITLE "Live in Berlin" +FILE "Faithless - Live in Berlin.mp3" MP3 + TRACK 01 AUDIO + PERFORMER "Faithless" + INDEX 01 00:00:77 diff --git a/cue-sheet-samples/parser-invalid-isrc.cue b/cue-sheet-samples/parser-invalid-isrc.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-invalid-isrc.cue @@ -0,0 +1,8 @@ +PERFORMER "Faithless" +REM GENRE Electronica +TITLE "Live in Berlin" +FILE "Faithless - Live in Berlin.mp3" MP3 + TRACK 03 AUDIO + PERFORMER "Faithless" + ISRC 123 + INDEX 01 00:00:00 diff --git a/cue-sheet-samples/parser-invalid-seconds.cue b/cue-sheet-samples/parser-invalid-seconds.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-invalid-seconds.cue @@ -0,0 +1,7 @@ +PERFORMER "Faithless" +REM GENRE Electronica +TITLE "Live in Berlin" +FILE "Faithless - Live in Berlin.mp3" MP3 + TRACK 01 AUDIO + PERFORMER "Faithless" + INDEX 01 00:61:00 diff --git a/cue-sheet-samples/parser-invalid-text.cue b/cue-sheet-samples/parser-invalid-text.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-invalid-text.cue @@ -0,0 +1,1 @@ +PERFORMER "" diff --git a/cue-sheet-samples/parser-missing-file.cue b/cue-sheet-samples/parser-missing-file.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-missing-file.cue @@ -0,0 +1,3 @@ +PERFORMER "Faithless" +REM GENRE Electronica +TITLE "Live in Berlin" diff --git a/cue-sheet-samples/parser-missing-index.cue b/cue-sheet-samples/parser-missing-index.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-missing-index.cue @@ -0,0 +1,7 @@ +PERFORMER "Faithless" +REM GENRE Electronica +TITLE "Live in Berlin" +FILE "Faithless - Live in Berlin.mp3" MP3 + TRACK 01 AUDIO + PERFORMER "Faithless" + INDEX 00 00:00:00 diff --git a/cue-sheet-samples/parser-missing-track.cue b/cue-sheet-samples/parser-missing-track.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-missing-track.cue @@ -0,0 +1,4 @@ +PERFORMER "Faithless" +REM GENRE Electronica +TITLE "Live in Berlin" +FILE "Faithless - Live in Berlin.mp3" MP3 diff --git a/cue-sheet-samples/parser-normal.cue b/cue-sheet-samples/parser-normal.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-normal.cue @@ -0,0 +1,43 @@ +REM GENRE Electronica +REM DATE 1998 +PERFORMER "Faithless" +CATALOG 1112223334445 +CDTEXTFILE blah-blah.txt +TITLE "Live in Berlin" +FILE "Faithless - Live in Berlin.mp3" MP3 + TRACK 01 AUDIO + TITLE "Reverence" + PERFORMER "Faithless" + PREGAP 00:01:00 + INDEX 01 00:00:00 + TRACK 02 AUDIO + TITLE "She's My Baby" + PERFORMER "Faithless" + INDEX 01 06:42:00 + TRACK 03 AUDIO + TITLE "Take the Long Way Home" + PERFORMER "Faithless" + INDEX 01 10:54:00 + POSTGAP 00:01:01 + TRACK 04 AUDIO + TITLE "Insomnia" + PERFORMER "Faithless" + INDEX 01 17:04:00 + INDEX 02 17:04:05 + TRACK 05 AUDIO + FLAGS PRE + TITLE "Bring the Family Back" + PERFORMER "Faithless" + INDEX 01 25:44:00 + TRACK 06 AUDIO + TITLE "Salva Mea" + PERFORMER "Faithless" + INDEX 01 30:50:00 + TRACK 07 AUDIO + TITLE "Dirty Old Man" + PERFORMER "Faithless" + INDEX 01 38:24:00 + TRACK 08 AUDIO + TITLE "God Is a DJ" + PERFORMER "Faithless" + INDEX 01 42:35:00 diff --git a/cue-sheet-samples/parser-track-out-of-order.cue b/cue-sheet-samples/parser-track-out-of-order.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-track-out-of-order.cue @@ -0,0 +1,9 @@ +PERFORMER "Faithless" +REM GENRE Electronica +TITLE "Live in Berlin" +FILE "Faithless - Live in Berlin.mp3" MP3 + TRACK 03 AUDIO + PERFORMER "Faithless" + INDEX 01 00:00:00 + TRACK 02 AUDIO + PERFORMER "Faithless" diff --git a/cue-sheet-samples/parser-whitespace.cue b/cue-sheet-samples/parser-whitespace.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/parser-whitespace.cue @@ -0,0 +1,13 @@ + + + + PERFORMER "Faithless" + REM GENRE Electronica + TITLE "Live in Berlin" +FILE "Faithless - Live in Berlin.mp3" MP3 + TRACK 01 AUDIO + TITLE "Reverence" + PERFORMER "Faithless" + INDEX 01 00:00:03 + INDEX 02 00:02:01 + diff --git a/cue-sheet-samples/rendered0.cue b/cue-sheet-samples/rendered0.cue new file mode 100644 --- /dev/null +++ b/cue-sheet-samples/rendered0.cue @@ -0,0 +1,32 @@ +CATALOG 1112223334445 +CDTEXTFILE /home/mark/mycdtextfile.txt +PERFORMER "The Famous Foobar" +TITLE "Bobla Fett" +SONGWRITER Paul +FILE the-famous-foobar-cd1.flac WAVE + TRACK 01 AUDIO + FLAGS PRE SCMS + ISRC agree1234567 + TITLE "Bobla Fett" + PERFORMER "The Famous Foobar" + INDEX 01 00:00:15 + TRACK 02 CDG + FLAGS DCP 4CH + ISRC agree1234567 + TITLE "Bobla Fett" + PERFORMER "The Famous Foobar" + PREGAP 01:00:13 + INDEX 01 00:00:15 + POSTGAP 00:08:09 +FILE the-famous-foobar-cd2.mp3 MP3 + TRACK 03 MODE1/2048 + ISRC agree1234567 + TITLE "Bobla Fett" + PERFORMER "The Famous Foobar" + INDEX 01 00:00:15 + TRACK 04 MODE2/2336 + FLAGS DCP 4CH PRE SCMS + ISRC agree1234567 + TITLE "Bobla Fett" + PERFORMER "The Famous Foobar" + INDEX 01 00:00:15 diff --git a/cue-sheet.cabal b/cue-sheet.cabal new file mode 100644 --- /dev/null +++ b/cue-sheet.cabal @@ -0,0 +1,104 @@ +-- +-- Cabal configuration for ‘cue-sheet’ package. +-- +-- Copyright © 2016 Mark Karpov +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are +-- met: +-- +-- * Redistributions of source code must retain the above copyright notice, +-- this list of conditions and the following disclaimer. +-- +-- * Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in the +-- documentation and/or other materials provided with the distribution. +-- +-- * Neither the name Mark Karpov nor the names of contributors may be used +-- to endorse or promote products derived from this software without +-- specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY +-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY +-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +-- POSSIBILITY OF SUCH DAMAGE. + +name: cue-sheet +version: 0.1.0 +cabal-version: >= 1.10 +license: BSD3 +license-file: LICENSE.md +author: Mark Karpov +maintainer: Mark Karpov +homepage: https://github.com/mrkkrp/cue-sheet +bug-reports: https://github.com/mrkkrp/cue-sheet/issues +category: Audio +synopsis: Support for construction, rendering, and parsing of CUE sheets +build-type: Simple +description: Support for construction, rendering, and parsing of CUE sheets. +extra-doc-files: CHANGELOG.md + , README.md +data-files: cue-sheet-samples/*.cue + +source-repository head + type: git + location: https://github.com/mrkkrp/cue-sheet.git + +flag dev + description: Turn on development settings. + manual: True + default: False + +library + build-depends: QuickCheck >= 2.4 && < 3.0 + , base >= 4.8 && < 5.0 + , bytestring >= 0.10.8 && < 0.11 + , containers >= 0.5.6.2 && < 0.6 + , data-default-class + , exceptions >= 0.6 && < 0.9 + , megaparsec >= 5.1.1 && < 6.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 + , Text.CueSheet.Render + if flag(dev) + ghc-options: -Wall -Werror + else + ghc-options: -O2 -Wall + default-language: Haskell2010 + +test-suite tests + main-is: Spec.hs + other-modules: Text.CueSheet.ParserSpec + , Text.CueSheet.RenderSpec + , Text.CueSheet.TypesSpec + hs-source-dirs: tests + type: exitcode-stdio-1.0 + build-depends: QuickCheck >= 2.4 && < 3.0 + , base >= 4.8 && < 5.0 + , bytestring >= 0.10.8 && < 0.11 + , cue-sheet >= 0.1 + , exceptions >= 0.6 && < 0.9 + , hspec >= 2.0 && < 3.0 + , hspec-megaparsec >= 0.3 && < 0.4 + , text >= 0.2 && < 1.3 + if !impl(ghc >= 8.0) + build-depends: semigroups == 0.18.* + + if flag(dev) + ghc-options: -Wall -Werror + else + ghc-options: -O2 -Wall + default-language: Haskell2010 diff --git a/tests/Spec.hs b/tests/Spec.hs new file mode 100644 --- /dev/null +++ b/tests/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/tests/Text/CueSheet/ParserSpec.hs b/tests/Text/CueSheet/ParserSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Text/CueSheet/ParserSpec.hs @@ -0,0 +1,423 @@ +-- +-- Parser tests for the ‘cue-sheet’ package. +-- +-- Copyright © 2016 Mark Karpov +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are +-- met: +-- +-- * Redistributions of source code must retain the above copyright notice, +-- this list of conditions and the following disclaimer. +-- +-- * Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in the +-- documentation and/or other materials provided with the distribution. +-- +-- * Neither the name Mark Karpov nor the names of contributors may be used +-- to endorse or promote products derived from this software without +-- specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY +-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY +-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +-- POSSIBILITY OF SUCH DAMAGE. + +{-# LANGUAGE OverloadedStrings #-} + +module Text.CueSheet.ParserSpec + ( spec ) +where + +import Control.Monad.Catch +import Data.Monoid ((<>)) +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 + +spec :: Spec +spec = + describe "parseCueSheet" $ do + it "correctly deals with whitespace" $ do + bs <- BL.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" + sheet <- testSheet + parseCueSheet "" bs `shouldParse` sheet + it "handles comments properly" $ do + bs <- BL.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 + [ "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 <- BL.readFile "cue-sheet-samples/parser-missing-track.cue" + parseCueSheet "" bs `shouldFailWith` + err (posN (110 :: Int) bs) (ueof <> etoks "REM" <> etoks "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) + parseCueSheet "" bs `shouldFailWith` + err (posN (180 :: Int) bs) + (ueof <> etoks "INDEX" <> etoks "REM" <> inTrack1) + it "parses a normal CUE file without issues" $ do + bs <- BL.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"))) + 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 ""))) + 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))) + 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")))) + 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)))) + 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)))) + 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))) + it "rejects duplicate CATALOG command" $ do + bs <- BL.readFile "cue-sheet-samples/parser-duplicate-catalog.cue" + let es = foldMap etoks + [ "CDTEXTFILE" + , "FILE" + , "PERFORMER" + , "REM" + , "SONGWRITER" + , "TITLE" ] + parseCueSheet "" bs `shouldFailWith` err (posN (22 :: Int) bs) + (utok 'C' <> es) + it "rejects duplicate CDTEXTFILE command" $ do + bs <- BL.readFile "cue-sheet-samples/parser-duplicate-cdtextfile.cue" + let es = foldMap etoks + [ "CATALOG" + , "FILE" + , "PERFORMER" + , "REM" + , "SONGWRITER" + , "TITLE" ] + parseCueSheet "" bs `shouldFailWith` err (posN (23 :: Int) bs) + (utok 'C' <> es) + it "rejects duplicate PERFORMER command" $ do + bs <- BL.readFile "cue-sheet-samples/parser-duplicate-performer.cue" + let es = foldMap etoks + [ "CATALOG" + , "CDTEXTFILE" + , "FILE" + , "REM" + , "SONGWRITER" + , "TITLE" ] + parseCueSheet "" bs `shouldFailWith` err (posN (30 :: Int) bs) + (utok 'P' <> es) + it "rejects duplicate TITLE command" $ do + bs <- BL.readFile "cue-sheet-samples/parser-duplicate-title.cue" + let es = foldMap etoks + [ "CATALOG" + , "CDTEXTFILE" + , "FILE" + , "PERFORMER" + , "REM" + , "SONGWRITER" ] + parseCueSheet "" bs `shouldFailWith` err (posN (17 :: Int) bs) + (utok 'T' <> es) + it "rejects duplicate SONGWRITER command" $ do + bs <- BL.readFile "cue-sheet-samples/parser-duplicate-songwriter.cue" + let es = foldMap etoks + [ "CATALOG" + , "CDTEXTFILE" + , "FILE" + , "PERFORMER" + , "REM" + , "TITLE" ] + parseCueSheet "" bs `shouldFailWith` err (posN (18 :: Int) bs) + (utok 'S' <> es) + it "rejects duplicate FLAGS command (in track)" $ do + bs <- BL.readFile "cue-sheet-samples/parser-duplicate-track-flags.cue" + let es = foldMap etoks + [ "INDEX" + , "ISRC" + , "PERFORMER" + , "PREGAP" + , "REM" + , "SONGWRITER" + , "TITLE" ] + parseCueSheet "" bs `shouldFailWith` err (posN (144 :: Int) bs) + (utok 'F' <> es <> cstm (Eec (Just 1) Nothing)) + it "rejects duplicate ISRC command (in track)" $ do + bs <- BL.readFile "cue-sheet-samples/parser-duplicate-track-isrc.cue" + let es = foldMap etoks + [ "FLAGS" + , "INDEX" + , "PERFORMER" + , "PREGAP" + , "REM" + , "SONGWRITER" + , "TITLE" ] + parseCueSheet "" bs `shouldFailWith` err (posN (152 :: Int) bs) + (utok 'I' <> utoks "IS" <> es <> cstm (Eec (Just 1) Nothing)) + it "rejects duplicate PERFORMER command (in track)" $ do + bs <- BL.readFile "cue-sheet-samples/parser-duplicate-track-performer.cue" + let es = foldMap etoks + [ "FLAGS" + , "INDEX" + , "ISRC" + , "PREGAP" + , "REM" + , "SONGWRITER" + , "TITLE" ] + parseCueSheet "" bs `shouldFailWith` err (posN (156 :: Int) bs) + (utok 'P' <> es <> cstm (Eec (Just 1) Nothing)) + it "rejects duplicate TITLE command (in track)" $ do + bs <- BL.readFile "cue-sheet-samples/parser-duplicate-track-title.cue" + let es = foldMap etoks + [ "FLAGS" + , "INDEX" + , "ISRC" + , "PERFORMER" + , "PREGAP" + , "REM" + , "SONGWRITER" ] + parseCueSheet "" bs `shouldFailWith` err (posN (146 :: Int) bs) + (utok 'T' <> es <> cstm (Eec (Just 1) Nothing)) + it "rejects duplicate SONGWRITER command (in track)" $ do + bs <- BL.readFile "cue-sheet-samples/parser-duplicate-track-songwriter.cue" + let es = foldMap etoks + [ "FLAGS" + , "INDEX" + , "ISRC" + , "PERFORMER" + , "PREGAP" + , "REM" + , "TITLE" ] + parseCueSheet "" bs `shouldFailWith` err (posN (150 :: Int) bs) + (utok 'S' <> es <> cstm (Eec (Just 1) Nothing)) + it "rejects duplicate PREGAP command (in track)" $ do + bs <- BL.readFile "cue-sheet-samples/parser-duplicate-track-pregap.cue" + let es = foldMap etoks + [ "FLAGS" + , "INDEX" + , "ISRC" + , "PERFORMER" + , "REM" + , "SONGWRITER" + , "TITLE" ] + parseCueSheet "" bs `shouldFailWith` err (posN (176 :: Int) bs) + (utok 'P' <> es <> cstm (Eec (Just 1) Nothing)) + it "rejects duplicate POSTGAP command (in track)" $ do + bs <- BL.readFile "cue-sheet-samples/parser-duplicate-track-postgap.cue" + let es = foldMap etoks + [ "FILE" + , "REM" + , "TRACK" ] + parseCueSheet "" bs `shouldFailWith` err (posN (199 :: Int) bs) + (utok 'P' <> 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 } ] } ] } diff --git a/tests/Text/CueSheet/RenderSpec.hs b/tests/Text/CueSheet/RenderSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Text/CueSheet/RenderSpec.hs @@ -0,0 +1,157 @@ +-- +-- Render tests for the ‘cue-sheet’ package. +-- +-- Copyright © 2016 Mark Karpov +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are +-- met: +-- +-- * Redistributions of source code must retain the above copyright notice, +-- this list of conditions and the following disclaimer. +-- +-- * Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in the +-- documentation and/or other materials provided with the distribution. +-- +-- * Neither the name Mark Karpov nor the names of contributors may be used +-- to endorse or promote products derived from this software without +-- specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY +-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY +-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +-- POSSIBILITY OF SUCH DAMAGE. + +{-# LANGUAGE OverloadedStrings #-} + +module Text.CueSheet.RenderSpec + ( spec ) +where + +import Control.Monad.Catch +import Data.List.NonEmpty (NonEmpty (..)) +import Test.Hspec +import Test.QuickCheck +import Text.CueSheet.Parser +import Text.CueSheet.Render +import Text.CueSheet.Types +import qualified Data.ByteString.Lazy as BL +import qualified Data.List.NonEmpty as NE + +spec :: Spec +spec = + describe "renderCueSheet" $ do + it "doesn't ever produce trailing whitespace" $ + property $ \csrf cueSheet -> do + let r = renderCueSheet csrf cueSheet + f x = if csrf then BL.take (BL.length x - 1) x else x + BL.split 10 r `shouldNotSatisfy` + any ((" " `BL.isSuffixOf`) . f) + it "always ends with the specified new line sequence" $ + property $ \csrf cueSheet -> do + let r = renderCueSheet csrf cueSheet + eol = if csrf then "\r\n" else "\n" + r `shouldSatisfy` (eol `BL.isSuffixOf`) + it "doesn't look too bad" $ do + expected <- BL.readFile "cue-sheet-samples/rendered0.cue" + cueSheet <- testCueSheet + renderCueSheet False cueSheet `shouldBe` expected + it "produces content that can be correctly parsed back" $ + property $ \csrf cueSheet -> + parseCueSheet "" (renderCueSheet csrf cueSheet) + `shouldBe` Right cueSheet + +-- | A manually constructed testing CUE sheet. + +testCueSheet :: MonadThrow m => m CueSheet +testCueSheet = do + mcn <- mkMcn "1112223334445" + performer <- mkCueText "The Famous Foobar" + title <- mkCueText "Bobla Fett" + songwriter <- mkCueText "Paul" + isrc <- mkIsrc "agree1234567" + pregap <- fromMmSsFf 1 0 13 + index <- fromMmSsFf 0 0 15 + postgap <- fromMmSsFf 0 8 9 + return CueSheet + { cueCatalog = Just mcn + , cueCdTextFile = Just "/home/mark/mycdtextfile.txt" + , cuePerformer = Just performer + , cueTitle = Just title + , cueSongwriter = Just songwriter + , cueFirstTrackNumber = 1 + , cueFiles = NE.fromList + [ CueFile + { cueFileName = "the-famous-foobar-cd1.flac" + , cueFileType = Wave + , cueFileTracks = NE.fromList + [ CueTrack + { cueTrackDigitalCopyPermitted = False + , cueTrackFourChannelAudio = False + , cueTrackPreemphasisEnabled = True + , cueTrackSerialCopyManagement = True + , cueTrackType = CueTrackAudio + , cueTrackIsrc = Just isrc + , cueTrackTitle = Just title + , cueTrackPerformer = Just performer + , cueTrackSongwriter = Nothing + , cueTrackPregap = Nothing + , cueTrackPregapIndex = Nothing + , cueTrackIndices = index :| [] + , cueTrackPostgap = Nothing } + , CueTrack + { cueTrackDigitalCopyPermitted = True + , cueTrackFourChannelAudio = True + , cueTrackPreemphasisEnabled = False + , cueTrackSerialCopyManagement = False + , cueTrackType = CueTrackCdg + , cueTrackIsrc = Just isrc + , cueTrackTitle = Just title + , cueTrackPerformer = Just performer + , cueTrackSongwriter = Nothing + , cueTrackPregap = Just pregap + , cueTrackPregapIndex = Nothing + , cueTrackIndices = index :| [] + , cueTrackPostgap = Just postgap } ] } + , CueFile + { cueFileName = "the-famous-foobar-cd2.mp3" + , cueFileType = MP3 + , cueFileTracks = NE.fromList + [ CueTrack + { cueTrackDigitalCopyPermitted = False + , cueTrackFourChannelAudio = False + , cueTrackPreemphasisEnabled = False + , cueTrackSerialCopyManagement = False + , cueTrackType = CueTrackMode1_2048 + , cueTrackIsrc = Just isrc + , cueTrackTitle = Just title + , cueTrackPerformer = Just performer + , cueTrackSongwriter = Nothing + , cueTrackPregap = Nothing + , cueTrackPregapIndex = Nothing + , cueTrackIndices = index :| [] + , cueTrackPostgap = Nothing } + , CueTrack + { cueTrackDigitalCopyPermitted = True + , cueTrackFourChannelAudio = True + , cueTrackPreemphasisEnabled = True + , cueTrackSerialCopyManagement = True + , cueTrackType = CueTrackMode2_2336 + , cueTrackIsrc = Just isrc + , cueTrackTitle = Just title + , cueTrackPerformer = Just performer + , cueTrackSongwriter = Nothing + , cueTrackPregap = Nothing + , cueTrackPregapIndex = Nothing + , cueTrackIndices = index :| [] + , cueTrackPostgap = Nothing } ] } + ] + } diff --git a/tests/Text/CueSheet/TypesSpec.hs b/tests/Text/CueSheet/TypesSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Text/CueSheet/TypesSpec.hs @@ -0,0 +1,108 @@ +-- +-- Test for ‘Text.CueSheet.Types’. +-- +-- Copyright © 2016 Mark Karpov +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are +-- met: +-- +-- * Redistributions of source code must retain the above copyright notice, +-- this list of conditions and the following disclaimer. +-- +-- * Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in the +-- documentation and/or other materials provided with the distribution. +-- +-- * Neither the name Mark Karpov nor the names of contributors may be used +-- to endorse or promote products derived from this software without +-- specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY +-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY +-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +-- POSSIBILITY OF SUCH DAMAGE. + +{-# LANGUAGE OverloadedStrings #-} + +module Text.CueSheet.TypesSpec + ( spec ) +where + +import Test.Hspec +import Test.QuickCheck +import Text.CueSheet.Types +import qualified Data.Text as T + +spec :: Spec +spec = + 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 + 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 + fromMmSsFf mm ss ff `shouldThrow` (== InvalidFrames ff) + context "if all input values are valid" $ + it "produces the correct result" $ do + fromMmSsFf 0 13 66 `shouldReturn` CueTime 1041 + fromMmSsFf 3 44 10 `shouldReturn` CueTime 16810 + fromMmSsFf 9 0 0 `shouldReturn` CueTime 40500 + describe "showMmSsFf" $ + it "works correctly" $ do + let f mm ss ff = showMmSsFf <$> fromMmSsFf mm ss ff + f 0 12 3 `shouldReturn` "00:12:03" + f 9 17 73 `shouldReturn` "09:17:73" + f 99 59 74 `shouldReturn` "99:59:74" + f 100 0 35 `shouldReturn` "100:00:35" + describe "mkMcn" $ do + context "when input value is a valid MCN" $ + it "returns the MCN all right" $ + property $ \mcn -> + mkMcn (unMcn mcn) `shouldReturn` mcn + context "when input value is invalid" $ + it "throws the correct exception" $ do + mkMcn "something" `shouldThrow` (== InvalidMcn "something") + mkMcn "123123123" `shouldThrow` (== InvalidMcn "123123123") + mkMcn "111222333444a" `shouldThrow` (== InvalidMcn "111222333444a") + describe "mkCueText" $ do + context "when input value is a valid CUE text" $ + it "returns the CueText all right" $ + property $ \cueText -> + mkCueText (unCueText cueText) `shouldReturn` cueText + context "when input value is invalid" $ do + context "when it's too short" $ + it "throws the correct exception" $ + mkCueText "" `shouldThrow` (== InvalidCueText "") + context "when it's too long" $ + it "throws the correct exception" $ do + let tooLong = T.replicate 81 "a" + mkCueText tooLong `shouldThrow` (== InvalidCueText tooLong) + context "when it contains the \" character" $ + it "throws the correct exception" $ + mkCueText "re\"re" `shouldThrow` (== InvalidCueText "re\"re") + context "when it contains the newline character" $ + it "throws the correct exception" $ + mkCueText "re\nre" `shouldThrow` (== InvalidCueText "re\nre") + describe "mkIsrc" $ do + context "when input value is a valid ISRC" $ + it "returns the ISRC all right" $ + property $ \isrc -> + mkIsrc (unIsrc isrc) `shouldReturn` isrc + context "when input value is invalid" $ + it "throws the correct exception" $ do + mkIsrc "a" `shouldThrow` (== InvalidIsrc "a") + mkIsrc "12323asoent8" `shouldThrow` (== InvalidIsrc "12323asoent8") + mkIsrc "aoe8u120997u" `shouldThrow` (== InvalidIsrc "aoe8u120997u")