[Haskell-cafe] IFF reader and writer

[Chris Kuklewicz]

This parser was quick to write and works on AIFF files.  It does not do much
validation, and bits from 2 to 4 GB in length will cause errors.

module LoadIFF(IFF(..),parseIFF,IDType,FormType,ContentsType) where

import Data.List(unfoldr,span)
import Data.Bits((.|.),shiftL)
import Data.Word(Word32)
import Data.ByteString(ByteString)
import qualified Data.ByteString as B(take,drop,splitAt,length,unpack)

type IDType = String
type FormType = String
type ContentsType = String

data IFF = IFF_Form {len :: Word32
                    ,typeID :: FormType
                    ,parts :: [IFF]
                    }
         | IFF_List {len :: Word32
                    ,typeID :: ContentsType
                    ,props :: [IFF]
                    ,parts :: [IFF]
                    }
         | IFF_Cat  {len :: Word32
                    ,typeID :: ContentsType
                    ,parts :: [IFF]
                    }
         | IFF_Prop {len :: Word32
                    ,typeID :: FormType
                    ,parts :: [IFF]
                    }
         | IFF_Chunk {len :: Word32
                     ,typeID :: IDType
                     ,rawContent :: ByteString
                     }

instance Show IFF where
  show IFF_Form { typeID = name, len = size, parts = p } =
    "IFF_Form {typeID="++show name++",size="++show size++",parts="++show p++"}"
  show IFF_List { typeID = name, len = size, props = ps, parts = p } =
    "IFF_List {typeID="++show name++",size="++show size++",props"++show
ps++",parts="++show p++"}"
  show IFF_Cat { typeID = name, len = size, parts = p } =
    "IFF_Cat {typeID="++show name++",size="++show size++",parts="++show p++"}"
  show IFF_Prop { typeID = name, len = size, parts = p } =
    "IFF_Prop {typeID="++show name++",size="++show size++",parts="++show p++"}"
  show IFF_Chunk { typeID = name, len = size } = "IFF_Chunk {typeID="++show
name++",size="++show size++"}"

b2s = map (toEnum . fromEnum) . B.unpack

isProp IFF_Prop {} = True
isProp _ = False

parseIFF :: ByteString -> Maybe (IFF,ByteString)
parseIFF b | B.length b <=8 = Nothing
           | otherwise =
  let (bID,b') = B.splitAt 4 b
      (bLEN,b'') = B.splitAt 4 b'
      (bTypeID,content) = B.splitAt 4 b''
      [x1,x2,x3,x4] = map fromIntegral (B.unpack bLEN)
      iLEN = (shiftL x1 24) .|. (shiftL x2 16) .|. (shiftL x3 8) .|. x4
      toNext = (if odd iLEN then succ else id) (fromIntegral iLEN)
      rest = B.drop toNext b''
  in if iLEN > fromIntegral (B.length b'')
       then Nothing
       else let iff = case b2s bID of
                        "FORM" -> IFF_Form {len = iLEN
                                           ,typeID = b2s bTypeID
                                           ,parts = unfoldr parseIFF content}
                        "LIST" -> let (ps,cs) = span isProp (unfoldr parseIFF
content)
                                  in IFF_List {len = iLEN
                                              ,typeID = b2s bTypeID
                                              ,props = ps
                                              ,parts = cs}
                        "CAT " -> IFF_Cat {len = iLEN
                                          ,typeID = b2s bTypeID
                                          ,parts = unfoldr parseIFF content}
                        "Prop" -> IFF_Prop {len = iLEN
                                           ,typeID = b2s bTypeID
                                           ,parts = unfoldr parseIFF content}
                        chunkID -> IFF_Chunk {len = iLEN
                                             ,typeID = chunkID
                                             ,rawContent = content}
            in Just (iff,rest)