/src/Data/NetCDF/Serialize.hs

  1{-# LANGUAGE OverloadedStrings #-}
  2
  3module Data.NetCDF.Serialize (getHeader) where
  4
  5import           Control.Applicative
  6import           Data.Bits ((.&.), complement)
  7import           Data.ByteString (ByteString)
  8import qualified Data.ByteString.Char8 as B
  9import           Data.Int (Int16, Int32)
 10import           Data.Serialize
 11import           Data.Word (Word8, Word32)
 12import           Prelude hiding (take, drop)
 13
 14import           Data.NetCDF.Types
 15
 16------------------------------------------------------------------------
 17
 18-- | Parse the header of a NetCDF file.
 19getHeader :: Get Header
 20getHeader = do
 21    string "CDF"
 22
 23    format <- pure FormatClassic <* word8 1
 24          <|> pure Format64Bit   <* word8 2
 25          <?> "file format"
 26
 27    numrecs <- pure Streaming <* word32be 0xFFFFFFFF
 28           <|> NumRecs <$> getWord32be
 29
 30    dims  <- getDimensionList
 31    gatts <- getAttributeList
 32    vars  <- getVariableList dims (getOffsetFor format)
 33
 34    return (Header format numrecs dims gatts vars)
 35
 36-- | Create a parser for file offsets depending on the file format.
 37getOffsetFor :: Format -> Get FileOffset
 38getOffsetFor FormatClassic = fromIntegral <$> getWord32be
 39getOffsetFor Format64Bit   = fromIntegral <$> getWord64be
 40
 41getDimensionList :: Get [Dim]
 42getDimensionList = headerList 0xA getDimension <?> "dimensions"
 43
 44getAttributeList :: Get [Attr]
 45getAttributeList = headerList 0xC getAttribute <?> "attributes"
 46
 47getVariableList  :: [Dim] -> Get FileOffset -> Get [Var]
 48getVariableList dims getOffset = headerList 0xB (getVariable dims getOffset) <?> "variables"
 49
 50headerList :: Word32 -> Get a -> Get [a]
 51headerList tag gelem = absent <|> word32be tag *> getList gelem
 52  where
 53    absent = zero *> zero *> pure []
 54    zero   = word32be 0
 55
 56getName :: Get Name
 57getName = getAlignedBytes <?> "name"
 58
 59
 60getDimension :: Get Dim
 61getDimension = Dim <$> getName <*> getDimensionLength
 62
 63getDimensionLength :: Get DimLength
 64getDimensionLength = pure Unlimited <* word32be 0
 65                 <|> Fixed <$> getWord32be
 66
 67
 68getAttribute :: Get Attr
 69getAttribute = Attr <$> getName <*> getAttributeValue <?> "attribute"
 70
 71getAttributeValue :: Get AttrValue
 72getAttributeValue = do
 73    typ <- getVariableType
 74    case typ of
 75      VarByte   -> AttrByte   <$> getAlignedBytes
 76      VarChar   -> AttrChar   <$> getAlignedBytes
 77      VarShort  -> AttrShort  <$> getAlignedShorts
 78      VarInt    -> AttrInt    <$> getList getInt32be
 79      VarFloat  -> AttrFloat  <$> getList getFloat32be
 80      VarDouble -> AttrDouble <$> getList getFloat64be
 81
 82
 83getVariable :: [Dim] -> Get FileOffset -> Get Var
 84getVariable dims getOffset =
 85    Var <$> getName
 86        <*> getList ((dims !!) <$> nonNeg)
 87        <*> getAttributeList
 88        <*> getVariableType
 89        <*> getWord32be
 90        <*> getOffset
 91        <?> "variable"
 92
 93getVariableType :: Get VarType
 94getVariableType = do
 95    typ <- getWord32be
 96    case typ of
 97      1 -> pure VarByte
 98      2 -> pure VarChar
 99      3 -> pure VarShort
100      4 -> pure VarInt
101      5 -> pure VarFloat
102      6 -> pure VarDouble
103      _ -> fail ("unsupported nc_type = " ++ show typ)
104    <?> "variableType"
105
106
107------------------------------------------------------------------------
108-- Utils
109
110-- | Label the parser, in case failure occurs.
111(<?>) :: Get a -> String -> Get a
112g <?> lbl = label lbl g
113infix 0 <?>
114
115-- | Apply the given action repeatedly, returning every result.
116count :: Monad m => Int -> m a -> m [a]
117count n p = sequence (replicate n p)
118
119-- | Expect a specific string.
120string :: ByteString -> Get ()
121string xs = expectS B.unpack (getByteString $ B.length xs) xs
122
123-- | Expect a specific 8-bit word.
124word8 :: Word8 -> Get ()
125word8 = expect getWord8
126
127-- | Expect a specific 32-bit big endian word.
128word32be :: Word32 -> Get ()
129word32be = expect getWord32be
130
131expect :: (Show a, Eq a) => Get a -> a -> Get ()
132expect = expectS show
133
134expectS :: Eq a => (a -> String) -> Get a -> a -> Get ()
135expectS show' get' x = get' >>= \y ->
136    if x == y
137       then return ()
138       else fail ("expected " ++ show' x ++ " (was " ++ show' y ++ ")")
139
140getAlignedBytes :: Get ByteString
141getAlignedBytes = do
142    n <- nonNeg
143    getBytes n <* align n
144    <?> "aligned bytes"
145
146getAlignedShorts :: Get [Int16]
147getAlignedShorts = do
148    n <- nonNeg
149    count n getInt16be <* align (n * 2)
150    <?> "aligned shorts"
151
152-- | Re-aligns the current offset to a 4-byte boundary given
153-- the number of bytes read since the last alignment.
154align :: Int -> Get ()
155align bytesRead = getBytes padding *> pure () <?> "align"
156  where
157    boundary = (bytesRead + 3) .&. complement 0x3
158    padding  = boundary - bytesRead
159
160getList :: Get a -> Get [a]
161getList g = do
162    n <- nonNeg
163    count n g
164
165nonNeg :: Get Int
166nonNeg = fromIntegral <$> getWord32be
167
168getInt16be :: Get Int16
169getInt16be = fromIntegral <$> getWord16be
170
171getInt32be :: Get Int32
172getInt32be = fromIntegral <$> getWord32be