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
data CueSheet = CueSheet
{ cueCatalog :: !(Maybe Mcn)
, cueCdTextFile :: !(Maybe FilePath)
, cuePerformer :: !(Maybe CueText)
, cueTitle :: !(Maybe CueText)
, cueSongwriter :: !(Maybe CueText)
, cueFirstTrackNumber :: !Natural
, cueFiles :: !(NonEmpty CueFile)
} 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
data CueFile = CueFile
{ cueFileName :: !FilePath
, cueFileType :: !CueFileType
, cueFileTracks :: !(NonEmpty CueTrack)
} 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
data CueFileType
= Binary
| Motorola
| Aiff
| Wave
| MP3
deriving (Show, Read, Eq, Ord, Bounded, Enum, Data, Typeable, Generic)
instance Arbitrary CueFileType where
arbitrary = elements [minBound..maxBound]
data CueTrack = CueTrack
{ cueTrackDigitalCopyPermitted :: !Bool
, cueTrackFourChannelAudio :: !Bool
, cueTrackPreemphasisEnabled :: !Bool
, cueTrackSerialCopyManagement :: !Bool
, cueTrackType :: !CueTrackType
, cueTrackIsrc :: !(Maybe Isrc)
, cueTrackTitle :: !(Maybe CueText)
, cueTrackPerformer :: !(Maybe CueText)
, cueTrackSongwriter :: !(Maybe CueText)
, cueTrackPregap :: !(Maybe CueTime)
, cueTrackPregapIndex :: !(Maybe CueTime)
, cueTrackIndices :: !(NonEmpty CueTime)
, cueTrackPostgap :: !(Maybe CueTime)
} 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
data CueTrackType
= CueTrackAudio
| CueTrackCdg
| CueTrackMode1_2048
| CueTrackMode1_2352
| CueTrackMode2_2336
| CueTrackMode2_2352
| CueTrackCdi2336
| CueTrackCdi2352
deriving (Show, Read, Eq, Ord, Bounded, Enum, Data, Typeable, Generic)
instance Arbitrary CueTrackType where
arbitrary = elements [minBound..maxBound]
newtype CueTime = CueTime Natural
deriving (Show, Read, Eq, Ord, Data, Typeable, Generic)
instance Arbitrary CueTime where
arbitrary = CueTime <$> arbitrary
fromMmSsFf :: MonadThrow m
=> Natural
-> Natural
-> Natural
-> m CueTime
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')
toMmSsFf :: CueTime -> (Natural, Natural, Natural)
toMmSsFf (CueTime ff') = (mm,ss,ff)
where
(ss', ff) = ff' `quotRem` 75
(mm, ss) = ss' `quotRem` 60
showMmSsFf :: CueTime -> Text
showMmSsFf x = T.pack (printf "%02d:%02d:%02d" mm ss ff)
where
(mm,ss,ff) = toMmSsFf x
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)
mkMcn :: MonadThrow m => Text -> m Mcn
mkMcn x =
if isValidMcn x
then return (Mcn x)
else throwM (InvalidMcn x)
unMcn :: Mcn -> Text
unMcn (Mcn x) = x
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)
mkCueText :: MonadThrow m => Text -> m CueText
mkCueText x =
if isValidCueText x
then return (CueText x)
else throwM (InvalidCueText x)
unCueText :: CueText -> Text
unCueText (CueText x) = x
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)
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)
unIsrc :: Isrc -> Text
unIsrc (Isrc x) = x
data CueSheetException
= InvalidSeconds Natural
| InvalidFrames Natural
| InvalidMcn Text
| InvalidCueText Text
| InvalidIsrc Text
deriving (Eq, Ord, Show, Read, Data, Typeable, Generic)
instance Exception CueSheetException
isValidMcn :: Text -> Bool
isValidMcn x = T.length x == 13 && T.all isDigit x
isValidCueText :: Text -> Bool
isValidCueText x = l >= 1 && l <= 80 && T.all f x
where
l = T.length x
f c = c /= '\"' && c /= '\n'
isAlphaNum :: Char -> Bool
isAlphaNum a = isAscii a && (isDigit a || isLetter a)
scaleDown :: Gen a -> Gen a
scaleDown = scale (`quot` 3)
filepath :: Gen FilePath
filepath = listOf (arbitrary `suchThat` windowsLikesIt)
where
windowsLikesIt = (`notElem` "?%*:<>#|\"\\\n")