diff --git a/SWMMoutGetMB.cabal b/SWMMoutGetMB.cabal --- a/SWMMoutGetMB.cabal +++ b/SWMMoutGetMB.cabal @@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.1.0.1 +version: 0.1.1.0 -- A short (one-line) description of the package. synopsis: A parser for SWMM 5 binary .OUT files diff --git a/src/Water/SWMM.hs b/src/Water/SWMM.hs --- a/src/Water/SWMM.hs +++ b/src/Water/SWMM.hs @@ -1,69 +1,45 @@ --- | --- Module : Water.SWMM --- Copyright : (C) 2014 Siddhanathan Shanmugam --- License : LGPL (see LICENSE) --- Maintainer : siddhanathan@gmail.com --- Portability : very --- --- Parser for SWMM 5 Binary .OUT files --- - -{-# LANGUAGE Trustworthy #-} - -module Water.SWMM ( SWMMObject(..) - , Header(..) - , ObjectIds(..) - , Properties(..) - , ObjectProperties(..) - , Variables(..) - , ReportingVariables(..) - , ReportingInterval(..) - , ValuesForOneDateTime(..) - , ComputedResult(..) - , ClosingRecord(..) - , parseSWMMBinary - ) where +module Water.SWMM where -import safe Data.Binary.Get (getWord32le, runGet, Get, getLazyByteString) -import safe Control.Applicative ((<$>), (<*>)) -import safe qualified Data.ByteString.Lazy as BL (ByteString, pack, unpack, drop, length) -import safe qualified Data.ByteString.Lazy.Char8 as BLC (ByteString, pack, unpack) -import safe Data.List.Split (chunksOf) -import safe Control.Monad (replicateM) +import Control.Applicative ((<$>), (<*>)) +import Control.Monad (replicateM) +import Data.Binary.Get (Get, getWord32le, getByteString) +import Data.Binary.IEEE754 (getFloat32le, getFloat64le) +import Data.List.Split (chunksOf) +import Pipes.Binary (decodeGet) +import Pipes.Parse (Parser, evalStateT) --- There is an implicit assumption that IEEE-754 is the in-memory representation. --- If we assume this is the case, then this is safe. -import Data.Binary.IEEE754 (getFloat32le, getFloat64le) +import qualified Data.ByteString.Char8 as BSC (ByteString) +import qualified Data.ByteString.Lazy as BL (ByteString, readFile, drop, take, length) +import qualified Pipes.ByteString as PB (ByteString, fromLazy) -data SWMMObject = SWMMObject { header :: Header +data SWMMParams = SWMMParams { header :: Header , ids :: ObjectIds , properties :: ObjectProperties , variables :: ReportingVariables , intervals :: ReportingInterval - , result :: ComputedResult , closingRecord :: ClosingRecord } deriving (Show, Eq) -data Header = Header { headerIdNumber :: Integer - , versionNumber :: Integer - , codeNumber :: Integer - , numberOfSubcatchments :: Integer - , numberOfNodes :: Integer - , numberOfLinks :: Integer - , numberOfPollutants :: Integer +data Header = Header { headerIdNumber :: Int + , versionNumber :: Int + , codeNumber :: Int + , numberOfSubcatchments :: Int + , numberOfNodes :: Int + , numberOfLinks :: Int + , numberOfPollutants :: Int } deriving (Show, Eq) -data ObjectIds = ObjectIds { subcatchmentIds :: [BLC.ByteString] - , nodeIds :: [BLC.ByteString] - , linkIds :: [BLC.ByteString] - , pollutantIds :: [BLC.ByteString] - , concentrationIds :: [Integer] +data ObjectIds = ObjectIds { subcatchmentIds :: [BSC.ByteString] + , nodeIds :: [BSC.ByteString] + , linkIds :: [BSC.ByteString] + , pollutantIds :: [BSC.ByteString] + , concentrationIds :: [Int] } deriving (Show, Eq) data ObjectProperties = ObjectProperties { subcatchmentProperties :: Properties , nodeProperties :: Properties , linkProperties :: Properties - } deriving (Show, Eq) + } deriving (Show, Eq) data ReportingVariables = ReportingVariables { subcatchmentVariables :: Variables , nodeVariables :: Variables @@ -71,155 +47,188 @@ , systemVariables :: Variables } deriving (Show, Eq) - data ReportingInterval = ReportingInterval { startDateTime :: Double - , timeIntervals :: Integer + , timeIntervals :: Int } deriving (Show, Eq) -data ComputedResult = ComputedResult { allDateTimes :: [ValuesForOneDateTime] } - deriving (Show, Eq) +data ValuesForOneDateTime = ValuesForOneDateTime { dateTimeValue :: Double + , subcatchmentValue :: [[Float]] + , nodeValue :: [[Float]] + , linkValue :: [[Float]] + , systemValue :: [Float] + } deriving (Show) -data ClosingRecord = ClosingRecord { idBytePosition :: Integer - , propertiesBytePosition :: Integer - , resultBytePosition :: Integer - , numberOfPeriods :: Integer - , errorCode :: Integer - , closingIdNumber :: Integer +data ClosingRecord = ClosingRecord { idBytePosition :: Int + , propertiesBytePosition :: Int + , resultBytePosition :: Int + , numberOfPeriods :: Int + , errorCode :: Int + , closingIdNumber :: Int } deriving (Show, Eq) -type Ids = [BL.ByteString] - -data Properties = Properties { numberOfProperties :: Integer - , codeNumberProperties :: [Integer] +data Properties = Properties { numberOfProperties :: Int + , codeNumberProperties :: [Int] , valueProperties :: [Float] } deriving (Show, Eq) -data Variables = Variables { numberOfVariables :: Integer - , codeNumberVariables :: [Integer] +data Variables = Variables { numberOfVariables :: Int + , codeNumberVariables :: [Int] } deriving (Show, Eq) -data ValuesForOneDateTime = ValuesForOneDateTime { dateTimeValue :: Double - , subcatchmentValue :: [[Float]] - , nodeValue :: [[Float]] - , linkValue :: [[Float]] - , systemValue :: [Float] - } deriving (Show) - instance Ord ValuesForOneDateTime where a <= b = dateTimeValue a <= dateTimeValue b instance Eq ValuesForOneDateTime where a == b = dateTimeValue a == dateTimeValue b -closingRecordSize :: Int -closingRecordSize = 6 * 4 -getHeader :: Get Header -getHeader = Header <$> a - <*> a - <*> a - <*> a - <*> a - <*> a - <*> a - where a = getIntegerWord32le - -getSWMMObject :: ClosingRecord -> Get SWMMObject -getSWMMObject closing = do - header <- getHeader - objectIds <- getObjectIds header - objectProperties <- getObjectProperties header - reportingVariables <- getReportingVariables - reportingIntervals <- getReportingIntervals - computedResult <- getComputedResults (numberOfPeriods closing) header reportingVariables - closingRecord <- getClosingRecords - return $ SWMMObject header - objectIds - objectProperties - reportingVariables - reportingIntervals - computedResult - closingRecord - -parseSWMMBinary :: BL.ByteString -> SWMMObject -parseSWMMBinary input = do - let closingRecord = runGet getClosingRecords (getClosingByteString input) - swmmObject = runGet (getSWMMObject closingRecord) input - swmmObject +-- | Get a 4 byte integer +getInt :: Get Int +getInt = fromIntegral <$> getWord32le -getIntegerWord32le :: Get Integer -getIntegerWord32le = fromIntegral <$> getWord32le +-- | Get a string +getString :: Get BSC.ByteString +getString = getInt >>= getByteString -getClosingByteString :: BL.ByteString -> BL.ByteString -getClosingByteString input = BL.drop (BL.length input - fromIntegral closingRecordSize) input +getHeader :: Get Header +getHeader = Header <$> getInt + <*> getInt + <*> getInt + <*> getInt + <*> getInt + <*> getInt + <*> getInt getObjectIds :: Header -> Get ObjectIds -getObjectIds header = - ObjectIds <$> getIds (numberOfSubcatchments header) - <*> getIds (numberOfNodes header) - <*> getIds (numberOfLinks header) - <*> getIds (numberOfPollutants header) - <*> replicateM (fromInteger . numberOfPollutants $ header) getIntegerWord32le +getObjectIds h = do + s <- replicateM (numberOfSubcatchments h) getString + n <- replicateM (numberOfNodes h) getString + l <- replicateM (numberOfLinks h) getString + p <- replicateM (numberOfPollutants h) getString + c <- replicateM (numberOfPollutants h) getInt + return $ ObjectIds s n l p c -getIds :: Integer -> Get [BL.ByteString] -getIds n = replicateM (fromInteger n) - (getIntegerWord32le >>= getLazyByteString . fromInteger) +getProperties :: Int -> Get Properties +getProperties n = do + size <- getInt + codeNumbers <- replicateM size getInt + values <- replicateM (size * n) getFloat32le + return $ Properties size codeNumbers values +getObjectProperties :: Header -> Get ObjectProperties +getObjectProperties h = + ObjectProperties <$> getProperties (numberOfSubcatchments h) + <*> getProperties (numberOfNodes h) + <*> getProperties (numberOfLinks h) + getVariables :: Get Variables getVariables = do - number <- getIntegerWord32le - codeNumbers <- replicateM (fromInteger number) getIntegerWord32le - return $ Variables number codeNumbers + size <- getInt + codeNumbers <- replicateM size getInt + return $ Variables size codeNumbers -getProperties :: Integer -> Get Properties -getProperties n = do - number <- getIntegerWord32le - codeNumbers <- replicateM (fromInteger number) getIntegerWord32le - values <- replicateM (fromInteger (number * n)) getFloat32le - return $ Properties number codeNumbers values +getReportingVariables :: Get ReportingVariables +getReportingVariables = ReportingVariables <$> getVariables + <*> getVariables + <*> getVariables + <*> getVariables -getObjectProperties :: Header -> Get ObjectProperties -getObjectProperties header = ObjectProperties <$> getProperties (numberOfSubcatchments header) - <*> getProperties (numberOfNodes header) - <*> getProperties (numberOfLinks header) +getReportingInterval :: Get ReportingInterval +getReportingInterval = ReportingInterval <$> getFloat64le + <*> getInt -getReportingVariables :: Get ReportingVariables -getReportingVariables = ReportingVariables <$> a - <*> a - <*> a - <*> a - where a = getVariables +getSWMMTopParams :: Get ( Header, ObjectIds, ObjectProperties + , ReportingVariables, ReportingInterval ) +getSWMMTopParams = do + h <- getHeader + oi <- getObjectIds h + op <- getObjectProperties h + rv <- getReportingVariables + ri <- getReportingInterval + return (h, oi, op, rv, ri) -getReportingIntervals :: Get ReportingInterval -getReportingIntervals = ReportingInterval <$> getFloat64le - <*> getIntegerWord32le +getClosingRecord :: Get ClosingRecord +getClosingRecord = ClosingRecord <$> getInt + <*> getInt + <*> getInt + <*> getInt + <*> getInt + <*> getInt -getResults :: Header -> ReportingVariables -> Get ValuesForOneDateTime -getResults header report = do - ValuesForOneDateTime <$> getFloat64le - <*> getSplitValues (numberOfSubcatchments header * ns) ns - <*> getSplitValues (numberOfNodes header * nn) nn - <*> getSplitValues (numberOfLinks header * nl) nl - <*> getValues (numberOfVariables . systemVariables $ report) - where ns = (numberOfVariables . subcatchmentVariables) report - nn = (numberOfVariables . nodeVariables) report - nl = (numberOfVariables . linkVariables) report +-- | Extract the SWMM parameters from the file, and return +-- the remainder of the binary file (containing only the +-- result data now) as a lazy bytestring. If the bytestring +-- is small, it can be forced and held in memory, otherwise +-- it needs to be streamed strictly. +extractSWMMParams :: FilePath -> IO (SWMMParams, BL.ByteString) +extractSWMMParams f = do + -- Grab the Top SWMM Parameters + s <- PB.fromLazy <$> BL.readFile f + (h,oi,op,rv,ri) <- evalStateT decodeTopSWMMParameters s -getComputedResults :: Integer -> Header -> ReportingVariables -> Get ComputedResult -getComputedResults n header report = ComputedResult <$> replicateM (fromInteger n) (getResults header report) + -- Grab the Closing Records + e <- PB.fromLazy . grabClosingRecord <$> BL.readFile f + c <- evalStateT decodeClosingRecord e -getValues :: Integer -> Get [Float] -getValues n = replicateM (fromInteger n) getFloat32le + -- Grab the actual data + results <- dropUptoResults c . takeUptoClosingRecord <$> BL.readFile f -getSplitValues :: Integer -> Integer -> Get [[Float]] -getSplitValues n nv = chunksOf (fromInteger nv) <$> replicateM (fromInteger n) getFloat32le + return $ (SWMMParams h oi op rv ri c, results) + where + -- | Grab all parameters aligned before the data in an unsafe manner. + decodeTopSWMMParameters + :: Parser PB.ByteString IO ( Header, ObjectIds, ObjectProperties + , ReportingVariables, ReportingInterval ) + decodeTopSWMMParameters = do + Right top <- decodeGet getSWMMTopParams + return top -getClosingRecords :: Get ClosingRecord -getClosingRecords = ClosingRecord <$> a - <*> a - <*> a - <*> a - <*> a - <*> a - where a = getIntegerWord32le + -- | Grab the closing record in an unsafe manner. + decodeClosingRecord :: Parser PB.ByteString IO ClosingRecord + decodeClosingRecord = do + Right closing <- decodeGet getClosingRecord + return closing + + -- | The number of bytes spanned by the closing record. + closingRecordSize :: Num a => a + closingRecordSize = 4 * 6 + + -- | Drop the initial bytestring upto the closing record. + -- Allows grabbing the closing record in O(1) time. + grabClosingRecord :: BL.ByteString -> BL.ByteString + grabClosingRecord = (\f -> BL.drop (BL.length f - closingRecordSize) f) + + -- | Take the initial bytestring upto the closing record. + -- Allows grabbing the closing record in O(1) time. + takeUptoClosingRecord :: BL.ByteString -> BL.ByteString + takeUptoClosingRecord = (\f -> BL.take (BL.length f - closingRecordSize) f) + + -- | Drop upto the actual recorded data. + -- Allows grabbing the results in O(1) time. + dropUptoResults :: ClosingRecord -> BL.ByteString -> BL.ByteString + dropUptoResults c = BL.drop (fromIntegral $ resultBytePosition c) + +getSplitValues :: Int -> Int -> Get [[Float]] +getSplitValues n nv = + chunksOf n <$> replicateM nv getFloat32le + +getValues :: Int -> Get [Float] +getValues n = replicateM n getFloat32le + +getResults :: Header -> ReportingVariables -> Get ValuesForOneDateTime +getResults header report = + ValuesForOneDateTime <$> getFloat64le + <*> getSub + <*> getNode + <*> getLink + <*> getVar + where nsub = (numberOfVariables . subcatchmentVariables) report + nnode = (numberOfVariables . nodeVariables ) report + nlink = (numberOfVariables . linkVariables ) report + nvar = (numberOfVariables . systemVariables ) report + + getSub = getSplitValues nsub (numberOfSubcatchments header * nsub ) + getNode = getSplitValues nnode (numberOfNodes header * nnode) + getLink = getSplitValues nlink (numberOfLinks header * nlink) + getVar = getValues nvar