module Codec.EBML.WebM where
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Word (Word64)
import Codec.EBML.Element
import Data.Foldable (find)
import Data.Maybe (catMaybes)
data WebMDocument = WebMDocument
{ WebMDocument -> Word64
timestampScale :: Word64
, WebMDocument -> [WebMCluster]
clusters :: [WebMCluster]
}
data WebMCluster = WebMCluster
{ WebMCluster -> Word64
timestamp :: Word64
, WebMCluster -> [EBMLElement]
content :: [EBMLElement]
}
decodeWebMDocument :: EBMLDocument -> Either Text WebMDocument
decodeWebMDocument :: EBMLDocument -> Either Text WebMDocument
decodeWebMDocument = \case
(EBMLDocument [EBMLElement
header, EBMLElement
segment]) -> do
[EBMLElement]
headerElements <- EBMLElement -> Either Text [EBMLElement]
getChilds EBMLElement
header
[EBMLElement]
segmentElements <- EBMLElement -> Either Text [EBMLElement]
getChilds EBMLElement
segment
Text
docType <- EBMLElement -> Either Text Text
getText forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [EBMLElement] -> EBMLID -> Either Text EBMLElement
getElt [EBMLElement]
headerElements EBMLID
0x4282
Word64
docVersion <- EBMLElement -> Either Text Word64
getUInt forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [EBMLElement] -> EBMLID -> Either Text EBMLElement
getElt [EBMLElement]
headerElements EBMLID
0x4287
if Text
docType forall a. Eq a => a -> a -> Bool
/= Text
"webm" Bool -> Bool -> Bool
|| Word64
docVersion forall a. Eq a => a -> a -> Bool
/= Word64
2
then forall a b. a -> Either a b
Left (Text
"Invalid doctype: " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show (Text
docType, Word64
docVersion)))
else [EBMLElement] -> Either Text WebMDocument
decodeSegment [EBMLElement]
segmentElements
EBMLDocument
_ -> forall a b. a -> Either a b
Left Text
"Invalid EBML file structure"
decodeSegment :: [EBMLElement] -> Either Text WebMDocument
decodeSegment :: [EBMLElement] -> Either Text WebMDocument
decodeSegment = Word64 -> [EBMLElement] -> Either Text WebMDocument
go Word64
0
where
go :: Word64 -> [EBMLElement] -> Either Text WebMDocument
go Word64
scale xs :: [EBMLElement]
xs@(EBMLElement
x : [EBMLElement]
rest)
| EBMLElement
x.header.eid forall a. Eq a => a -> a -> Bool
== EBMLID
0x1F43B675 = Word64 -> [WebMCluster] -> WebMDocument
WebMDocument Word64
scale forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse EBMLElement -> Either Text (Maybe WebMCluster)
decodeWebMCluster [EBMLElement]
xs
| EBMLElement
x.header.eid forall a. Eq a => a -> a -> Bool
== EBMLID
0x1549A966 = do
[EBMLElement]
info <- EBMLElement -> Either Text [EBMLElement]
getChilds EBMLElement
x
Word64
scaleValue <- EBMLElement -> Either Text Word64
getUInt forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [EBMLElement] -> EBMLID -> Either Text EBMLElement
getElt [EBMLElement]
info EBMLID
0x2AD7B1
Word64 -> [EBMLElement] -> Either Text WebMDocument
go Word64
scaleValue [EBMLElement]
rest
| Bool
otherwise = Word64 -> [EBMLElement] -> Either Text WebMDocument
go Word64
scale [EBMLElement]
rest
go Word64
scale [] = forall a b. b -> Either a b
Right (Word64 -> [WebMCluster] -> WebMDocument
WebMDocument Word64
scale [])
decodeWebMCluster :: EBMLElement -> Either Text (Maybe WebMCluster)
decodeWebMCluster :: EBMLElement -> Either Text (Maybe WebMCluster)
decodeWebMCluster EBMLElement
elt
| EBMLElement
elt.header.eid forall a. Eq a => a -> a -> Bool
== EBMLID
0x1F43B675 =
forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
[EBMLElement]
childs <- EBMLElement -> Either Text [EBMLElement]
getChilds EBMLElement
elt
case [EBMLElement]
childs of
(EBMLElement
tsElt : [EBMLElement]
xs)
| EBMLElement
tsElt.header.eid forall a. Eq a => a -> a -> Bool
== EBMLID
0xE7 -> do
Word64
timestamp <- EBMLElement -> Either Text Word64
getUInt EBMLElement
tsElt
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Word64 -> [EBMLElement] -> WebMCluster
WebMCluster Word64
timestamp [EBMLElement]
xs
[EBMLElement]
_ -> forall a b. a -> Either a b
Left Text
"Cluster first element is not a timestamp"
| Bool
otherwise = forall a b. b -> Either a b
Right forall a. Maybe a
Nothing
documentSegment :: EBMLDocument -> Either Text (Text, Word64, [EBMLElement])
documentSegment :: EBMLDocument -> Either Text (Text, Word64, [EBMLElement])
documentSegment (EBMLDocument [EBMLElement
header, EBMLElement
segment]) = do
[EBMLElement]
headerElements <- EBMLElement -> Either Text [EBMLElement]
getChilds EBMLElement
header
[EBMLElement]
segmentElements <- EBMLElement -> Either Text [EBMLElement]
getChilds EBMLElement
segment
Text
docType <- EBMLElement -> Either Text Text
getText forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [EBMLElement] -> EBMLID -> Either Text EBMLElement
getElt [EBMLElement]
headerElements EBMLID
0x4282
Word64
docVersion <- EBMLElement -> Either Text Word64
getUInt forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [EBMLElement] -> EBMLID -> Either Text EBMLElement
getElt [EBMLElement]
headerElements EBMLID
0x4287
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
docType, Word64
docVersion, [EBMLElement]
segmentElements)
documentSegment EBMLDocument
_ = forall a b. a -> Either a b
Left Text
"Invalid EBML file structure"
getElt :: [EBMLElement] -> EBMLID -> Either Text EBMLElement
getElt :: [EBMLElement] -> EBMLID -> Either Text EBMLElement
getElt [EBMLElement]
xs EBMLID
eid = case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\EBMLElement
elt -> EBMLElement
elt.header.eid forall a. Eq a => a -> a -> Bool
== EBMLID
eid) [EBMLElement]
xs of
Just EBMLElement
elt -> forall a b. b -> Either a b
Right EBMLElement
elt
Maybe EBMLElement
Nothing -> forall a b. a -> Either a b
Left (Text
"Element " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show EBMLID
eid) forall a. Semigroup a => a -> a -> a
<> Text
" not found")
getText :: EBMLElement -> Either Text Text
getText :: EBMLElement -> Either Text Text
getText EBMLElement
elt = case EBMLElement
elt.value of
EBMLText Text
txt -> forall a b. b -> Either a b
Right Text
txt
EBMLValue
_ -> forall a b. a -> Either a b
Left Text
"Invalid text value"
getUInt :: EBMLElement -> Either Text Word64
getUInt :: EBMLElement -> Either Text Word64
getUInt EBMLElement
elt = case EBMLElement
elt.value of
EBMLUnsignedInteger Word64
x -> forall a b. b -> Either a b
Right Word64
x
EBMLValue
_ -> forall a b. a -> Either a b
Left (Text
"Invalid uint value " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show EBMLElement
elt.value))
getChilds :: EBMLElement -> Either Text [EBMLElement]
getChilds :: EBMLElement -> Either Text [EBMLElement]
getChilds EBMLElement
elt = case EBMLElement
elt.value of
EBMLRoot [EBMLElement]
xs -> forall a b. b -> Either a b
Right [EBMLElement]
xs
EBMLValue
_ -> forall a b. a -> Either a b
Left Text
"Element is not a root"