packages feed

SWMMoutGetMB 0.1.0.1 → 0.1.1.0

raw patch · 2 files changed

+175/−166 lines, 2 files

Files

SWMMoutGetMB.cabal view
@@ -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
src/Water/SWMM.hs view
@@ -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