{- | This module contains the logic to convert a raw EBMLDocument into a WebMDocument

See: https://www.matroska.org/technical/diagram.html
-}
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)

-- | A WebM document.
data WebMDocument = WebMDocument
    { WebMDocument -> Word64
timestampScale :: Word64
    -- ^ Base unit for Segment Ticks and Track Ticks, in nanoseconds. A TimestampScale of 1_000_000 means segments' timestamps are expressed in milliseconds;
    , WebMDocument -> [WebMCluster]
clusters :: [WebMCluster]
    -- ^ The list of clusters.
    }

-- | A WebM cluster, e.g. a media segment.
data WebMCluster = WebMCluster
    { WebMCluster -> Word64
timestamp :: Word64
    -- ^ Absolute timestamp of the cluster.
    , WebMCluster -> [EBMLElement]
content :: [EBMLElement]
    -- ^ The cluster elements.
    }

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

-- | Extract the document type, version and the segment elements.
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"