{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Data.DTA.Base
( DTA(..), Tree(..), Chunk(..)
, renumberFrom
, binaryDTA, DTAVersion(..)
) where

#if __GLASGOW_HASKELL__ < 710
import           Control.Applicative       ((<$>))
#endif
import           Control.Applicative       (liftA2)
import           Control.Monad             (replicateM)
import qualified Data.ByteString           as B
import           Data.Data                 (Data)
import           Data.Int                  (Int32)
import           Data.Typeable             (Typeable)
import           Data.Word                 (Word32, Word8)

import qualified Control.Monad.Trans.State as S
import           Data.Binary               (Binary (..), Get, Put)
import           Data.Binary.Get           (getByteString, getWord16le,
                                            getWord32le, skip)
import           Data.Binary.IEEE754       (getFloat32le, putFloat32le)
import           Data.Binary.Put           (putByteString, putWord16le,
                                            putWord32le)

--
-- Type definitions
--

-- | A top-level file.
data DTA = DTA { DTA -> Word8
byteZero :: Word8, DTA -> Tree
topTree :: Tree }
  deriving (DTA -> DTA -> Bool
(DTA -> DTA -> Bool) -> (DTA -> DTA -> Bool) -> Eq DTA
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DTA -> DTA -> Bool
$c/= :: DTA -> DTA -> Bool
== :: DTA -> DTA -> Bool
$c== :: DTA -> DTA -> Bool
Eq, Eq DTA
Eq DTA
-> (DTA -> DTA -> Ordering)
-> (DTA -> DTA -> Bool)
-> (DTA -> DTA -> Bool)
-> (DTA -> DTA -> Bool)
-> (DTA -> DTA -> Bool)
-> (DTA -> DTA -> DTA)
-> (DTA -> DTA -> DTA)
-> Ord DTA
DTA -> DTA -> Bool
DTA -> DTA -> Ordering
DTA -> DTA -> DTA
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 :: DTA -> DTA -> DTA
$cmin :: DTA -> DTA -> DTA
max :: DTA -> DTA -> DTA
$cmax :: DTA -> DTA -> DTA
>= :: DTA -> DTA -> Bool
$c>= :: DTA -> DTA -> Bool
> :: DTA -> DTA -> Bool
$c> :: DTA -> DTA -> Bool
<= :: DTA -> DTA -> Bool
$c<= :: DTA -> DTA -> Bool
< :: DTA -> DTA -> Bool
$c< :: DTA -> DTA -> Bool
compare :: DTA -> DTA -> Ordering
$ccompare :: DTA -> DTA -> Ordering
$cp1Ord :: Eq DTA
Ord, Int -> DTA -> ShowS
[DTA] -> ShowS
DTA -> String
(Int -> DTA -> ShowS)
-> (DTA -> String) -> ([DTA] -> ShowS) -> Show DTA
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DTA] -> ShowS
$cshowList :: [DTA] -> ShowS
show :: DTA -> String
$cshow :: DTA -> String
showsPrec :: Int -> DTA -> ShowS
$cshowsPrec :: Int -> DTA -> ShowS
Show, ReadPrec [DTA]
ReadPrec DTA
Int -> ReadS DTA
ReadS [DTA]
(Int -> ReadS DTA)
-> ReadS [DTA] -> ReadPrec DTA -> ReadPrec [DTA] -> Read DTA
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DTA]
$creadListPrec :: ReadPrec [DTA]
readPrec :: ReadPrec DTA
$creadPrec :: ReadPrec DTA
readList :: ReadS [DTA]
$creadList :: ReadS [DTA]
readsPrec :: Int -> ReadS DTA
$creadsPrec :: Int -> ReadS DTA
Read, Typeable, Typeable DTA
DataType
Constr
Typeable DTA
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DTA -> c DTA)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DTA)
-> (DTA -> Constr)
-> (DTA -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DTA))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DTA))
-> ((forall b. Data b => b -> b) -> DTA -> DTA)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DTA -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DTA -> r)
-> (forall u. (forall d. Data d => d -> u) -> DTA -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> DTA -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DTA -> m DTA)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DTA -> m DTA)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DTA -> m DTA)
-> Data DTA
DTA -> DataType
DTA -> Constr
(forall b. Data b => b -> b) -> DTA -> DTA
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DTA -> c DTA
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DTA
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) -> DTA -> u
forall u. (forall d. Data d => d -> u) -> DTA -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DTA -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DTA -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DTA -> m DTA
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DTA -> m DTA
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DTA
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DTA -> c DTA
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DTA)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DTA)
$cDTA :: Constr
$tDTA :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> DTA -> m DTA
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DTA -> m DTA
gmapMp :: (forall d. Data d => d -> m d) -> DTA -> m DTA
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DTA -> m DTA
gmapM :: (forall d. Data d => d -> m d) -> DTA -> m DTA
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DTA -> m DTA
gmapQi :: Int -> (forall d. Data d => d -> u) -> DTA -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DTA -> u
gmapQ :: (forall d. Data d => d -> u) -> DTA -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DTA -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DTA -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DTA -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DTA -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DTA -> r
gmapT :: (forall b. Data b => b -> b) -> DTA -> DTA
$cgmapT :: (forall b. Data b => b -> b) -> DTA -> DTA
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DTA)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DTA)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DTA)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DTA)
dataTypeOf :: DTA -> DataType
$cdataTypeOf :: DTA -> DataType
toConstr :: DTA -> Constr
$ctoConstr :: DTA -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DTA
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DTA
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DTA -> c DTA
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DTA -> c DTA
$cp1Data :: Typeable DTA
Data)

-- | A list of chunks, for either the top-level tree or a subtree.
data Tree = Tree { Tree -> Word32
nodeID :: Word32, Tree -> [Chunk]
treeChunks :: [Chunk] }
  deriving (Tree -> Tree -> Bool
(Tree -> Tree -> Bool) -> (Tree -> Tree -> Bool) -> Eq Tree
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tree -> Tree -> Bool
$c/= :: Tree -> Tree -> Bool
== :: Tree -> Tree -> Bool
$c== :: Tree -> Tree -> Bool
Eq, Eq Tree
Eq Tree
-> (Tree -> Tree -> Ordering)
-> (Tree -> Tree -> Bool)
-> (Tree -> Tree -> Bool)
-> (Tree -> Tree -> Bool)
-> (Tree -> Tree -> Bool)
-> (Tree -> Tree -> Tree)
-> (Tree -> Tree -> Tree)
-> Ord Tree
Tree -> Tree -> Bool
Tree -> Tree -> Ordering
Tree -> Tree -> Tree
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 :: Tree -> Tree -> Tree
$cmin :: Tree -> Tree -> Tree
max :: Tree -> Tree -> Tree
$cmax :: Tree -> Tree -> Tree
>= :: Tree -> Tree -> Bool
$c>= :: Tree -> Tree -> Bool
> :: Tree -> Tree -> Bool
$c> :: Tree -> Tree -> Bool
<= :: Tree -> Tree -> Bool
$c<= :: Tree -> Tree -> Bool
< :: Tree -> Tree -> Bool
$c< :: Tree -> Tree -> Bool
compare :: Tree -> Tree -> Ordering
$ccompare :: Tree -> Tree -> Ordering
$cp1Ord :: Eq Tree
Ord, Int -> Tree -> ShowS
[Tree] -> ShowS
Tree -> String
(Int -> Tree -> ShowS)
-> (Tree -> String) -> ([Tree] -> ShowS) -> Show Tree
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tree] -> ShowS
$cshowList :: [Tree] -> ShowS
show :: Tree -> String
$cshow :: Tree -> String
showsPrec :: Int -> Tree -> ShowS
$cshowsPrec :: Int -> Tree -> ShowS
Show, ReadPrec [Tree]
ReadPrec Tree
Int -> ReadS Tree
ReadS [Tree]
(Int -> ReadS Tree)
-> ReadS [Tree] -> ReadPrec Tree -> ReadPrec [Tree] -> Read Tree
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Tree]
$creadListPrec :: ReadPrec [Tree]
readPrec :: ReadPrec Tree
$creadPrec :: ReadPrec Tree
readList :: ReadS [Tree]
$creadList :: ReadS [Tree]
readsPrec :: Int -> ReadS Tree
$creadsPrec :: Int -> ReadS Tree
Read, Typeable, Typeable Tree
DataType
Constr
Typeable Tree
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Tree -> c Tree)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Tree)
-> (Tree -> Constr)
-> (Tree -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Tree))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Tree))
-> ((forall b. Data b => b -> b) -> Tree -> Tree)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Tree -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Tree -> r)
-> (forall u. (forall d. Data d => d -> u) -> Tree -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Tree -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Tree -> m Tree)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Tree -> m Tree)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Tree -> m Tree)
-> Data Tree
Tree -> DataType
Tree -> Constr
(forall b. Data b => b -> b) -> Tree -> Tree
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Tree -> c Tree
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Tree
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) -> Tree -> u
forall u. (forall d. Data d => d -> u) -> Tree -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Tree -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Tree -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Tree -> m Tree
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Tree -> m Tree
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Tree
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Tree -> c Tree
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Tree)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Tree)
$cTree :: Constr
$tTree :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Tree -> m Tree
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Tree -> m Tree
gmapMp :: (forall d. Data d => d -> m d) -> Tree -> m Tree
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Tree -> m Tree
gmapM :: (forall d. Data d => d -> m d) -> Tree -> m Tree
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Tree -> m Tree
gmapQi :: Int -> (forall d. Data d => d -> u) -> Tree -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Tree -> u
gmapQ :: (forall d. Data d => d -> u) -> Tree -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Tree -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Tree -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Tree -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Tree -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Tree -> r
gmapT :: (forall b. Data b => b -> b) -> Tree -> Tree
$cgmapT :: (forall b. Data b => b -> b) -> Tree -> Tree
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Tree)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Tree)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Tree)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Tree)
dataTypeOf :: Tree -> DataType
$cdataTypeOf :: Tree -> DataType
toConstr :: Tree -> Constr
$ctoConstr :: Tree -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Tree
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Tree
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Tree -> c Tree
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Tree -> c Tree
$cp1Data :: Typeable Tree
Data)

-- | A data value, which may be a subtree. The constructors are ordered by their
-- chunk identification tag in the binary format.
data Chunk
  = Int Int32
  | Float Float
  | Var B.ByteString
  | Sym B.ByteString
  | Unhandled
  | IfDef B.ByteString
  | Else
  | EndIf
  | Parens Tree
  | Braces Tree
  | String B.ByteString
  | Brackets Tree
  | Define B.ByteString
  | Include B.ByteString
  | Merge B.ByteString
  | IfNDef B.ByteString
  | Autorun
  | Undef B.ByteString
  deriving (Chunk -> Chunk -> Bool
(Chunk -> Chunk -> Bool) -> (Chunk -> Chunk -> Bool) -> Eq Chunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Chunk -> Chunk -> Bool
$c/= :: Chunk -> Chunk -> Bool
== :: Chunk -> Chunk -> Bool
$c== :: Chunk -> Chunk -> Bool
Eq, Eq Chunk
Eq Chunk
-> (Chunk -> Chunk -> Ordering)
-> (Chunk -> Chunk -> Bool)
-> (Chunk -> Chunk -> Bool)
-> (Chunk -> Chunk -> Bool)
-> (Chunk -> Chunk -> Bool)
-> (Chunk -> Chunk -> Chunk)
-> (Chunk -> Chunk -> Chunk)
-> Ord Chunk
Chunk -> Chunk -> Bool
Chunk -> Chunk -> Ordering
Chunk -> Chunk -> Chunk
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 :: Chunk -> Chunk -> Chunk
$cmin :: Chunk -> Chunk -> Chunk
max :: Chunk -> Chunk -> Chunk
$cmax :: Chunk -> Chunk -> Chunk
>= :: Chunk -> Chunk -> Bool
$c>= :: Chunk -> Chunk -> Bool
> :: Chunk -> Chunk -> Bool
$c> :: Chunk -> Chunk -> Bool
<= :: Chunk -> Chunk -> Bool
$c<= :: Chunk -> Chunk -> Bool
< :: Chunk -> Chunk -> Bool
$c< :: Chunk -> Chunk -> Bool
compare :: Chunk -> Chunk -> Ordering
$ccompare :: Chunk -> Chunk -> Ordering
$cp1Ord :: Eq Chunk
Ord, Int -> Chunk -> ShowS
[Chunk] -> ShowS
Chunk -> String
(Int -> Chunk -> ShowS)
-> (Chunk -> String) -> ([Chunk] -> ShowS) -> Show Chunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Chunk] -> ShowS
$cshowList :: [Chunk] -> ShowS
show :: Chunk -> String
$cshow :: Chunk -> String
showsPrec :: Int -> Chunk -> ShowS
$cshowsPrec :: Int -> Chunk -> ShowS
Show, ReadPrec [Chunk]
ReadPrec Chunk
Int -> ReadS Chunk
ReadS [Chunk]
(Int -> ReadS Chunk)
-> ReadS [Chunk]
-> ReadPrec Chunk
-> ReadPrec [Chunk]
-> Read Chunk
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Chunk]
$creadListPrec :: ReadPrec [Chunk]
readPrec :: ReadPrec Chunk
$creadPrec :: ReadPrec Chunk
readList :: ReadS [Chunk]
$creadList :: ReadS [Chunk]
readsPrec :: Int -> ReadS Chunk
$creadsPrec :: Int -> ReadS Chunk
Read, Typeable, Typeable Chunk
DataType
Constr
Typeable Chunk
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Chunk -> c Chunk)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Chunk)
-> (Chunk -> Constr)
-> (Chunk -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Chunk))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Chunk))
-> ((forall b. Data b => b -> b) -> Chunk -> Chunk)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Chunk -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Chunk -> r)
-> (forall u. (forall d. Data d => d -> u) -> Chunk -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Chunk -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Chunk -> m Chunk)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Chunk -> m Chunk)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Chunk -> m Chunk)
-> Data Chunk
Chunk -> DataType
Chunk -> Constr
(forall b. Data b => b -> b) -> Chunk -> Chunk
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Chunk -> c Chunk
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Chunk
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) -> Chunk -> u
forall u. (forall d. Data d => d -> u) -> Chunk -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Chunk -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Chunk -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Chunk -> m Chunk
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Chunk -> m Chunk
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Chunk
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Chunk -> c Chunk
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Chunk)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Chunk)
$cUndef :: Constr
$cAutorun :: Constr
$cIfNDef :: Constr
$cMerge :: Constr
$cInclude :: Constr
$cDefine :: Constr
$cBrackets :: Constr
$cString :: Constr
$cBraces :: Constr
$cParens :: Constr
$cEndIf :: Constr
$cElse :: Constr
$cIfDef :: Constr
$cUnhandled :: Constr
$cSym :: Constr
$cVar :: Constr
$cFloat :: Constr
$cInt :: Constr
$tChunk :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Chunk -> m Chunk
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Chunk -> m Chunk
gmapMp :: (forall d. Data d => d -> m d) -> Chunk -> m Chunk
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Chunk -> m Chunk
gmapM :: (forall d. Data d => d -> m d) -> Chunk -> m Chunk
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Chunk -> m Chunk
gmapQi :: Int -> (forall d. Data d => d -> u) -> Chunk -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Chunk -> u
gmapQ :: (forall d. Data d => d -> u) -> Chunk -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Chunk -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Chunk -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Chunk -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Chunk -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Chunk -> r
gmapT :: (forall b. Data b => b -> b) -> Chunk -> Chunk
$cgmapT :: (forall b. Data b => b -> b) -> Chunk -> Chunk
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Chunk)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Chunk)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Chunk)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Chunk)
dataTypeOf :: Chunk -> DataType
$cdataTypeOf :: Chunk -> DataType
toConstr :: Chunk -> Constr
$ctoConstr :: Chunk -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Chunk
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Chunk
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Chunk -> c Chunk
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Chunk -> c Chunk
$cp1Data :: Typeable Chunk
Data)

--
-- Binary (DTB) instances
--

data DTAVersion
  = DTAVersion1 -- ^ everything before and including RB3 AFAIK
  | DTAVersion2 -- ^ seen in Fantasia: Music Evolved

binaryDTA :: DTAVersion -> Get DTA
binaryDTA :: DTAVersion -> Get DTA
binaryDTA DTAVersion
version = (Word8 -> Tree -> DTA) -> Get Word8 -> Get Tree -> Get DTA
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Word8 -> Tree -> DTA
DTA Get Word8
forall t. Binary t => Get t
get (DTAVersion -> Get Tree
binaryTree DTAVersion
version)

-- Single byte, then a tree.
instance Binary DTA where
  put :: DTA -> Put
put (DTA Word8
b Tree
t) = Word8 -> Put
forall t. Binary t => t -> Put
put Word8
b Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tree -> Put
forall t. Binary t => t -> Put
put Tree
t
  get :: Get DTA
get = DTAVersion -> Get DTA
binaryDTA DTAVersion
DTAVersion1

binaryTree :: DTAVersion -> Get Tree
binaryTree :: DTAVersion -> Get Tree
binaryTree DTAVersion
version = case DTAVersion
version of
  DTAVersion
DTAVersion1 -> do
    Word16
len <- Get Word16
getWord16le
    Word32
nid <- Get Word32
getWord32le
    [Chunk]
xs <- Int -> Get Chunk -> Get [Chunk]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
len) (DTAVersion -> Get Chunk
binaryChunk DTAVersion
version)
    Tree -> Get Tree
forall (m :: * -> *) a. Monad m => a -> m a
return (Tree -> Get Tree) -> Tree -> Get Tree
forall a b. (a -> b) -> a -> b
$ Word32 -> [Chunk] -> Tree
Tree Word32
nid [Chunk]
xs
  DTAVersion
DTAVersion2 -> do
    Word32
_unk <- Get Word32
getWord32le -- always zero?
    Word32
len <- Get Word32
getWord32le
    Word32
nid <- Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word32) -> Get Word16 -> Get Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
    [Chunk]
xs <- Int -> Get Chunk -> Get [Chunk]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len) (DTAVersion -> Get Chunk
binaryChunk DTAVersion
version)
    Tree -> Get Tree
forall (m :: * -> *) a. Monad m => a -> m a
return (Tree -> Get Tree) -> Tree -> Get Tree
forall a b. (a -> b) -> a -> b
$ Word32 -> [Chunk] -> Tree
Tree Word32
nid [Chunk]
xs

-- 2-byte length, 4-byte node ID, then each element in sequence.
instance Binary Tree where
  put :: Tree -> Put
put (Tree Word32
nid [Chunk]
chks) = do
    Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ [Chunk] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Chunk]
chks
    Word32 -> Put
putWord32le Word32
nid
    (Chunk -> Put) -> [Chunk] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Chunk -> Put
forall t. Binary t => t -> Put
put [Chunk]
chks
  get :: Get Tree
get = DTAVersion -> Get Tree
binaryTree DTAVersion
DTAVersion1

binaryChunk :: DTAVersion -> Get Chunk
binaryChunk :: DTAVersion -> Get Chunk
binaryChunk DTAVersion
version = Get Word32
getWord32le Get Word32 -> (Word32 -> Get Chunk) -> Get Chunk
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word32
cid -> case Word32
cid of
  Word32
0x0  -> Int32 -> Chunk
Int (Int32 -> Chunk) -> (Word32 -> Int32) -> Word32 -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Chunk) -> Get Word32 -> Get Chunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
  Word32
0x1  -> Float -> Chunk
Float (Float -> Chunk) -> Get Float -> Get Chunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Float
getFloat32le
  Word32
0x2  -> ByteString -> Chunk
Var (ByteString -> Chunk) -> Get ByteString -> Get Chunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getLenStr
  Word32
0x5  -> ByteString -> Chunk
Sym (ByteString -> Chunk) -> Get ByteString -> Get Chunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getLenStr
  Word32
0x6  -> Int -> Get ()
skip Int
4 Get () -> Get Chunk -> Get Chunk
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Chunk -> Get Chunk
forall (m :: * -> *) a. Monad m => a -> m a
return Chunk
Unhandled
  Word32
0x7  -> ByteString -> Chunk
IfDef (ByteString -> Chunk) -> Get ByteString -> Get Chunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getLenStr
  Word32
0x8  -> Int -> Get ()
skip Int
4 Get () -> Get Chunk -> Get Chunk
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Chunk -> Get Chunk
forall (m :: * -> *) a. Monad m => a -> m a
return Chunk
Else
  Word32
0x9  -> Int -> Get ()
skip Int
4 Get () -> Get Chunk -> Get Chunk
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Chunk -> Get Chunk
forall (m :: * -> *) a. Monad m => a -> m a
return Chunk
EndIf
  Word32
0x10 -> Tree -> Chunk
Parens (Tree -> Chunk) -> Get Tree -> Get Chunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DTAVersion -> Get Tree
binaryTree DTAVersion
version
  Word32
0x11 -> Tree -> Chunk
Braces (Tree -> Chunk) -> Get Tree -> Get Chunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DTAVersion -> Get Tree
binaryTree DTAVersion
version
  Word32
0x12 -> ByteString -> Chunk
String (ByteString -> Chunk) -> Get ByteString -> Get Chunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getLenStr
  Word32
0x13 -> Tree -> Chunk
Brackets (Tree -> Chunk) -> Get Tree -> Get Chunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DTAVersion -> Get Tree
binaryTree DTAVersion
version
  Word32
0x20 -> ByteString -> Chunk
Define (ByteString -> Chunk) -> Get ByteString -> Get Chunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getLenStr
  Word32
0x21 -> ByteString -> Chunk
Include (ByteString -> Chunk) -> Get ByteString -> Get Chunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getLenStr
  Word32
0x22 -> ByteString -> Chunk
Merge (ByteString -> Chunk) -> Get ByteString -> Get Chunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getLenStr
  Word32
0x23 -> ByteString -> Chunk
IfNDef (ByteString -> Chunk) -> Get ByteString -> Get Chunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getLenStr
  Word32
0x24 -> Int -> Get ()
skip Int
4 Get () -> Get Chunk -> Get Chunk
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Chunk -> Get Chunk
forall (m :: * -> *) a. Monad m => a -> m a
return Chunk
Autorun
  Word32
0x25 -> ByteString -> Chunk
Undef (ByteString -> Chunk) -> Get ByteString -> Get Chunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getLenStr
  Word32
_    -> String -> Get Chunk
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Chunk) -> String -> Get Chunk
forall a b. (a -> b) -> a -> b
$ String
"Unidentified DTB chunk with ID " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
cid

-- 4-byte chunk type ID, then at least 4 bytes of chunk data.
instance Binary Chunk where
  put :: Chunk -> Put
put Chunk
c = case Chunk
c of
    Int Int32
i       -> Word32 -> Put
putWord32le Word32
0x0  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
putWord32le (Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i)
    Float Float
f     -> Word32 -> Put
putWord32le Word32
0x1  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Float -> Put
putFloat32le Float
f
    Var ByteString
b       -> Word32 -> Put
putWord32le Word32
0x2  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putLenStr ByteString
b
    Sym ByteString
b       -> Word32 -> Put
putWord32le Word32
0x5  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putLenStr ByteString
b
    Chunk
Unhandled   -> Word32 -> Put
putWord32le Word32
0x6  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
putWord32le Word32
0
    IfDef ByteString
b     -> Word32 -> Put
putWord32le Word32
0x7  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putLenStr ByteString
b
    Chunk
Else        -> Word32 -> Put
putWord32le Word32
0x8  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
putWord32le Word32
0
    Chunk
EndIf       -> Word32 -> Put
putWord32le Word32
0x9  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
putWord32le Word32
0
    Parens Tree
tr   -> Word32 -> Put
putWord32le Word32
0x10 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tree -> Put
forall t. Binary t => t -> Put
put Tree
tr
    Braces Tree
tr   -> Word32 -> Put
putWord32le Word32
0x11 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tree -> Put
forall t. Binary t => t -> Put
put Tree
tr
    String ByteString
b    -> Word32 -> Put
putWord32le Word32
0x12 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putLenStr ByteString
b
    Brackets Tree
tr -> Word32 -> Put
putWord32le Word32
0x13 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tree -> Put
forall t. Binary t => t -> Put
put Tree
tr
    Define ByteString
b    -> Word32 -> Put
putWord32le Word32
0x20 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putLenStr ByteString
b
    Include ByteString
b   -> Word32 -> Put
putWord32le Word32
0x21 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putLenStr ByteString
b
    Merge ByteString
b     -> Word32 -> Put
putWord32le Word32
0x22 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putLenStr ByteString
b
    IfNDef ByteString
b    -> Word32 -> Put
putWord32le Word32
0x23 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putLenStr ByteString
b
    Chunk
Autorun     -> Word32 -> Put
putWord32le Word32
0x24 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
putWord32le Word32
0
    Undef ByteString
b     -> Word32 -> Put
putWord32le Word32
0x25 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putLenStr ByteString
b
  get :: Get Chunk
get = DTAVersion -> Get Chunk
binaryChunk DTAVersion
DTAVersion1

-- | DTB string format: 4-byte length, then a string in latin-1.
putLenStr :: B.ByteString -> Put
putLenStr :: ByteString -> Put
putLenStr ByteString
b = Word32 -> Put
putWord32le (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
b) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putByteString ByteString
b

-- | DTB string format: 4-byte length, then a string in latin-1.
getLenStr :: Get B.ByteString
getLenStr :: Get ByteString
getLenStr = Get Word32
getWord32le Get Word32 -> (Word32 -> Get ByteString) -> Get ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get ByteString
getByteString (Int -> Get ByteString)
-> (Word32 -> Int) -> Word32 -> Get ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Assign new sequential node IDs to each tree in a DTA, starting with the
-- top-level tree.
renumberFrom :: Word32 -> DTA -> DTA
renumberFrom :: Word32 -> DTA -> DTA
renumberFrom Word32
w (DTA Word8
b Tree
t) = Word8 -> Tree -> DTA
DTA Word8
b (Tree -> DTA) -> Tree -> DTA
forall a b. (a -> b) -> a -> b
$ State Word32 Tree -> Word32 -> Tree
forall s a. State s a -> s -> a
S.evalState (Tree -> State Word32 Tree
renumberTree Tree
t) Word32
w where
  renumberTree :: Tree -> S.State Word32 Tree
  renumberTree :: Tree -> State Word32 Tree
renumberTree (Tree Word32
_ [Chunk]
sub) = (Word32 -> [Chunk] -> Tree)
-> StateT Word32 Identity Word32
-> StateT Word32 Identity [Chunk]
-> State Word32 Tree
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Word32 -> [Chunk] -> Tree
Tree StateT Word32 Identity Word32
forall (m :: * -> *) s. Monad m => StateT s m s
S.get (StateT Word32 Identity [Chunk] -> State Word32 Tree)
-> StateT Word32 Identity [Chunk] -> State Word32 Tree
forall a b. (a -> b) -> a -> b
$
    (Word32 -> Word32) -> StateT Word32 Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
S.modify (Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1) StateT Word32 Identity ()
-> StateT Word32 Identity [Chunk] -> StateT Word32 Identity [Chunk]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Chunk -> StateT Word32 Identity Chunk)
-> [Chunk] -> StateT Word32 Identity [Chunk]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Chunk -> StateT Word32 Identity Chunk
renumberChunk [Chunk]
sub
  renumberChunk :: Chunk -> S.State Word32 Chunk
  renumberChunk :: Chunk -> StateT Word32 Identity Chunk
renumberChunk Chunk
c = case Chunk
c of
    Parens Tree
tr   -> Tree -> Chunk
Parens (Tree -> Chunk)
-> State Word32 Tree -> StateT Word32 Identity Chunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree -> State Word32 Tree
renumberTree Tree
tr
    Braces Tree
tr   -> Tree -> Chunk
Braces (Tree -> Chunk)
-> State Word32 Tree -> StateT Word32 Identity Chunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree -> State Word32 Tree
renumberTree Tree
tr
    Brackets Tree
tr -> Tree -> Chunk
Brackets (Tree -> Chunk)
-> State Word32 Tree -> StateT Word32 Identity Chunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree -> State Word32 Tree
renumberTree Tree
tr
    Chunk
_           -> Chunk -> StateT Word32 Identity Chunk
forall (m :: * -> *) a. Monad m => a -> m a
return Chunk
c
  -- alternately, with uniplate: renumberChunk = descendBiM renumberTree