{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module Text.CueSheet.Parser
( parseCueSheet,
CueParserFailure (..),
Eec (..),
)
where
import Control.Monad (void)
import Control.Monad.State.Strict (StateT, execStateT, gets, modify)
import Data.ByteString (ByteString)
import Data.Data (Data)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Maybe (isJust)
import Data.Set (Set)
import qualified Data.Set as E
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Typeable (Typeable)
import Data.Word (Word8)
import GHC.Generics
import Numeric.Natural
import Text.CueSheet.Types
import Text.Megaparsec
import Text.Megaparsec.Byte
import qualified Text.Megaparsec.Byte.Lexer as L
data Eec = Eec (Maybe Natural) CueParserFailure
deriving (Int -> Eec -> ShowS
[Eec] -> ShowS
Eec -> String
(Int -> Eec -> ShowS)
-> (Eec -> String) -> ([Eec] -> ShowS) -> Show Eec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Eec] -> ShowS
$cshowList :: [Eec] -> ShowS
show :: Eec -> String
$cshow :: Eec -> String
showsPrec :: Int -> Eec -> ShowS
$cshowsPrec :: Int -> Eec -> ShowS
Show, Eec -> Eec -> Bool
(Eec -> Eec -> Bool) -> (Eec -> Eec -> Bool) -> Eq Eec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Eec -> Eec -> Bool
$c/= :: Eec -> Eec -> Bool
== :: Eec -> Eec -> Bool
$c== :: Eec -> Eec -> Bool
Eq, Eq Eec
Eq Eec
-> (Eec -> Eec -> Ordering)
-> (Eec -> Eec -> Bool)
-> (Eec -> Eec -> Bool)
-> (Eec -> Eec -> Bool)
-> (Eec -> Eec -> Bool)
-> (Eec -> Eec -> Eec)
-> (Eec -> Eec -> Eec)
-> Ord Eec
Eec -> Eec -> Bool
Eec -> Eec -> Ordering
Eec -> Eec -> Eec
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Eec -> Eec -> Eec
$cmin :: Eec -> Eec -> Eec
max :: Eec -> Eec -> Eec
$cmax :: Eec -> Eec -> Eec
>= :: Eec -> Eec -> Bool
$c>= :: Eec -> Eec -> Bool
> :: Eec -> Eec -> Bool
$c> :: Eec -> Eec -> Bool
<= :: Eec -> Eec -> Bool
$c<= :: Eec -> Eec -> Bool
< :: Eec -> Eec -> Bool
$c< :: Eec -> Eec -> Bool
compare :: Eec -> Eec -> Ordering
$ccompare :: Eec -> Eec -> Ordering
$cp1Ord :: Eq Eec
Ord, Typeable Eec
DataType
Constr
Typeable Eec
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Eec -> c Eec)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Eec)
-> (Eec -> Constr)
-> (Eec -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Eec))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Eec))
-> ((forall b. Data b => b -> b) -> Eec -> Eec)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Eec -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Eec -> r)
-> (forall u. (forall d. Data d => d -> u) -> Eec -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Eec -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Eec -> m Eec)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Eec -> m Eec)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Eec -> m Eec)
-> Data Eec
Eec -> DataType
Eec -> Constr
(forall b. Data b => b -> b) -> Eec -> Eec
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Eec -> c Eec
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Eec
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Eec -> u
forall u. (forall d. Data d => d -> u) -> Eec -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Eec -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Eec -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Eec -> m Eec
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Eec -> m Eec
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Eec
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Eec -> c Eec
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Eec)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Eec)
$cEec :: Constr
$tEec :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Eec -> m Eec
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Eec -> m Eec
gmapMp :: (forall d. Data d => d -> m d) -> Eec -> m Eec
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Eec -> m Eec
gmapM :: (forall d. Data d => d -> m d) -> Eec -> m Eec
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Eec -> m Eec
gmapQi :: Int -> (forall d. Data d => d -> u) -> Eec -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Eec -> u
gmapQ :: (forall d. Data d => d -> u) -> Eec -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Eec -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Eec -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Eec -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Eec -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Eec -> r
gmapT :: (forall b. Data b => b -> b) -> Eec -> Eec
$cgmapT :: (forall b. Data b => b -> b) -> Eec -> Eec
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Eec)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Eec)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Eec)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Eec)
dataTypeOf :: Eec -> DataType
$cdataTypeOf :: Eec -> DataType
toConstr :: Eec -> Constr
$ctoConstr :: Eec -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Eec
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Eec
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Eec -> c Eec
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Eec -> c Eec
$cp1Data :: Typeable Eec
Data, Typeable, (forall x. Eec -> Rep Eec x)
-> (forall x. Rep Eec x -> Eec) -> Generic Eec
forall x. Rep Eec x -> Eec
forall x. Eec -> Rep Eec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Eec x -> Eec
$cfrom :: forall x. Eec -> Rep Eec x
Generic)
instance ShowErrorComponent Eec where
showErrorComponent :: Eec -> String
showErrorComponent (Eec Maybe Natural
mtrack CueParserFailure
failure') =
CueParserFailure -> String
forall a. ShowErrorComponent a => a -> String
showErrorComponent CueParserFailure
failure'
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> (Natural -> String) -> Maybe Natural -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Natural
n -> String
"in declaration of the track " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Natural -> String
forall a. Show a => a -> String
show Natural
n) Maybe Natural
mtrack
data CueParserFailure
=
CueParserTrivialError (Maybe (ErrorItem Word8)) (Set (ErrorItem Word8))
|
CueParserInvalidCatalog Text
|
CueParserInvalidCueText Text
|
CueParserTrackOutOfOrder
|
CueParserInvalidTrackIsrc Text
|
CueParserInvalidSeconds Natural
|
CueParserInvalidFrames Natural
|
CueParserTrackIndexOutOfOrder
deriving (Int -> CueParserFailure -> ShowS
[CueParserFailure] -> ShowS
CueParserFailure -> String
(Int -> CueParserFailure -> ShowS)
-> (CueParserFailure -> String)
-> ([CueParserFailure] -> ShowS)
-> Show CueParserFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CueParserFailure] -> ShowS
$cshowList :: [CueParserFailure] -> ShowS
show :: CueParserFailure -> String
$cshow :: CueParserFailure -> String
showsPrec :: Int -> CueParserFailure -> ShowS
$cshowsPrec :: Int -> CueParserFailure -> ShowS
Show, CueParserFailure -> CueParserFailure -> Bool
(CueParserFailure -> CueParserFailure -> Bool)
-> (CueParserFailure -> CueParserFailure -> Bool)
-> Eq CueParserFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CueParserFailure -> CueParserFailure -> Bool
$c/= :: CueParserFailure -> CueParserFailure -> Bool
== :: CueParserFailure -> CueParserFailure -> Bool
$c== :: CueParserFailure -> CueParserFailure -> Bool
Eq, Eq CueParserFailure
Eq CueParserFailure
-> (CueParserFailure -> CueParserFailure -> Ordering)
-> (CueParserFailure -> CueParserFailure -> Bool)
-> (CueParserFailure -> CueParserFailure -> Bool)
-> (CueParserFailure -> CueParserFailure -> Bool)
-> (CueParserFailure -> CueParserFailure -> Bool)
-> (CueParserFailure -> CueParserFailure -> CueParserFailure)
-> (CueParserFailure -> CueParserFailure -> CueParserFailure)
-> Ord CueParserFailure
CueParserFailure -> CueParserFailure -> Bool
CueParserFailure -> CueParserFailure -> Ordering
CueParserFailure -> CueParserFailure -> CueParserFailure
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CueParserFailure -> CueParserFailure -> CueParserFailure
$cmin :: CueParserFailure -> CueParserFailure -> CueParserFailure
max :: CueParserFailure -> CueParserFailure -> CueParserFailure
$cmax :: CueParserFailure -> CueParserFailure -> CueParserFailure
>= :: CueParserFailure -> CueParserFailure -> Bool
$c>= :: CueParserFailure -> CueParserFailure -> Bool
> :: CueParserFailure -> CueParserFailure -> Bool
$c> :: CueParserFailure -> CueParserFailure -> Bool
<= :: CueParserFailure -> CueParserFailure -> Bool
$c<= :: CueParserFailure -> CueParserFailure -> Bool
< :: CueParserFailure -> CueParserFailure -> Bool
$c< :: CueParserFailure -> CueParserFailure -> Bool
compare :: CueParserFailure -> CueParserFailure -> Ordering
$ccompare :: CueParserFailure -> CueParserFailure -> Ordering
$cp1Ord :: Eq CueParserFailure
Ord, Typeable CueParserFailure
DataType
Constr
Typeable CueParserFailure
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CueParserFailure -> c CueParserFailure)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CueParserFailure)
-> (CueParserFailure -> Constr)
-> (CueParserFailure -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CueParserFailure))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CueParserFailure))
-> ((forall b. Data b => b -> b)
-> CueParserFailure -> CueParserFailure)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CueParserFailure -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CueParserFailure -> r)
-> (forall u.
(forall d. Data d => d -> u) -> CueParserFailure -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> CueParserFailure -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CueParserFailure -> m CueParserFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CueParserFailure -> m CueParserFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CueParserFailure -> m CueParserFailure)
-> Data CueParserFailure
CueParserFailure -> DataType
CueParserFailure -> Constr
(forall b. Data b => b -> b)
-> CueParserFailure -> CueParserFailure
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CueParserFailure -> c CueParserFailure
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CueParserFailure
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> CueParserFailure -> u
forall u. (forall d. Data d => d -> u) -> CueParserFailure -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CueParserFailure -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CueParserFailure -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CueParserFailure -> m CueParserFailure
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CueParserFailure -> m CueParserFailure
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CueParserFailure
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CueParserFailure -> c CueParserFailure
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CueParserFailure)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CueParserFailure)
$cCueParserTrackIndexOutOfOrder :: Constr
$cCueParserInvalidFrames :: Constr
$cCueParserInvalidSeconds :: Constr
$cCueParserInvalidTrackIsrc :: Constr
$cCueParserTrackOutOfOrder :: Constr
$cCueParserInvalidCueText :: Constr
$cCueParserInvalidCatalog :: Constr
$cCueParserTrivialError :: Constr
$tCueParserFailure :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> CueParserFailure -> m CueParserFailure
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CueParserFailure -> m CueParserFailure
gmapMp :: (forall d. Data d => d -> m d)
-> CueParserFailure -> m CueParserFailure
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CueParserFailure -> m CueParserFailure
gmapM :: (forall d. Data d => d -> m d)
-> CueParserFailure -> m CueParserFailure
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CueParserFailure -> m CueParserFailure
gmapQi :: Int -> (forall d. Data d => d -> u) -> CueParserFailure -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CueParserFailure -> u
gmapQ :: (forall d. Data d => d -> u) -> CueParserFailure -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CueParserFailure -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CueParserFailure -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CueParserFailure -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CueParserFailure -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CueParserFailure -> r
gmapT :: (forall b. Data b => b -> b)
-> CueParserFailure -> CueParserFailure
$cgmapT :: (forall b. Data b => b -> b)
-> CueParserFailure -> CueParserFailure
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CueParserFailure)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CueParserFailure)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CueParserFailure)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CueParserFailure)
dataTypeOf :: CueParserFailure -> DataType
$cdataTypeOf :: CueParserFailure -> DataType
toConstr :: CueParserFailure -> Constr
$ctoConstr :: CueParserFailure -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CueParserFailure
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CueParserFailure
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CueParserFailure -> c CueParserFailure
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CueParserFailure -> c CueParserFailure
$cp1Data :: Typeable CueParserFailure
Data, Typeable, (forall x. CueParserFailure -> Rep CueParserFailure x)
-> (forall x. Rep CueParserFailure x -> CueParserFailure)
-> Generic CueParserFailure
forall x. Rep CueParserFailure x -> CueParserFailure
forall x. CueParserFailure -> Rep CueParserFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CueParserFailure x -> CueParserFailure
$cfrom :: forall x. CueParserFailure -> Rep CueParserFailure x
Generic)
instance ShowErrorComponent CueParserFailure where
showErrorComponent :: CueParserFailure -> String
showErrorComponent = \case
CueParserTrivialError Maybe (ErrorItem Word8)
us Set (ErrorItem Word8)
es ->
ShowS
forall a. [a] -> [a]
init ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
ParseError ByteString Eec -> String
forall s e.
(VisualStream s, ShowErrorComponent e) =>
ParseError s e -> String
parseErrorTextPretty
(Int
-> Maybe (ErrorItem (Token ByteString))
-> Set (ErrorItem (Token ByteString))
-> ParseError ByteString Eec
forall s e.
Int
-> Maybe (ErrorItem (Token s))
-> Set (ErrorItem (Token s))
-> ParseError s e
TrivialError Int
forall a. HasCallStack => a
undefined Maybe (ErrorItem Word8)
Maybe (ErrorItem (Token ByteString))
us Set (ErrorItem Word8)
Set (ErrorItem (Token ByteString))
es :: ParseError ByteString Eec)
CueParserInvalidCatalog Text
txt ->
String
"the value \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
txt String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" is not a valid Media Catalog Number"
CueParserInvalidCueText Text
txt ->
String
"the value \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
txt String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" is not a valid CUE text literal"
CueParserFailure
CueParserTrackOutOfOrder ->
String
"this track appears out of order"
CueParserInvalidTrackIsrc Text
txt ->
String
"\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
txt String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" is not a valid ISRC"
CueParserInvalidSeconds Natural
n ->
String
"\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Natural -> String
forall a. Show a => a -> String
show Natural
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" is not a valid number of seconds"
CueParserInvalidFrames Natural
n ->
String
"\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Natural -> String
forall a. Show a => a -> String
show Natural
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" is not a valid number of frames"
CueParserFailure
CueParserTrackIndexOutOfOrder ->
String
"this index appears out of order"
type Parser a = StateT Context (Parsec Eec ByteString) a
data Context = Context
{
Context -> CueSheet
contextCueSheet :: !CueSheet,
Context -> [CueFile]
contextFiles :: ![CueFile],
Context -> [CueTrack]
contextTracks :: ![CueTrack],
Context -> Natural
contextTrackCount :: !Natural,
Context -> [CueTime]
contextIndices :: ![CueTime],
Context -> Natural
contextIndexCount :: !Natural
}
parseCueSheet ::
String ->
ByteString ->
Either (ParseErrorBundle ByteString Eec) CueSheet
parseCueSheet :: String
-> ByteString -> Either (ParseErrorBundle ByteString Eec) CueSheet
parseCueSheet = Parsec Eec ByteString CueSheet
-> String
-> ByteString
-> Either (ParseErrorBundle ByteString Eec) CueSheet
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Context -> CueSheet
contextCueSheet (Context -> CueSheet)
-> Parsec Eec ByteString Context -> Parsec Eec ByteString CueSheet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Context (Parsec Eec ByteString) ()
-> Context -> Parsec Eec ByteString Context
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT StateT Context (Parsec Eec ByteString) ()
pCueSheet Context
initContext)
where
initContext :: Context
initContext =
Context :: CueSheet
-> [CueFile]
-> [CueTrack]
-> Natural
-> [CueTime]
-> Natural
-> Context
Context
{ contextCueSheet :: CueSheet
contextCueSheet =
CueSheet :: Maybe Mcn
-> Maybe String
-> Maybe CueText
-> Maybe CueText
-> Maybe CueText
-> Natural
-> NonEmpty CueFile
-> CueSheet
CueSheet
{ cueCatalog :: Maybe Mcn
cueCatalog = Maybe Mcn
forall a. Maybe a
Nothing,
cueCdTextFile :: Maybe String
cueCdTextFile = Maybe String
forall a. Maybe a
Nothing,
cuePerformer :: Maybe CueText
cuePerformer = Maybe CueText
forall a. Maybe a
Nothing,
cueTitle :: Maybe CueText
cueTitle = Maybe CueText
forall a. Maybe a
Nothing,
cueSongwriter :: Maybe CueText
cueSongwriter = Maybe CueText
forall a. Maybe a
Nothing,
cueFirstTrackNumber :: Natural
cueFirstTrackNumber = Natural
0,
cueFiles :: NonEmpty CueFile
cueFiles = CueFile
dummyFile CueFile -> [CueFile] -> NonEmpty CueFile
forall a. a -> [a] -> NonEmpty a
:| []
},
contextFiles :: [CueFile]
contextFiles = [],
contextTracks :: [CueTrack]
contextTracks = [],
contextTrackCount :: Natural
contextTrackCount = Natural
0,
contextIndices :: [CueTime]
contextIndices = [],
contextIndexCount :: Natural
contextIndexCount = Natural
0
}
pCueSheet :: Parser ()
pCueSheet :: StateT Context (Parsec Eec ByteString) ()
pCueSheet = do
StateT Context (Parsec Eec ByteString) ()
scn
StateT Context (Parsec Eec ByteString) [()]
-> StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many StateT Context (Parsec Eec ByteString) ()
pHeaderItem)
StateT Context (Parsec Eec ByteString) [()]
-> StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some StateT Context (Parsec Eec ByteString) ()
pFile)
(Context -> Context) -> StateT Context (Parsec Eec ByteString) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Context -> Context) -> StateT Context (Parsec Eec ByteString) ())
-> (Context -> Context)
-> StateT Context (Parsec Eec ByteString) ()
forall a b. (a -> b) -> a -> b
$ \Context
x ->
Context
x
{ contextCueSheet :: CueSheet
contextCueSheet =
(Context -> CueSheet
contextCueSheet Context
x)
{ cueFiles :: NonEmpty CueFile
cueFiles = ([CueFile] -> NonEmpty CueFile
forall a. [a] -> NonEmpty a
NE.fromList ([CueFile] -> NonEmpty CueFile)
-> (Context -> [CueFile]) -> Context -> NonEmpty CueFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CueFile] -> [CueFile]
forall a. [a] -> [a]
reverse ([CueFile] -> [CueFile])
-> (Context -> [CueFile]) -> Context -> [CueFile]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> [CueFile]
contextFiles) Context
x
}
}
StateT Context (Parsec Eec ByteString) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
pHeaderItem :: Parser ()
=
[StateT Context (Parsec Eec ByteString) ()]
-> StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ StateT Context (Parsec Eec ByteString) ()
pCatalog,
StateT Context (Parsec Eec ByteString) ()
pCdTextFile,
StateT Context (Parsec Eec ByteString) ()
pPerformer,
StateT Context (Parsec Eec ByteString) ()
pTitle,
StateT Context (Parsec Eec ByteString) ()
pSongwriter,
StateT Context (Parsec Eec ByteString) ()
pRem
]
pCatalog :: Parser ()
pCatalog :: StateT Context (Parsec Eec ByteString) ()
pCatalog = do
Bool
already <- (Context -> Bool) -> StateT Context (Parsec Eec ByteString) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Maybe Mcn -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Mcn -> Bool) -> (Context -> Maybe Mcn) -> Context -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CueSheet -> Maybe Mcn
cueCatalog (CueSheet -> Maybe Mcn)
-> (Context -> CueSheet) -> Context -> Maybe Mcn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> CueSheet
contextCueSheet)
let f :: ByteString -> Either CueParserFailure Mcn
f ByteString
x' =
let x :: Text
x = ByteString -> Text
T.decodeUtf8 ByteString
x'
in case Text -> Maybe Mcn
forall (m :: * -> *). MonadThrow m => Text -> m Mcn
mkMcn Text
x of
Maybe Mcn
Nothing -> CueParserFailure -> Either CueParserFailure Mcn
forall a b. a -> Either a b
Left (Text -> CueParserFailure
CueParserInvalidCatalog Text
x)
Just Mcn
mcn -> Mcn -> Either CueParserFailure Mcn
forall a b. b -> Either a b
Right Mcn
mcn
Mcn
mcn <- Bool
-> (ByteString -> Either CueParserFailure Mcn)
-> ByteString
-> Parser Mcn
forall a.
Bool
-> (ByteString -> Either CueParserFailure a)
-> ByteString
-> Parser a
labelledLit Bool
already ByteString -> Either CueParserFailure Mcn
f ByteString
"CATALOG"
(Context -> Context) -> StateT Context (Parsec Eec ByteString) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Context -> Context) -> StateT Context (Parsec Eec ByteString) ())
-> (Context -> Context)
-> StateT Context (Parsec Eec ByteString) ()
forall a b. (a -> b) -> a -> b
$ \Context
x ->
Context
x
{ contextCueSheet :: CueSheet
contextCueSheet =
(Context -> CueSheet
contextCueSheet Context
x) {cueCatalog :: Maybe Mcn
cueCatalog = Mcn -> Maybe Mcn
forall a. a -> Maybe a
Just Mcn
mcn}
}
pCdTextFile :: Parser ()
pCdTextFile :: StateT Context (Parsec Eec ByteString) ()
pCdTextFile = do
Bool
already <- (Context -> Bool) -> StateT Context (Parsec Eec ByteString) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool)
-> (Context -> Maybe String) -> Context -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CueSheet -> Maybe String
cueCdTextFile (CueSheet -> Maybe String)
-> (Context -> CueSheet) -> Context -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> CueSheet
contextCueSheet)
Text
cdTextFile <- ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> (ByteString -> Either CueParserFailure ByteString)
-> ByteString
-> StateT Context (Parsec Eec ByteString) ByteString
forall a.
Bool
-> (ByteString -> Either CueParserFailure a)
-> ByteString
-> Parser a
labelledLit Bool
already ByteString -> Either CueParserFailure ByteString
forall a b. b -> Either a b
Right ByteString
"CDTEXTFILE"
(Context -> Context) -> StateT Context (Parsec Eec ByteString) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Context -> Context) -> StateT Context (Parsec Eec ByteString) ())
-> (Context -> Context)
-> StateT Context (Parsec Eec ByteString) ()
forall a b. (a -> b) -> a -> b
$ \Context
x ->
Context
x
{ contextCueSheet :: CueSheet
contextCueSheet =
(Context -> CueSheet
contextCueSheet Context
x)
{ cueCdTextFile :: Maybe String
cueCdTextFile = String -> Maybe String
forall a. a -> Maybe a
Just (Text -> String
T.unpack Text
cdTextFile)
}
}
pPerformer :: Parser ()
pPerformer :: StateT Context (Parsec Eec ByteString) ()
pPerformer = do
Bool
already <- (Context -> Bool) -> StateT Context (Parsec Eec ByteString) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Maybe CueText -> Bool
forall a. Maybe a -> Bool
isJust (Maybe CueText -> Bool)
-> (Context -> Maybe CueText) -> Context -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CueSheet -> Maybe CueText
cuePerformer (CueSheet -> Maybe CueText)
-> (Context -> CueSheet) -> Context -> Maybe CueText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> CueSheet
contextCueSheet)
let f :: ByteString -> Either CueParserFailure CueText
f ByteString
x' =
let x :: Text
x = ByteString -> Text
T.decodeUtf8 ByteString
x'
in case Text -> Maybe CueText
forall (m :: * -> *). MonadThrow m => Text -> m CueText
mkCueText Text
x of
Maybe CueText
Nothing -> CueParserFailure -> Either CueParserFailure CueText
forall a b. a -> Either a b
Left (Text -> CueParserFailure
CueParserInvalidCueText Text
x)
Just CueText
txt -> CueText -> Either CueParserFailure CueText
forall a b. b -> Either a b
Right CueText
txt
CueText
performer <- Bool
-> (ByteString -> Either CueParserFailure CueText)
-> ByteString
-> Parser CueText
forall a.
Bool
-> (ByteString -> Either CueParserFailure a)
-> ByteString
-> Parser a
labelledLit Bool
already ByteString -> Either CueParserFailure CueText
f ByteString
"PERFORMER"
(Context -> Context) -> StateT Context (Parsec Eec ByteString) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Context -> Context) -> StateT Context (Parsec Eec ByteString) ())
-> (Context -> Context)
-> StateT Context (Parsec Eec ByteString) ()
forall a b. (a -> b) -> a -> b
$ \Context
x ->
Context
x
{ contextCueSheet :: CueSheet
contextCueSheet =
(Context -> CueSheet
contextCueSheet Context
x) {cuePerformer :: Maybe CueText
cuePerformer = CueText -> Maybe CueText
forall a. a -> Maybe a
Just CueText
performer}
}
pTitle :: Parser ()
pTitle :: StateT Context (Parsec Eec ByteString) ()
pTitle = do
Bool
already <- (Context -> Bool) -> StateT Context (Parsec Eec ByteString) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Maybe CueText -> Bool
forall a. Maybe a -> Bool
isJust (Maybe CueText -> Bool)
-> (Context -> Maybe CueText) -> Context -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CueSheet -> Maybe CueText
cueTitle (CueSheet -> Maybe CueText)
-> (Context -> CueSheet) -> Context -> Maybe CueText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> CueSheet
contextCueSheet)
let f :: ByteString -> Either CueParserFailure CueText
f ByteString
x' =
let x :: Text
x = ByteString -> Text
T.decodeUtf8 ByteString
x'
in case Text -> Maybe CueText
forall (m :: * -> *). MonadThrow m => Text -> m CueText
mkCueText Text
x of
Maybe CueText
Nothing -> CueParserFailure -> Either CueParserFailure CueText
forall a b. a -> Either a b
Left (Text -> CueParserFailure
CueParserInvalidCueText Text
x)
Just CueText
txt -> CueText -> Either CueParserFailure CueText
forall a b. b -> Either a b
Right CueText
txt
CueText
title <- Bool
-> (ByteString -> Either CueParserFailure CueText)
-> ByteString
-> Parser CueText
forall a.
Bool
-> (ByteString -> Either CueParserFailure a)
-> ByteString
-> Parser a
labelledLit Bool
already ByteString -> Either CueParserFailure CueText
f ByteString
"TITLE"
(Context -> Context) -> StateT Context (Parsec Eec ByteString) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Context -> Context) -> StateT Context (Parsec Eec ByteString) ())
-> (Context -> Context)
-> StateT Context (Parsec Eec ByteString) ()
forall a b. (a -> b) -> a -> b
$ \Context
x ->
Context
x
{ contextCueSheet :: CueSheet
contextCueSheet =
(Context -> CueSheet
contextCueSheet Context
x) {cueTitle :: Maybe CueText
cueTitle = CueText -> Maybe CueText
forall a. a -> Maybe a
Just CueText
title}
}
pSongwriter :: Parser ()
pSongwriter :: StateT Context (Parsec Eec ByteString) ()
pSongwriter = do
Bool
already <- (Context -> Bool) -> StateT Context (Parsec Eec ByteString) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Maybe CueText -> Bool
forall a. Maybe a -> Bool
isJust (Maybe CueText -> Bool)
-> (Context -> Maybe CueText) -> Context -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CueSheet -> Maybe CueText
cueSongwriter (CueSheet -> Maybe CueText)
-> (Context -> CueSheet) -> Context -> Maybe CueText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> CueSheet
contextCueSheet)
let f :: ByteString -> Either CueParserFailure CueText
f ByteString
x' =
let x :: Text
x = ByteString -> Text
T.decodeUtf8 ByteString
x'
in case Text -> Maybe CueText
forall (m :: * -> *). MonadThrow m => Text -> m CueText
mkCueText Text
x of
Maybe CueText
Nothing -> CueParserFailure -> Either CueParserFailure CueText
forall a b. a -> Either a b
Left (Text -> CueParserFailure
CueParserInvalidCueText Text
x)
Just CueText
txt -> CueText -> Either CueParserFailure CueText
forall a b. b -> Either a b
Right CueText
txt
CueText
songwriter <- Bool
-> (ByteString -> Either CueParserFailure CueText)
-> ByteString
-> Parser CueText
forall a.
Bool
-> (ByteString -> Either CueParserFailure a)
-> ByteString
-> Parser a
labelledLit Bool
already ByteString -> Either CueParserFailure CueText
f ByteString
"SONGWRITER"
(Context -> Context) -> StateT Context (Parsec Eec ByteString) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Context -> Context) -> StateT Context (Parsec Eec ByteString) ())
-> (Context -> Context)
-> StateT Context (Parsec Eec ByteString) ()
forall a b. (a -> b) -> a -> b
$ \Context
x ->
Context
x
{ contextCueSheet :: CueSheet
contextCueSheet =
(Context -> CueSheet
contextCueSheet Context
x) {cueSongwriter :: Maybe CueText
cueSongwriter = CueText -> Maybe CueText
forall a. a -> Maybe a
Just CueText
songwriter}
}
pRem :: Parser ()
pRem :: StateT Context (Parsec Eec ByteString) ()
pRem = do
StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ByteString -> StateT Context (Parsec Eec ByteString) ByteString
symbol ByteString
"REM")
Maybe String
-> (Token ByteString -> Bool)
-> StateT Context (Parsec Eec ByteString) (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"character") (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
10) StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) Word8
-> StateT Context (Parsec Eec ByteString) Word8
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Token ByteString
-> StateT Context (Parsec Eec ByteString) (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
10 StateT Context (Parsec Eec ByteString) Word8
-> StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT Context (Parsec Eec ByteString) ()
scn
pFile :: Parser ()
pFile :: StateT Context (Parsec Eec ByteString) ()
pFile = do
StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ByteString -> StateT Context (Parsec Eec ByteString) ByteString
symbol ByteString
"FILE")
Text
filename <- ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) ByteString
forall a. Parser a -> Parser a
lexeme StateT Context (Parsec Eec ByteString) ByteString
stringLit
let pFiletype :: StateT Context (Parsec Eec ByteString) CueFileType
pFiletype =
[StateT Context (Parsec Eec ByteString) CueFileType]
-> StateT Context (Parsec Eec ByteString) CueFileType
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ CueFileType
Binary CueFileType
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) CueFileType
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> StateT Context (Parsec Eec ByteString) ByteString
symbol ByteString
"BINARY",
CueFileType
Motorola CueFileType
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) CueFileType
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> StateT Context (Parsec Eec ByteString) ByteString
symbol ByteString
"MOTOROLA",
CueFileType
Aiff CueFileType
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) CueFileType
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> StateT Context (Parsec Eec ByteString) ByteString
symbol ByteString
"AIFF",
CueFileType
Wave CueFileType
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) CueFileType
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> StateT Context (Parsec Eec ByteString) ByteString
symbol ByteString
"WAVE",
CueFileType
MP3 CueFileType
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) CueFileType
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> StateT Context (Parsec Eec ByteString) ByteString
symbol ByteString
"MP3"
]
CueFileType
filetype <- StateT Context (Parsec Eec ByteString) CueFileType
pFiletype StateT Context (Parsec Eec ByteString) CueFileType
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) CueFileType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Context (Parsec Eec ByteString) ByteString
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Tokens s)
eol StateT Context (Parsec Eec ByteString) CueFileType
-> StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) CueFileType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Context (Parsec Eec ByteString) ()
scn
StateT Context (Parsec Eec ByteString) [()]
-> StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (StateT Context (Parsec Eec ByteString) ()
pTrack StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT Context (Parsec Eec ByteString) ()
pRem))
[CueTrack]
tracks <- (Context -> [CueTrack])
-> StateT Context (Parsec Eec ByteString) [CueTrack]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Context -> [CueTrack]
contextTracks
let newFile :: CueFile
newFile =
CueFile :: String -> CueFileType -> NonEmpty CueTrack -> CueFile
CueFile
{ cueFileName :: String
cueFileName = Text -> String
T.unpack Text
filename,
cueFileType :: CueFileType
cueFileType = CueFileType
filetype,
cueFileTracks :: NonEmpty CueTrack
cueFileTracks = [CueTrack] -> NonEmpty CueTrack
forall a. [a] -> NonEmpty a
NE.fromList ([CueTrack] -> [CueTrack]
forall a. [a] -> [a]
reverse [CueTrack]
tracks)
}
(Context -> Context) -> StateT Context (Parsec Eec ByteString) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Context -> Context) -> StateT Context (Parsec Eec ByteString) ())
-> (Context -> Context)
-> StateT Context (Parsec Eec ByteString) ()
forall a b. (a -> b) -> a -> b
$ \Context
x ->
Context
x
{ contextFiles :: [CueFile]
contextFiles = CueFile
newFile CueFile -> [CueFile] -> [CueFile]
forall a. a -> [a] -> [a]
: Context -> [CueFile]
contextFiles Context
x,
contextTracks :: [CueTrack]
contextTracks = []
}
pTrack :: Parser ()
pTrack :: StateT Context (Parsec Eec ByteString) ()
pTrack = do
StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ByteString -> StateT Context (Parsec Eec ByteString) ByteString
symbol ByteString
"TRACK")
Natural
trackOffset <- (Context -> Natural)
-> StateT Context (Parsec Eec ByteString) Natural
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (CueSheet -> Natural
cueFirstTrackNumber (CueSheet -> Natural)
-> (Context -> CueSheet) -> Context -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> CueSheet
contextCueSheet)
Natural
trackCount <- (Context -> Natural)
-> StateT Context (Parsec Eec ByteString) Natural
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Context -> Natural
contextTrackCount
let firstTrack :: Bool
firstTrack = Natural
trackCount Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
0
f :: Natural -> Either CueParserFailure Natural
f Natural
x =
if Bool
firstTrack Bool -> Bool -> Bool
|| Natural
x Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
trackOffset Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
trackCount
then Natural -> Either CueParserFailure Natural
forall a b. b -> Either a b
Right Natural
x
else CueParserFailure -> Either CueParserFailure Natural
forall a b. a -> Either a b
Left CueParserFailure
CueParserTrackOutOfOrder
Natural
n <- (Natural -> Either CueParserFailure Natural)
-> StateT Context (Parsec Eec ByteString) Natural
-> StateT Context (Parsec Eec ByteString) Natural
forall a b.
(a -> Either CueParserFailure b) -> Parser a -> Parser b
withCheck Natural -> Either CueParserFailure Natural
f (StateT Context (Parsec Eec ByteString) Natural
-> StateT Context (Parsec Eec ByteString) Natural
forall a. Parser a -> Parser a
lexeme StateT Context (Parsec Eec ByteString) Natural
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
L.decimal)
let pTrackType :: StateT Context (Parsec Eec ByteString) CueTrackType
pTrackType =
[StateT Context (Parsec Eec ByteString) CueTrackType]
-> StateT Context (Parsec Eec ByteString) CueTrackType
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ CueTrackType
CueTrackAudio CueTrackType
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) CueTrackType
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> StateT Context (Parsec Eec ByteString) ByteString
symbol ByteString
"AUDIO",
CueTrackType
CueTrackCdg CueTrackType
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) CueTrackType
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> StateT Context (Parsec Eec ByteString) ByteString
symbol ByteString
"CDG",
CueTrackType
CueTrackMode1_2048 CueTrackType
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) CueTrackType
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> StateT Context (Parsec Eec ByteString) ByteString
symbol ByteString
"MODE1/2048",
CueTrackType
CueTrackMode1_2352 CueTrackType
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) CueTrackType
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> StateT Context (Parsec Eec ByteString) ByteString
symbol ByteString
"MODE1/2352",
CueTrackType
CueTrackMode2_2336 CueTrackType
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) CueTrackType
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> StateT Context (Parsec Eec ByteString) ByteString
symbol ByteString
"MODE2/2336",
CueTrackType
CueTrackMode2_2352 CueTrackType
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) CueTrackType
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> StateT Context (Parsec Eec ByteString) ByteString
symbol ByteString
"MODE2/2352",
CueTrackType
CueTrackCdi2336 CueTrackType
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) CueTrackType
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> StateT Context (Parsec Eec ByteString) ByteString
symbol ByteString
"CDI/2336",
CueTrackType
CueTrackCdi2352 CueTrackType
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) CueTrackType
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> StateT Context (Parsec Eec ByteString) ByteString
symbol ByteString
"CDI/2352"
]
CueTrackType
trackType <- StateT Context (Parsec Eec ByteString) CueTrackType
pTrackType StateT Context (Parsec Eec ByteString) CueTrackType
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) CueTrackType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Context (Parsec Eec ByteString) ByteString
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Tokens s)
eol StateT Context (Parsec Eec ByteString) CueTrackType
-> StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) CueTrackType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Context (Parsec Eec ByteString) ()
scn
let newTrack :: CueTrack
newTrack = CueTrack
dummyTrack {cueTrackType :: CueTrackType
cueTrackType = CueTrackType
trackType}
(Context -> Context) -> StateT Context (Parsec Eec ByteString) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Context -> Context) -> StateT Context (Parsec Eec ByteString) ())
-> (Context -> Context)
-> StateT Context (Parsec Eec ByteString) ()
forall a b. (a -> b) -> a -> b
$ \Context
x ->
Context
x
{ contextTracks :: [CueTrack]
contextTracks = CueTrack
newTrack CueTrack -> [CueTrack] -> [CueTrack]
forall a. a -> [a] -> [a]
: Context -> [CueTrack]
contextTracks Context
x,
contextTrackCount :: Natural
contextTrackCount = Natural
trackCount Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1,
contextCueSheet :: CueSheet
contextCueSheet =
let old :: CueSheet
old = Context -> CueSheet
contextCueSheet Context
x
in if Bool
firstTrack
then CueSheet
old {cueFirstTrackNumber :: Natural
cueFirstTrackNumber = Natural
n}
else CueSheet
old
}
Natural
-> StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) ()
forall a. Natural -> Parser a -> Parser a
inTrack Natural
n (StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) ())
-> StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) ()
forall a b. (a -> b) -> a -> b
$ do
StateT Context (Parsec Eec ByteString) [()]
-> StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many StateT Context (Parsec Eec ByteString) ()
pTrackHeaderItem)
Maybe CueTime
index0 <- (StateT Context (Parsec Eec ByteString) CueTime
-> StateT Context (Parsec Eec ByteString) (Maybe CueTime)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT Context (Parsec Eec ByteString) CueTime
-> StateT Context (Parsec Eec ByteString) (Maybe CueTime))
-> (Natural -> StateT Context (Parsec Eec ByteString) CueTime)
-> Natural
-> StateT Context (Parsec Eec ByteString) (Maybe CueTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT Context (Parsec Eec ByteString) CueTime
-> StateT Context (Parsec Eec ByteString) CueTime
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (StateT Context (Parsec Eec ByteString) CueTime
-> StateT Context (Parsec Eec ByteString) CueTime)
-> (Natural -> StateT Context (Parsec Eec ByteString) CueTime)
-> Natural
-> StateT Context (Parsec Eec ByteString) CueTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> StateT Context (Parsec Eec ByteString) CueTime
pIndex) Natural
0
(Context -> Context) -> StateT Context (Parsec Eec ByteString) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Context -> Context) -> StateT Context (Parsec Eec ByteString) ())
-> (Context -> Context)
-> StateT Context (Parsec Eec ByteString) ()
forall a b. (a -> b) -> a -> b
$ \Context
x ->
Context
x
{ contextTracks :: [CueTrack]
contextTracks = [CueTrack] -> (CueTrack -> CueTrack) -> [CueTrack]
forall a. [a] -> (a -> a) -> [a]
changingFirstOf (Context -> [CueTrack]
contextTracks Context
x) ((CueTrack -> CueTrack) -> [CueTrack])
-> (CueTrack -> CueTrack) -> [CueTrack]
forall a b. (a -> b) -> a -> b
$ \CueTrack
t ->
CueTrack
t {cueTrackPregapIndex :: Maybe CueTime
cueTrackPregapIndex = Maybe CueTime
index0}
}
(Context -> Context) -> StateT Context (Parsec Eec ByteString) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Context -> Context) -> StateT Context (Parsec Eec ByteString) ())
-> (Context -> Context)
-> StateT Context (Parsec Eec ByteString) ()
forall a b. (a -> b) -> a -> b
$ \Context
x ->
Context
x
{ contextIndices :: [CueTime]
contextIndices = [],
contextIndexCount :: Natural
contextIndexCount = Natural
0
}
let grabIndex :: StateT Context (Parsec Eec ByteString) ()
grabIndex = do
Natural
next <- (Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1) (Natural -> Natural)
-> StateT Context (Parsec Eec ByteString) Natural
-> StateT Context (Parsec Eec ByteString) Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Context -> Natural)
-> StateT Context (Parsec Eec ByteString) Natural
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Context -> Natural
contextIndexCount
CueTime
nextIndex <- Natural -> StateT Context (Parsec Eec ByteString) CueTime
pIndex Natural
next
(Context -> Context) -> StateT Context (Parsec Eec ByteString) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Context -> Context) -> StateT Context (Parsec Eec ByteString) ())
-> (Context -> Context)
-> StateT Context (Parsec Eec ByteString) ()
forall a b. (a -> b) -> a -> b
$ \Context
x ->
Context
x
{ contextIndices :: [CueTime]
contextIndices = CueTime
nextIndex CueTime -> [CueTime] -> [CueTime]
forall a. a -> [a] -> [a]
: Context -> [CueTime]
contextIndices Context
x,
contextIndexCount :: Natural
contextIndexCount = Natural
next
}
StateT Context (Parsec Eec ByteString) [()]
-> StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (StateT Context (Parsec Eec ByteString) ()
grabIndex StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT Context (Parsec Eec ByteString) ()
pRem))
(Context -> Context) -> StateT Context (Parsec Eec ByteString) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Context -> Context) -> StateT Context (Parsec Eec ByteString) ())
-> (Context -> Context)
-> StateT Context (Parsec Eec ByteString) ()
forall a b. (a -> b) -> a -> b
$ \Context
x ->
Context
x
{ contextTracks :: [CueTrack]
contextTracks = [CueTrack] -> (CueTrack -> CueTrack) -> [CueTrack]
forall a. [a] -> (a -> a) -> [a]
changingFirstOf (Context -> [CueTrack]
contextTracks Context
x) ((CueTrack -> CueTrack) -> [CueTrack])
-> (CueTrack -> CueTrack) -> [CueTrack]
forall a b. (a -> b) -> a -> b
$ \CueTrack
t ->
CueTrack
t {cueTrackIndices :: NonEmpty CueTime
cueTrackIndices = ([CueTime] -> NonEmpty CueTime
forall a. [a] -> NonEmpty a
NE.fromList ([CueTime] -> NonEmpty CueTime)
-> (Context -> [CueTime]) -> Context -> NonEmpty CueTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CueTime] -> [CueTime]
forall a. [a] -> [a]
reverse ([CueTime] -> [CueTime])
-> (Context -> [CueTime]) -> Context -> [CueTime]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> [CueTime]
contextIndices) Context
x}
}
StateT Context (Parsec Eec ByteString) (Maybe ())
-> StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT Context (Parsec Eec ByteString) ()
pPostgap)
pTrackHeaderItem :: Parser ()
=
[StateT Context (Parsec Eec ByteString) ()]
-> StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ StateT Context (Parsec Eec ByteString) ()
pFlags,
StateT Context (Parsec Eec ByteString) ()
pIsrc,
StateT Context (Parsec Eec ByteString) ()
pTrackPerformer,
StateT Context (Parsec Eec ByteString) ()
pTrackTitle,
StateT Context (Parsec Eec ByteString) ()
pTrackSongwriter,
StateT Context (Parsec Eec ByteString) ()
pRem,
StateT Context (Parsec Eec ByteString) ()
pPregap
]
pFlags :: Parser ()
pFlags :: StateT Context (Parsec Eec ByteString) ()
pFlags = do
Bool
already <- (Context -> Bool) -> StateT Context (Parsec Eec ByteString) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (CueTrack -> Bool
seenFlags (CueTrack -> Bool) -> (Context -> CueTrack) -> Context -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CueTrack] -> CueTrack
forall a. [a] -> a
head ([CueTrack] -> CueTrack)
-> (Context -> [CueTrack]) -> Context -> CueTrack
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> [CueTrack]
contextTracks)
Bool -> ByteString -> StateT Context (Parsec Eec ByteString) ()
failAtIf Bool
already ByteString
"FLAGS"
StateT Context (Parsec Eec ByteString) [()]
-> StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some StateT Context (Parsec Eec ByteString) ()
pFlag) StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Context (Parsec Eec ByteString) ByteString
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Tokens s)
eol StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Context (Parsec Eec ByteString) ()
scn
data CueTrackFlag = DCP | FourCH | PRE | SCMS
pFlag :: Parser ()
pFlag :: StateT Context (Parsec Eec ByteString) ()
pFlag = do
CueTrackFlag
flag <-
[StateT Context (Parsec Eec ByteString) CueTrackFlag]
-> StateT Context (Parsec Eec ByteString) CueTrackFlag
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ CueTrackFlag
DCP CueTrackFlag
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) CueTrackFlag
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> StateT Context (Parsec Eec ByteString) ByteString
symbol ByteString
"DCP",
CueTrackFlag
FourCH CueTrackFlag
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) CueTrackFlag
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> StateT Context (Parsec Eec ByteString) ByteString
symbol ByteString
"4CH",
CueTrackFlag
PRE CueTrackFlag
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) CueTrackFlag
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> StateT Context (Parsec Eec ByteString) ByteString
symbol ByteString
"PRE",
CueTrackFlag
SCMS CueTrackFlag
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) CueTrackFlag
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> StateT Context (Parsec Eec ByteString) ByteString
symbol ByteString
"SCMS"
]
(Context -> Context) -> StateT Context (Parsec Eec ByteString) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Context -> Context) -> StateT Context (Parsec Eec ByteString) ())
-> (Context -> Context)
-> StateT Context (Parsec Eec ByteString) ()
forall a b. (a -> b) -> a -> b
$ \Context
x ->
Context
x
{ contextTracks :: [CueTrack]
contextTracks = [CueTrack] -> (CueTrack -> CueTrack) -> [CueTrack]
forall a. [a] -> (a -> a) -> [a]
changingFirstOf (Context -> [CueTrack]
contextTracks Context
x) ((CueTrack -> CueTrack) -> [CueTrack])
-> (CueTrack -> CueTrack) -> [CueTrack]
forall a b. (a -> b) -> a -> b
$ \CueTrack
t ->
case CueTrackFlag
flag of
CueTrackFlag
DCP -> CueTrack
t {cueTrackDigitalCopyPermitted :: Bool
cueTrackDigitalCopyPermitted = Bool
True}
CueTrackFlag
FourCH -> CueTrack
t {cueTrackFourChannelAudio :: Bool
cueTrackFourChannelAudio = Bool
True}
CueTrackFlag
PRE -> CueTrack
t {cueTrackPreemphasisEnabled :: Bool
cueTrackPreemphasisEnabled = Bool
True}
CueTrackFlag
SCMS -> CueTrack
t {cueTrackSerialCopyManagement :: Bool
cueTrackSerialCopyManagement = Bool
True}
}
pIsrc :: Parser ()
pIsrc :: StateT Context (Parsec Eec ByteString) ()
pIsrc = do
Bool
already <- (Context -> Bool) -> StateT Context (Parsec Eec ByteString) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Maybe Isrc -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Isrc -> Bool) -> (Context -> Maybe Isrc) -> Context -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CueTrack -> Maybe Isrc
cueTrackIsrc (CueTrack -> Maybe Isrc)
-> (Context -> CueTrack) -> Context -> Maybe Isrc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CueTrack] -> CueTrack
forall a. [a] -> a
head ([CueTrack] -> CueTrack)
-> (Context -> [CueTrack]) -> Context -> CueTrack
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> [CueTrack]
contextTracks)
let f :: ByteString -> Either CueParserFailure Isrc
f ByteString
x' =
let x :: Text
x = ByteString -> Text
T.decodeUtf8 ByteString
x'
in case Text -> Maybe Isrc
forall (m :: * -> *). MonadThrow m => Text -> m Isrc
mkIsrc Text
x of
Maybe Isrc
Nothing -> CueParserFailure -> Either CueParserFailure Isrc
forall a b. a -> Either a b
Left (Text -> CueParserFailure
CueParserInvalidTrackIsrc Text
x)
Just Isrc
isrc -> Isrc -> Either CueParserFailure Isrc
forall a b. b -> Either a b
Right Isrc
isrc
Isrc
isrc <- Bool
-> (ByteString -> Either CueParserFailure Isrc)
-> ByteString
-> Parser Isrc
forall a.
Bool
-> (ByteString -> Either CueParserFailure a)
-> ByteString
-> Parser a
labelledLit Bool
already ByteString -> Either CueParserFailure Isrc
f ByteString
"ISRC"
(Context -> Context) -> StateT Context (Parsec Eec ByteString) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Context -> Context) -> StateT Context (Parsec Eec ByteString) ())
-> (Context -> Context)
-> StateT Context (Parsec Eec ByteString) ()
forall a b. (a -> b) -> a -> b
$ \Context
x ->
Context
x
{ contextTracks :: [CueTrack]
contextTracks = [CueTrack] -> (CueTrack -> CueTrack) -> [CueTrack]
forall a. [a] -> (a -> a) -> [a]
changingFirstOf (Context -> [CueTrack]
contextTracks Context
x) ((CueTrack -> CueTrack) -> [CueTrack])
-> (CueTrack -> CueTrack) -> [CueTrack]
forall a b. (a -> b) -> a -> b
$ \CueTrack
t ->
CueTrack
t {cueTrackIsrc :: Maybe Isrc
cueTrackIsrc = Isrc -> Maybe Isrc
forall a. a -> Maybe a
Just Isrc
isrc}
}
pTrackPerformer :: Parser ()
pTrackPerformer :: StateT Context (Parsec Eec ByteString) ()
pTrackPerformer = do
Bool
already <- (Context -> Bool) -> StateT Context (Parsec Eec ByteString) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Maybe CueText -> Bool
forall a. Maybe a -> Bool
isJust (Maybe CueText -> Bool)
-> (Context -> Maybe CueText) -> Context -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CueTrack -> Maybe CueText
cueTrackPerformer (CueTrack -> Maybe CueText)
-> (Context -> CueTrack) -> Context -> Maybe CueText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CueTrack] -> CueTrack
forall a. [a] -> a
head ([CueTrack] -> CueTrack)
-> (Context -> [CueTrack]) -> Context -> CueTrack
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> [CueTrack]
contextTracks)
let f :: ByteString -> Either CueParserFailure CueText
f ByteString
x' =
let x :: Text
x = ByteString -> Text
T.decodeUtf8 ByteString
x'
in case Text -> Maybe CueText
forall (m :: * -> *). MonadThrow m => Text -> m CueText
mkCueText Text
x of
Maybe CueText
Nothing -> CueParserFailure -> Either CueParserFailure CueText
forall a b. a -> Either a b
Left (Text -> CueParserFailure
CueParserInvalidCueText Text
x)
Just CueText
txt -> CueText -> Either CueParserFailure CueText
forall a b. b -> Either a b
Right CueText
txt
CueText
performer <- Bool
-> (ByteString -> Either CueParserFailure CueText)
-> ByteString
-> Parser CueText
forall a.
Bool
-> (ByteString -> Either CueParserFailure a)
-> ByteString
-> Parser a
labelledLit Bool
already ByteString -> Either CueParserFailure CueText
f ByteString
"PERFORMER"
(Context -> Context) -> StateT Context (Parsec Eec ByteString) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Context -> Context) -> StateT Context (Parsec Eec ByteString) ())
-> (Context -> Context)
-> StateT Context (Parsec Eec ByteString) ()
forall a b. (a -> b) -> a -> b
$ \Context
x ->
Context
x
{ contextTracks :: [CueTrack]
contextTracks = [CueTrack] -> (CueTrack -> CueTrack) -> [CueTrack]
forall a. [a] -> (a -> a) -> [a]
changingFirstOf (Context -> [CueTrack]
contextTracks Context
x) ((CueTrack -> CueTrack) -> [CueTrack])
-> (CueTrack -> CueTrack) -> [CueTrack]
forall a b. (a -> b) -> a -> b
$ \CueTrack
t ->
CueTrack
t {cueTrackPerformer :: Maybe CueText
cueTrackPerformer = CueText -> Maybe CueText
forall a. a -> Maybe a
Just CueText
performer}
}
pTrackTitle :: Parser ()
pTrackTitle :: StateT Context (Parsec Eec ByteString) ()
pTrackTitle = do
Bool
already <- (Context -> Bool) -> StateT Context (Parsec Eec ByteString) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Maybe CueText -> Bool
forall a. Maybe a -> Bool
isJust (Maybe CueText -> Bool)
-> (Context -> Maybe CueText) -> Context -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CueTrack -> Maybe CueText
cueTrackTitle (CueTrack -> Maybe CueText)
-> (Context -> CueTrack) -> Context -> Maybe CueText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CueTrack] -> CueTrack
forall a. [a] -> a
head ([CueTrack] -> CueTrack)
-> (Context -> [CueTrack]) -> Context -> CueTrack
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> [CueTrack]
contextTracks)
let f :: ByteString -> Either CueParserFailure CueText
f ByteString
x' =
let x :: Text
x = ByteString -> Text
T.decodeUtf8 ByteString
x'
in case Text -> Maybe CueText
forall (m :: * -> *). MonadThrow m => Text -> m CueText
mkCueText Text
x of
Maybe CueText
Nothing -> CueParserFailure -> Either CueParserFailure CueText
forall a b. a -> Either a b
Left (Text -> CueParserFailure
CueParserInvalidCueText Text
x)
Just CueText
txt -> CueText -> Either CueParserFailure CueText
forall a b. b -> Either a b
Right CueText
txt
CueText
title <- Bool
-> (ByteString -> Either CueParserFailure CueText)
-> ByteString
-> Parser CueText
forall a.
Bool
-> (ByteString -> Either CueParserFailure a)
-> ByteString
-> Parser a
labelledLit Bool
already ByteString -> Either CueParserFailure CueText
f ByteString
"TITLE"
(Context -> Context) -> StateT Context (Parsec Eec ByteString) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Context -> Context) -> StateT Context (Parsec Eec ByteString) ())
-> (Context -> Context)
-> StateT Context (Parsec Eec ByteString) ()
forall a b. (a -> b) -> a -> b
$ \Context
x ->
Context
x
{ contextTracks :: [CueTrack]
contextTracks = [CueTrack] -> (CueTrack -> CueTrack) -> [CueTrack]
forall a. [a] -> (a -> a) -> [a]
changingFirstOf (Context -> [CueTrack]
contextTracks Context
x) ((CueTrack -> CueTrack) -> [CueTrack])
-> (CueTrack -> CueTrack) -> [CueTrack]
forall a b. (a -> b) -> a -> b
$ \CueTrack
t ->
CueTrack
t {cueTrackTitle :: Maybe CueText
cueTrackTitle = CueText -> Maybe CueText
forall a. a -> Maybe a
Just CueText
title}
}
pTrackSongwriter :: Parser ()
pTrackSongwriter :: StateT Context (Parsec Eec ByteString) ()
pTrackSongwriter = do
Bool
already <- (Context -> Bool) -> StateT Context (Parsec Eec ByteString) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Maybe CueText -> Bool
forall a. Maybe a -> Bool
isJust (Maybe CueText -> Bool)
-> (Context -> Maybe CueText) -> Context -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CueTrack -> Maybe CueText
cueTrackSongwriter (CueTrack -> Maybe CueText)
-> (Context -> CueTrack) -> Context -> Maybe CueText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CueTrack] -> CueTrack
forall a. [a] -> a
head ([CueTrack] -> CueTrack)
-> (Context -> [CueTrack]) -> Context -> CueTrack
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> [CueTrack]
contextTracks)
let f :: ByteString -> Either CueParserFailure CueText
f ByteString
x' =
let x :: Text
x = ByteString -> Text
T.decodeUtf8 ByteString
x'
in case Text -> Maybe CueText
forall (m :: * -> *). MonadThrow m => Text -> m CueText
mkCueText Text
x of
Maybe CueText
Nothing -> CueParserFailure -> Either CueParserFailure CueText
forall a b. a -> Either a b
Left (Text -> CueParserFailure
CueParserInvalidCueText Text
x)
Just CueText
txt -> CueText -> Either CueParserFailure CueText
forall a b. b -> Either a b
Right CueText
txt
CueText
songwriter <- Bool
-> (ByteString -> Either CueParserFailure CueText)
-> ByteString
-> Parser CueText
forall a.
Bool
-> (ByteString -> Either CueParserFailure a)
-> ByteString
-> Parser a
labelledLit Bool
already ByteString -> Either CueParserFailure CueText
f ByteString
"SONGWRITER"
(Context -> Context) -> StateT Context (Parsec Eec ByteString) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Context -> Context) -> StateT Context (Parsec Eec ByteString) ())
-> (Context -> Context)
-> StateT Context (Parsec Eec ByteString) ()
forall a b. (a -> b) -> a -> b
$ \Context
x ->
Context
x
{ contextTracks :: [CueTrack]
contextTracks = [CueTrack] -> (CueTrack -> CueTrack) -> [CueTrack]
forall a. [a] -> (a -> a) -> [a]
changingFirstOf (Context -> [CueTrack]
contextTracks Context
x) ((CueTrack -> CueTrack) -> [CueTrack])
-> (CueTrack -> CueTrack) -> [CueTrack]
forall a b. (a -> b) -> a -> b
$ \CueTrack
t ->
CueTrack
t {cueTrackSongwriter :: Maybe CueText
cueTrackSongwriter = CueText -> Maybe CueText
forall a. a -> Maybe a
Just CueText
songwriter}
}
pPregap :: Parser ()
pPregap :: StateT Context (Parsec Eec ByteString) ()
pPregap = do
Bool
already <- (Context -> Bool) -> StateT Context (Parsec Eec ByteString) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Maybe CueTime -> Bool
forall a. Maybe a -> Bool
isJust (Maybe CueTime -> Bool)
-> (Context -> Maybe CueTime) -> Context -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CueTrack -> Maybe CueTime
cueTrackPregap (CueTrack -> Maybe CueTime)
-> (Context -> CueTrack) -> Context -> Maybe CueTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CueTrack] -> CueTrack
forall a. [a] -> a
head ([CueTrack] -> CueTrack)
-> (Context -> [CueTrack]) -> Context -> CueTrack
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> [CueTrack]
contextTracks)
Bool -> ByteString -> StateT Context (Parsec Eec ByteString) ()
failAtIf Bool
already ByteString
"PREGAP"
CueTime
time <- StateT Context (Parsec Eec ByteString) CueTime
-> StateT Context (Parsec Eec ByteString) CueTime
forall a. Parser a -> Parser a
lexeme StateT Context (Parsec Eec ByteString) CueTime
cueTime StateT Context (Parsec Eec ByteString) CueTime
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) CueTime
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Context (Parsec Eec ByteString) ByteString
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Tokens s)
eol StateT Context (Parsec Eec ByteString) CueTime
-> StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) CueTime
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Context (Parsec Eec ByteString) ()
scn
(Context -> Context) -> StateT Context (Parsec Eec ByteString) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Context -> Context) -> StateT Context (Parsec Eec ByteString) ())
-> (Context -> Context)
-> StateT Context (Parsec Eec ByteString) ()
forall a b. (a -> b) -> a -> b
$ \Context
x ->
Context
x
{ contextTracks :: [CueTrack]
contextTracks = [CueTrack] -> (CueTrack -> CueTrack) -> [CueTrack]
forall a. [a] -> (a -> a) -> [a]
changingFirstOf (Context -> [CueTrack]
contextTracks Context
x) ((CueTrack -> CueTrack) -> [CueTrack])
-> (CueTrack -> CueTrack) -> [CueTrack]
forall a b. (a -> b) -> a -> b
$ \CueTrack
t ->
CueTrack
t {cueTrackPregap :: Maybe CueTime
cueTrackPregap = CueTime -> Maybe CueTime
forall a. a -> Maybe a
Just CueTime
time}
}
pPostgap :: Parser ()
pPostgap :: StateT Context (Parsec Eec ByteString) ()
pPostgap = do
Bool
already <- (Context -> Bool) -> StateT Context (Parsec Eec ByteString) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Maybe CueTime -> Bool
forall a. Maybe a -> Bool
isJust (Maybe CueTime -> Bool)
-> (Context -> Maybe CueTime) -> Context -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CueTrack -> Maybe CueTime
cueTrackPostgap (CueTrack -> Maybe CueTime)
-> (Context -> CueTrack) -> Context -> Maybe CueTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CueTrack] -> CueTrack
forall a. [a] -> a
head ([CueTrack] -> CueTrack)
-> (Context -> [CueTrack]) -> Context -> CueTrack
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> [CueTrack]
contextTracks)
Bool -> ByteString -> StateT Context (Parsec Eec ByteString) ()
failAtIf Bool
already ByteString
"POSTGAP"
CueTime
time <- StateT Context (Parsec Eec ByteString) CueTime
-> StateT Context (Parsec Eec ByteString) CueTime
forall a. Parser a -> Parser a
lexeme StateT Context (Parsec Eec ByteString) CueTime
cueTime StateT Context (Parsec Eec ByteString) CueTime
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) CueTime
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Context (Parsec Eec ByteString) ByteString
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Tokens s)
eol StateT Context (Parsec Eec ByteString) CueTime
-> StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) CueTime
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Context (Parsec Eec ByteString) ()
scn
(Context -> Context) -> StateT Context (Parsec Eec ByteString) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Context -> Context) -> StateT Context (Parsec Eec ByteString) ())
-> (Context -> Context)
-> StateT Context (Parsec Eec ByteString) ()
forall a b. (a -> b) -> a -> b
$ \Context
x ->
Context
x
{ contextTracks :: [CueTrack]
contextTracks = [CueTrack] -> (CueTrack -> CueTrack) -> [CueTrack]
forall a. [a] -> (a -> a) -> [a]
changingFirstOf (Context -> [CueTrack]
contextTracks Context
x) ((CueTrack -> CueTrack) -> [CueTrack])
-> (CueTrack -> CueTrack) -> [CueTrack]
forall a b. (a -> b) -> a -> b
$ \CueTrack
t ->
CueTrack
t {cueTrackPostgap :: Maybe CueTime
cueTrackPostgap = CueTime -> Maybe CueTime
forall a. a -> Maybe a
Just CueTime
time}
}
pIndex :: Natural -> Parser CueTime
pIndex :: Natural -> StateT Context (Parsec Eec ByteString) CueTime
pIndex Natural
n = do
StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ByteString -> StateT Context (Parsec Eec ByteString) ByteString
symbol ByteString
"INDEX")
let f :: Natural -> Either CueParserFailure ()
f Natural
x =
if Natural
x Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
n
then () -> Either CueParserFailure ()
forall a b. b -> Either a b
Right ()
else CueParserFailure -> Either CueParserFailure ()
forall a b. a -> Either a b
Left CueParserFailure
CueParserTrackIndexOutOfOrder
(Natural -> Either CueParserFailure ())
-> StateT Context (Parsec Eec ByteString) Natural
-> StateT Context (Parsec Eec ByteString) ()
forall a b.
(a -> Either CueParserFailure b) -> Parser a -> Parser b
withCheck Natural -> Either CueParserFailure ()
f (StateT Context (Parsec Eec ByteString) Natural
-> StateT Context (Parsec Eec ByteString) Natural
forall a. Parser a -> Parser a
lexeme StateT Context (Parsec Eec ByteString) Natural
naturalLit)
StateT Context (Parsec Eec ByteString) CueTime
-> StateT Context (Parsec Eec ByteString) CueTime
forall a. Parser a -> Parser a
lexeme StateT Context (Parsec Eec ByteString) CueTime
cueTime StateT Context (Parsec Eec ByteString) CueTime
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) CueTime
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Context (Parsec Eec ByteString) ByteString
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Tokens s)
eol StateT Context (Parsec Eec ByteString) CueTime
-> StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) CueTime
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Context (Parsec Eec ByteString) ()
scn
cueTime :: Parser CueTime
cueTime :: StateT Context (Parsec Eec ByteString) CueTime
cueTime = do
Natural
minutes <- StateT Context (Parsec Eec ByteString) Natural
naturalLit
StateT Context (Parsec Eec ByteString) Word8
-> StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token ByteString
-> StateT Context (Parsec Eec ByteString) (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58)
let checkSeconds :: Natural -> Either CueParserFailure Natural
checkSeconds Natural
n =
if Natural
n Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
60
then Natural -> Either CueParserFailure Natural
forall a b. b -> Either a b
Right Natural
n
else CueParserFailure -> Either CueParserFailure Natural
forall a b. a -> Either a b
Left (Natural -> CueParserFailure
CueParserInvalidSeconds Natural
n)
checkFrames :: Natural -> Either CueParserFailure Natural
checkFrames Natural
n =
if Natural
n Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
75
then Natural -> Either CueParserFailure Natural
forall a b. b -> Either a b
Right Natural
n
else CueParserFailure -> Either CueParserFailure Natural
forall a b. a -> Either a b
Left (Natural -> CueParserFailure
CueParserInvalidFrames Natural
n)
Natural
seconds <- (Natural -> Either CueParserFailure Natural)
-> StateT Context (Parsec Eec ByteString) Natural
-> StateT Context (Parsec Eec ByteString) Natural
forall a b.
(a -> Either CueParserFailure b) -> Parser a -> Parser b
withCheck Natural -> Either CueParserFailure Natural
checkSeconds StateT Context (Parsec Eec ByteString) Natural
naturalLit
StateT Context (Parsec Eec ByteString) Word8
-> StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token ByteString
-> StateT Context (Parsec Eec ByteString) (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58)
Natural
frames <- (Natural -> Either CueParserFailure Natural)
-> StateT Context (Parsec Eec ByteString) Natural
-> StateT Context (Parsec Eec ByteString) Natural
forall a b.
(a -> Either CueParserFailure b) -> Parser a -> Parser b
withCheck Natural -> Either CueParserFailure Natural
checkFrames StateT Context (Parsec Eec ByteString) Natural
naturalLit
case Natural -> Natural -> Natural -> Maybe CueTime
forall (m :: * -> *).
MonadThrow m =>
Natural -> Natural -> Natural -> m CueTime
fromMmSsFf Natural
minutes Natural
seconds Natural
frames of
Maybe CueTime
Nothing -> StateT Context (Parsec Eec ByteString) CueTime
forall (f :: * -> *) a. Alternative f => f a
empty
Just CueTime
x -> CueTime -> StateT Context (Parsec Eec ByteString) CueTime
forall (m :: * -> *) a. Monad m => a -> m a
return CueTime
x
withCheck :: (a -> Either CueParserFailure b) -> Parser a -> Parser b
withCheck :: (a -> Either CueParserFailure b) -> Parser a -> Parser b
withCheck a -> Either CueParserFailure b
check Parser a
p = do
Int
o <- StateT Context (Parsec Eec ByteString) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
a
r <- Parser a
p
case a -> Either CueParserFailure b
check a
r of
Left CueParserFailure
custom -> do
Int -> StateT Context (Parsec Eec ByteString) ()
forall e s (m :: * -> *). MonadParsec e s m => Int -> m ()
setOffset Int
o
(Set (ErrorFancy Eec) -> Parser b
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Set (ErrorFancy e) -> m a
fancyFailure (Set (ErrorFancy Eec) -> Parser b)
-> (Eec -> Set (ErrorFancy Eec)) -> Eec -> Parser b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorFancy Eec -> Set (ErrorFancy Eec)
forall a. a -> Set a
E.singleton (ErrorFancy Eec -> Set (ErrorFancy Eec))
-> (Eec -> ErrorFancy Eec) -> Eec -> Set (ErrorFancy Eec)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eec -> ErrorFancy Eec
forall e. e -> ErrorFancy e
ErrorCustom) (Maybe Natural -> CueParserFailure -> Eec
Eec Maybe Natural
forall a. Maybe a
Nothing CueParserFailure
custom)
Right b
x -> b -> Parser b
forall (m :: * -> *) a. Monad m => a -> m a
return b
x
failAtIf :: Bool -> ByteString -> Parser ()
failAtIf :: Bool -> ByteString -> StateT Context (Parsec Eec ByteString) ()
failAtIf Bool
shouldFail ByteString
command = do
let p :: StateT Context (Parsec Eec ByteString) ()
p = StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ByteString -> StateT Context (Parsec Eec ByteString) ByteString
symbol ByteString
command)
StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead StateT Context (Parsec Eec ByteString) ()
p
if Bool
shouldFail
then StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) a. Alternative f => f a
empty
else StateT Context (Parsec Eec ByteString) ()
p
inTrack :: Natural -> Parser a -> Parser a
inTrack :: Natural -> Parser a -> Parser a
inTrack Natural
n = (ParseError ByteString Eec -> ParseError ByteString Eec)
-> Parser a -> Parser a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
(ParseError s e -> ParseError s e) -> m a -> m a
region ParseError ByteString Eec -> ParseError ByteString Eec
f
where
f :: ParseError ByteString Eec -> ParseError ByteString Eec
f (TrivialError Int
pos Maybe (ErrorItem (Token ByteString))
us Set (ErrorItem (Token ByteString))
es) =
Int -> Set (ErrorFancy Eec) -> ParseError ByteString Eec
forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError Int
pos (Set (ErrorFancy Eec) -> ParseError ByteString Eec)
-> (ErrorFancy Eec -> Set (ErrorFancy Eec))
-> ErrorFancy Eec
-> ParseError ByteString Eec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorFancy Eec -> Set (ErrorFancy Eec)
forall a. a -> Set a
E.singleton (ErrorFancy Eec -> ParseError ByteString Eec)
-> ErrorFancy Eec -> ParseError ByteString Eec
forall a b. (a -> b) -> a -> b
$
Eec -> ErrorFancy Eec
forall e. e -> ErrorFancy e
ErrorCustom (Maybe Natural -> CueParserFailure -> Eec
Eec (Natural -> Maybe Natural
forall a. a -> Maybe a
Just Natural
n) (Maybe (ErrorItem Word8)
-> Set (ErrorItem Word8) -> CueParserFailure
CueParserTrivialError Maybe (ErrorItem Word8)
Maybe (ErrorItem (Token ByteString))
us Set (ErrorItem Word8)
Set (ErrorItem (Token ByteString))
es))
f (FancyError Int
pos Set (ErrorFancy Eec)
xs) = Int -> Set (ErrorFancy Eec) -> ParseError ByteString Eec
forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError Int
pos ((ErrorFancy Eec -> ErrorFancy Eec)
-> Set (ErrorFancy Eec) -> Set (ErrorFancy Eec)
forall b a. Ord b => (a -> b) -> Set a -> Set b
E.map ErrorFancy Eec -> ErrorFancy Eec
g Set (ErrorFancy Eec)
xs)
g :: ErrorFancy Eec -> ErrorFancy Eec
g (ErrorCustom (Eec Maybe Natural
mn CueParserFailure
x)) = Eec -> ErrorFancy Eec
forall e. e -> ErrorFancy e
ErrorCustom (Maybe Natural -> CueParserFailure -> Eec
Eec (Maybe Natural
mn Maybe Natural -> Maybe Natural -> Maybe Natural
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Natural -> Maybe Natural
forall a. a -> Maybe a
Just Natural
n) CueParserFailure
x)
g ErrorFancy Eec
e = ErrorFancy Eec
e
labelledLit ::
Bool ->
(ByteString -> Either CueParserFailure a) ->
ByteString ->
Parser a
labelledLit :: Bool
-> (ByteString -> Either CueParserFailure a)
-> ByteString
-> Parser a
labelledLit Bool
shouldFail ByteString -> Either CueParserFailure a
check ByteString
command = do
Bool -> ByteString -> StateT Context (Parsec Eec ByteString) ()
failAtIf Bool
shouldFail ByteString
command
(ByteString -> Either CueParserFailure a)
-> StateT Context (Parsec Eec ByteString) ByteString -> Parser a
forall a b.
(a -> Either CueParserFailure b) -> Parser a -> Parser b
withCheck ByteString -> Either CueParserFailure a
check (StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) ByteString
forall a. Parser a -> Parser a
lexeme StateT Context (Parsec Eec ByteString) ByteString
stringLit) Parser a
-> StateT Context (Parsec Eec ByteString) ByteString -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Context (Parsec Eec ByteString) ByteString
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Tokens s)
eol Parser a -> StateT Context (Parsec Eec ByteString) () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Context (Parsec Eec ByteString) ()
scn
stringLit :: Parser ByteString
stringLit :: StateT Context (Parsec Eec ByteString) ByteString
stringLit =
(StateT Context (Parsec Eec ByteString) ByteString
StateT Context (Parsec Eec ByteString) (Tokens ByteString)
quoted StateT Context (Parsec Eec ByteString) ByteString
-> String -> StateT Context (Parsec Eec ByteString) ByteString
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"quoted string literal")
StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (StateT Context (Parsec Eec ByteString) ByteString
StateT Context (Parsec Eec ByteString) (Tokens ByteString)
unquoted StateT Context (Parsec Eec ByteString) ByteString
-> String -> StateT Context (Parsec Eec ByteString) ByteString
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"unquoted string literal")
where
quoted :: StateT Context (Parsec Eec ByteString) (Tokens ByteString)
quoted = Token ByteString
-> StateT Context (Parsec Eec ByteString) (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
34 StateT Context (Parsec Eec ByteString) Word8
-> StateT Context (Parsec Eec ByteString) (Tokens ByteString)
-> StateT Context (Parsec Eec ByteString) (Tokens ByteString)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe String
-> (Token ByteString -> Bool)
-> StateT Context (Parsec Eec ByteString) (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing Token ByteString -> Bool
forall a. (Eq a, Num a) => a -> Bool
f StateT Context (Parsec Eec ByteString) (Tokens ByteString)
-> StateT Context (Parsec Eec ByteString) Word8
-> StateT Context (Parsec Eec ByteString) (Tokens ByteString)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token ByteString
-> StateT Context (Parsec Eec ByteString) (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
34
unquoted :: StateT Context (Parsec Eec ByteString) (Tokens ByteString)
unquoted = Maybe String
-> (Token ByteString -> Bool)
-> StateT Context (Parsec Eec ByteString) (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing Token ByteString -> Bool
forall a. (Eq a, Num a) => a -> Bool
g
f :: a -> Bool
f a
x = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
10 Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
34
g :: a -> Bool
g a
x = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
10 Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
9 Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
13 Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
32
naturalLit :: Parser Natural
naturalLit :: StateT Context (Parsec Eec ByteString) Natural
naturalLit = StateT Context (Parsec Eec ByteString) Natural
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
L.decimal
symbol :: ByteString -> Parser ByteString
symbol :: ByteString -> StateT Context (Parsec Eec ByteString) ByteString
symbol ByteString
s = Tokens ByteString
-> StateT Context (Parsec Eec ByteString) (Tokens ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' ByteString
Tokens ByteString
s StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Context (Parsec Eec ByteString) Word8
-> StateT Context (Parsec Eec ByteString) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy StateT Context (Parsec Eec ByteString) Word8
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
alphaNumChar StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Context (Parsec Eec ByteString) ()
sc
lexeme :: Parser a -> Parser a
lexeme :: Parser a -> Parser a
lexeme = StateT Context (Parsec Eec ByteString) () -> Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme StateT Context (Parsec Eec ByteString) ()
sc
scn :: Parser ()
scn :: StateT Context (Parsec Eec ByteString) ()
scn = StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space StateT Context (Parsec Eec ByteString) ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
space1 StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) a. Alternative f => f a
empty StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) a. Alternative f => f a
empty
sc :: Parser ()
sc :: StateT Context (Parsec Eec ByteString) ()
sc = StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) ()
-> StateT Context (Parsec Eec ByteString) ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space (StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) ())
-> StateT Context (Parsec Eec ByteString) ByteString
-> StateT Context (Parsec Eec ByteString) ()
forall a b. (a -> b) -> a -> b
$ Maybe String
-> (Token ByteString -> Bool)
-> StateT Context (Parsec Eec ByteString) (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing Token ByteString -> Bool
forall a. (Eq a, Num a) => a -> Bool
f) StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) a. Alternative f => f a
empty StateT Context (Parsec Eec ByteString) ()
forall (f :: * -> *) a. Alternative f => f a
empty
where
f :: a -> Bool
f a
x = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
32 Bool -> Bool -> Bool
|| a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
9
seenFlags :: CueTrack -> Bool
seenFlags :: CueTrack -> Bool
seenFlags CueTrack {Bool
Maybe Isrc
Maybe CueText
Maybe CueTime
NonEmpty CueTime
CueTrackType
cueTrackPostgap :: Maybe CueTime
cueTrackIndices :: NonEmpty CueTime
cueTrackPregapIndex :: Maybe CueTime
cueTrackPregap :: Maybe CueTime
cueTrackSongwriter :: Maybe CueText
cueTrackPerformer :: Maybe CueText
cueTrackTitle :: Maybe CueText
cueTrackIsrc :: Maybe Isrc
cueTrackType :: CueTrackType
cueTrackSerialCopyManagement :: Bool
cueTrackPreemphasisEnabled :: Bool
cueTrackFourChannelAudio :: Bool
cueTrackDigitalCopyPermitted :: Bool
cueTrackPostgap :: CueTrack -> Maybe CueTime
cueTrackPregap :: CueTrack -> Maybe CueTime
cueTrackSongwriter :: CueTrack -> Maybe CueText
cueTrackTitle :: CueTrack -> Maybe CueText
cueTrackPerformer :: CueTrack -> Maybe CueText
cueTrackIsrc :: CueTrack -> Maybe Isrc
cueTrackSerialCopyManagement :: CueTrack -> Bool
cueTrackPreemphasisEnabled :: CueTrack -> Bool
cueTrackFourChannelAudio :: CueTrack -> Bool
cueTrackDigitalCopyPermitted :: CueTrack -> Bool
cueTrackIndices :: CueTrack -> NonEmpty CueTime
cueTrackPregapIndex :: CueTrack -> Maybe CueTime
cueTrackType :: CueTrack -> CueTrackType
..} =
[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
[ Bool
cueTrackDigitalCopyPermitted,
Bool
cueTrackFourChannelAudio,
Bool
cueTrackPreemphasisEnabled,
Bool
cueTrackSerialCopyManagement
]
changingFirstOf :: [a] -> (a -> a) -> [a]
changingFirstOf :: [a] -> (a -> a) -> [a]
changingFirstOf [] a -> a
_ = []
changingFirstOf (a
x : [a]
xs) a -> a
f = a -> a
f a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
dummyFile :: CueFile
dummyFile :: CueFile
dummyFile =
CueFile :: String -> CueFileType -> NonEmpty CueTrack -> CueFile
CueFile
{ cueFileName :: String
cueFileName = String
"",
cueFileType :: CueFileType
cueFileType = CueFileType
Wave,
cueFileTracks :: NonEmpty CueTrack
cueFileTracks = CueTrack
dummyTrack CueTrack -> [CueTrack] -> NonEmpty CueTrack
forall a. a -> [a] -> NonEmpty a
:| []
}
dummyTrack :: CueTrack
dummyTrack :: CueTrack
dummyTrack =
CueTrack :: Bool
-> Bool
-> Bool
-> Bool
-> CueTrackType
-> Maybe Isrc
-> Maybe CueText
-> Maybe CueText
-> Maybe CueText
-> Maybe CueTime
-> Maybe CueTime
-> NonEmpty CueTime
-> Maybe CueTime
-> CueTrack
CueTrack
{ cueTrackDigitalCopyPermitted :: Bool
cueTrackDigitalCopyPermitted = Bool
False,
cueTrackFourChannelAudio :: Bool
cueTrackFourChannelAudio = Bool
False,
cueTrackPreemphasisEnabled :: Bool
cueTrackPreemphasisEnabled = Bool
False,
cueTrackSerialCopyManagement :: Bool
cueTrackSerialCopyManagement = Bool
False,
cueTrackType :: CueTrackType
cueTrackType = CueTrackType
CueTrackAudio,
cueTrackIsrc :: Maybe Isrc
cueTrackIsrc = Maybe Isrc
forall a. Maybe a
Nothing,
cueTrackTitle :: Maybe CueText
cueTrackTitle = Maybe CueText
forall a. Maybe a
Nothing,
cueTrackPerformer :: Maybe CueText
cueTrackPerformer = Maybe CueText
forall a. Maybe a
Nothing,
cueTrackSongwriter :: Maybe CueText
cueTrackSongwriter = Maybe CueText
forall a. Maybe a
Nothing,
cueTrackPregap :: Maybe CueTime
cueTrackPregap = Maybe CueTime
forall a. Maybe a
Nothing,
cueTrackPregapIndex :: Maybe CueTime
cueTrackPregapIndex = Maybe CueTime
forall a. Maybe a
Nothing,
cueTrackIndices :: NonEmpty CueTime
cueTrackIndices = Natural -> CueTime
CueTime Natural
0 CueTime -> [CueTime] -> NonEmpty CueTime
forall a. a -> [a] -> NonEmpty a
:| [],
cueTrackPostgap :: Maybe CueTime
cueTrackPostgap = Maybe CueTime
forall a. Maybe a
Nothing
}