module Codec.EBML.Pretty where

import Data.ByteString qualified as BS
import Data.Text (Text)
import Data.Text qualified as Text
import Numeric.Natural

import Codec.EBML.Element
import Codec.EBML.Schema

-- | Pretty-print a 'EBMLDocument'.
prettyEBMLDocument :: [EBMLSchema] -> EBMLDocument -> Text
prettyEBMLDocument :: [EBMLSchema] -> EBMLDocument -> Text
prettyEBMLDocument [EBMLSchema]
schemas (EBMLDocument [EBMLElement]
xs) = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (EBMLSchemas -> Natural -> EBMLElement -> Text
prettyElement ([EBMLSchema] -> EBMLSchemas
compileSchemas [EBMLSchema]
schemas) Natural
0) [EBMLElement]
xs

prettyElement :: EBMLSchemas -> Natural -> EBMLElement -> Text
prettyElement :: EBMLSchemas -> Natural -> EBMLElement -> Text
prettyElement EBMLSchemas
schemas Natural
indent EBMLElement
elt = Text
indentTxt forall a. Semigroup a => a -> a -> a
<> Text
eltIDTxt forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> Text
eltValueTxt
  where
    indentTxt :: Text
indentTxt = Int -> Text -> Text
Text.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
indent) Text
" "
    eltIDTxt :: Text
eltIDTxt = case EBMLID -> EBMLSchemas -> Maybe EBMLSchema
lookupSchema EBMLElement
elt.header.eid EBMLSchemas
schemas of
        Just EBMLSchema
schema -> EBMLSchema
schema.name
        Maybe EBMLSchema
Nothing -> String -> Text
Text.pack (forall a. Show a => a -> String
show EBMLElement
elt.header.eid)
    eltValueTxt :: Text
eltValueTxt = case EBMLElement
elt.value of
        EBMLRoot [EBMLElement]
xs -> Text
"\n" forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (EBMLSchemas -> Natural -> EBMLElement -> Text
prettyElement EBMLSchemas
schemas (Natural
indent forall a. Num a => a -> a -> a
+ Natural
2)) [EBMLElement]
xs)
        EBMLText Text
txt -> Text
txt forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        EBMLBinary ByteString
bs -> Text
"[raw:" forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
bs) forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
bsTxt ByteString
bs forall a. Semigroup a => a -> a -> a
<> Text
"]\n"
        EBMLUnsignedInteger Word64
x -> String -> Text
Text.pack (forall a. Show a => a -> String
show Word64
x) forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        EBMLValue
_ -> Text
"value\n"
    bsTxt :: ByteString -> Text
bsTxt = String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
BS.take Int
32