SWMMoutGetMB 0.1.0.0 → 0.1.0.1
raw patch · 2 files changed
+115/−141 lines, 2 filesdep ~basedep ~binarydep ~bytestring
Dependency ranges changed: base, binary, bytestring, data-binary-ieee754, split
Files
- SWMMoutGetMB.cabal +6/−2
- src/Water/SWMM.hs +109/−139
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.0+version: 0.1.0.1 -- A short (one-line) description of the package. synopsis: A parser for SWMM 5 binary .OUT files@@ -62,7 +62,11 @@ -- other-modules: Examples -- Other library packages from which modules are imported.- build-depends: base ==4.6.*, binary ==0.7.*, bytestring ==0.10.*, data-binary-ieee754 ==0.4.*, split ==0.2.*+ build-depends: base >= 4 && < 5,+ binary >= 0.7,+ bytestring >= 0.10,+ data-binary-ieee754 >= 0.4,+ split >= 0.2 -- Directories containing source files. hs-source-dirs: src
src/Water/SWMM.hs view
@@ -8,38 +8,41 @@ -- Parser for SWMM 5 Binary .OUT files -- -{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}+{-# LANGUAGE Trustworthy #-} module Water.SWMM ( SWMMObject(..) , Header(..)- , Ids(..)+ , ObjectIds(..) , Properties(..) , ObjectProperties(..) , Variables(..) , ReportingVariables(..) , ReportingInterval(..) , ValuesForOneDateTime(..)- , ComputedResult+ , ComputedResult(..) , ClosingRecord(..) , parseSWMMBinary ) where -import Data.Binary.Get (getWord32le, runGetState, Get(..), getLazyByteString)-import Data.Word (Word32(..))-import Data.ByteString.Internal (ByteString)-import Control.Applicative ((<$>), (<*>))-import Data.Binary.IEEE754 (getFloat32le, getFloat64le)-import qualified Data.ByteString.Lazy as BL (ByteString, pack, unpack)-import Data.List.Split (splitEvery)+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) +-- 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)+ data SWMMObject = SWMMObject { header :: Header- , ids :: Ids+ , ids :: ObjectIds , properties :: ObjectProperties , variables :: ReportingVariables , intervals :: ReportingInterval , result :: ComputedResult , closingRecord :: ClosingRecord- } deriving (Show)+ } deriving (Show, Eq) data Header = Header { headerIdNumber :: Integer , versionNumber :: Integer@@ -48,32 +51,33 @@ , numberOfNodes :: Integer , numberOfLinks :: Integer , numberOfPollutants :: Integer- } deriving (Show)+ } deriving (Show, Eq) -data Ids = Ids { subcatchmentIds :: [BL.ByteString]- , nodeIds :: [BL.ByteString]- , linkIds :: [BL.ByteString]- , pollutantIds :: [BL.ByteString]- , concentrationIds :: [Integer]- } deriving (Show)+data ObjectIds = ObjectIds { subcatchmentIds :: [BLC.ByteString]+ , nodeIds :: [BLC.ByteString]+ , linkIds :: [BLC.ByteString]+ , pollutantIds :: [BLC.ByteString]+ , concentrationIds :: [Integer]+ } deriving (Show, Eq) data ObjectProperties = ObjectProperties { subcatchmentProperties :: Properties , nodeProperties :: Properties , linkProperties :: Properties- } deriving (Show)+ } deriving (Show, Eq) data ReportingVariables = ReportingVariables { subcatchmentVariables :: Variables , nodeVariables :: Variables , linkVariables :: Variables , systemVariables :: Variables- } deriving (Show)+ } deriving (Show, Eq) data ReportingInterval = ReportingInterval { startDateTime :: Double , timeIntervals :: Integer- } deriving (Show)+ } deriving (Show, Eq) -type ComputedResult = [ValuesForOneDateTime]+data ComputedResult = ComputedResult { allDateTimes :: [ValuesForOneDateTime] }+ deriving (Show, Eq) data ClosingRecord = ClosingRecord { idBytePosition :: Integer , propertiesBytePosition :: Integer@@ -81,16 +85,18 @@ , numberOfPeriods :: Integer , errorCode :: Integer , closingIdNumber :: Integer- } deriving (Show)+ } deriving (Show, Eq) +type Ids = [BL.ByteString]+ data Properties = Properties { numberOfProperties :: Integer , codeNumberProperties :: [Integer] , valueProperties :: [Float]- } deriving (Show)+ } deriving (Show, Eq) data Variables = Variables { numberOfVariables :: Integer , codeNumberVariables :: [Integer]- } deriving (Show)+ } deriving (Show, Eq) data ValuesForOneDateTime = ValuesForOneDateTime { dateTimeValue :: Double , subcatchmentValue :: [[Float]]@@ -99,6 +105,12 @@ , 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 @@ -112,137 +124,95 @@ <*> 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 closingByteString = getClosingByteString input- (closingRecord, _, _) = runGetState getClosingRecords closingByteString 1- (header, rest1, _) = runGetState getHeader input 1- (ids, rest2) = getIds rest1 header- (objectProperties, rest3) = getObjectProperties header rest2- (reportingVariables, rest4) = getReportingVariables rest3- (reportingIntervals, rest5, _) = runGetState getReportingIntervals rest4 1- (result, rest6) = getComputedResults (numberOfPeriods closingRecord)- reportingVariables header rest5- SWMMObject header- ids- objectProperties- reportingVariables- reportingIntervals- result- closingRecord+ let closingRecord = runGet getClosingRecords (getClosingByteString input)+ swmmObject = runGet (getSWMMObject closingRecord) input+ swmmObject getIntegerWord32le :: Get Integer getIntegerWord32le = fromIntegral <$> getWord32le -getWords :: Integer -> BL.ByteString -> ([Integer], BL.ByteString)-getWords n input- | n == 0 = ([], input)- | otherwise = appendW w (getWords (n-1) rest)- where (w, rest, _) = runGetState getIntegerWord32le input 1--appendW :: a -> ([a], BL.ByteString) -> ([a], BL.ByteString)-appendW w (x, y) = (w:x, y)+getClosingByteString :: BL.ByteString -> BL.ByteString+getClosingByteString input = BL.drop (BL.length input - fromIntegral closingRecordSize) input -getDecimals :: Integer -> BL.ByteString -> ([Float], BL.ByteString)-getDecimals n input- | n == 0 = ([], input)- | otherwise = appendW w (getDecimals (n-1) rest)- where (w, rest, _) = runGetState getFloat32le input 1+getObjectIds :: Header -> Get ObjectIds+getObjectIds header =+ ObjectIds <$> getIds (numberOfSubcatchments header)+ <*> getIds (numberOfNodes header)+ <*> getIds (numberOfLinks header)+ <*> getIds (numberOfPollutants header)+ <*> replicateM (fromInteger . numberOfPollutants $ header) getIntegerWord32le -getByteStrings :: Integer -> BL.ByteString -> ([BL.ByteString], BL.ByteString)-getByteStrings n input- | n == 0 = ([], input)- | otherwise = appendW w (getByteStrings (n-1) rest)- where (c, r, _) = runGetState getWord32le input 1- (w, rest, _) = runGetState ((getLazyByteString . fromIntegral) c) r 1+getIds :: Integer -> Get [BL.ByteString]+getIds n = replicateM (fromInteger n)+ (getIntegerWord32le >>= getLazyByteString . fromInteger) -getClosingByteString :: BL.ByteString -> BL.ByteString-getClosingByteString = BL.pack . reverse . take closingRecordSize . reverse . BL.unpack+getVariables :: Get Variables+getVariables = do+ number <- getIntegerWord32le+ codeNumbers <- replicateM (fromInteger number) getIntegerWord32le+ return $ Variables number codeNumbers -getIds :: BL.ByteString -> Header -> (Ids, BL.ByteString)-getIds rest1 header = do- let (subcatchments, rest2) = getByteStrings (numberOfSubcatchments header) rest1- (nodes, rest3) = getByteStrings (numberOfNodes header) rest2- (links, rest4) = getByteStrings (numberOfLinks header) rest3- (pollutants, rest5) = getByteStrings (numberOfPollutants header) rest4- (pollutantConcentrationUnits, rest6) = getWords (numberOfPollutants header) rest5- (Ids subcatchments nodes links pollutants pollutantConcentrationUnits, rest6)+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 -getObjectProperties :: Header -> BL.ByteString -> (ObjectProperties, BL.ByteString)-getObjectProperties header rest1 = do- let (numberOfSubcatchmentProperties, rest2, _) = runGetState getIntegerWord32le rest1 1- (codeNumberSubcatchmentProperties, rest3) = getWords numberOfSubcatchmentProperties rest2- (valueSubcatchmentProperties, rest4) = getDecimals n rest3- where n = numberOfSubcatchmentProperties- * numberOfSubcatchments header- (numberOfNodeProperties, rest5, _) = runGetState getIntegerWord32le rest4 1- (codeNumberNodeProperties, rest6) = getWords numberOfNodeProperties rest5- (valueNodeProperties, rest7) = getDecimals (numberOfNodeProperties- * numberOfNodes header) rest6- (numberOfLinkProperties, rest8, _) = runGetState getIntegerWord32le rest7 1- (codeNumberLinkProperties, rest9) = getWords numberOfLinkProperties rest8- (valueLinkProperties, rest10) = getDecimals (numberOfLinkProperties- * numberOfLinks header) rest9- subcatchment = Properties numberOfSubcatchmentProperties- codeNumberSubcatchmentProperties- valueSubcatchmentProperties- node = Properties numberOfNodeProperties- codeNumberNodeProperties- valueNodeProperties- link = Properties numberOfLinkProperties- codeNumberLinkProperties- valueLinkProperties- object = ObjectProperties subcatchment node link- (object, rest10)+getObjectProperties :: Header -> Get ObjectProperties+getObjectProperties header = ObjectProperties <$> getProperties (numberOfSubcatchments header)+ <*> getProperties (numberOfNodes header)+ <*> getProperties (numberOfLinks header) -getReportingVariables :: BL.ByteString -> (ReportingVariables, BL.ByteString)-getReportingVariables rest1 = do- let (numberOfSubcatchmentVariables, rest2, _) = runGetState getIntegerWord32le rest1 1- (codeNumberSubcatchmentVariables, rest3) = getWords numberOfSubcatchmentVariables rest2- (numberOfNodeVariables, rest4, _) = runGetState getIntegerWord32le rest3 1- (codeNumberNodeVariables, rest5) = getWords numberOfNodeVariables rest4- (numberOfLinkVariables, rest6, _) = runGetState getIntegerWord32le rest5 1- (codeNumberLinkVariables, rest7) = getWords numberOfLinkVariables rest6- (numberOfSystemVariables, rest8, _) = runGetState getIntegerWord32le rest7 1- (codeNumberSystemVariables, rest9) = getWords numberOfSystemVariables rest8- subcatchment = Variables numberOfSubcatchmentVariables codeNumberSubcatchmentVariables- node = Variables numberOfNodeVariables codeNumberNodeVariables- link = Variables numberOfLinkVariables codeNumberLinkVariables- system = Variables numberOfSystemVariables codeNumberSystemVariables- reportingVariables = ReportingVariables subcatchment node link system- (reportingVariables, rest9)+getReportingVariables :: Get ReportingVariables+getReportingVariables = ReportingVariables <$> a+ <*> a+ <*> a+ <*> a+ where a = getVariables getReportingIntervals :: Get ReportingInterval getReportingIntervals = ReportingInterval <$> getFloat64le <*> getIntegerWord32le -splitEveryRemainder :: Num b => Integer -> ([b], BL.ByteString) -> ([[b]], BL.ByteString)-splitEveryRemainder n (l, r) = (splitEvery ns l, r)- where ns = fromInteger n+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 -getComputedResults :: Integer -> ReportingVariables -> Header -> BL.ByteString- -> ([ValuesForOneDateTime], BL.ByteString)-getComputedResults n reportingVariables header rest1- | n == 0 = ([], rest1)- | otherwise = do- let (dateTimeValue, rest2, _) = runGetState getFloat64le rest1 1- (subcatchmentValue, rest3) = splitEveryRemainder nv $ getDecimals n rest2- where n = numberOfSubcatchments header * nv- nv = (numberOfVariables . subcatchmentVariables) reportingVariables- (nodeValue, rest4) = splitEveryRemainder nv $ getDecimals n rest3- where n = numberOfNodes header * nv- nv = (numberOfVariables . nodeVariables) reportingVariables- (linkValue, rest5) = splitEveryRemainder nv $ getDecimals n rest4- where n = numberOfLinks header * nv- nv = (numberOfVariables . linkVariables) reportingVariables- (systemValue, rest6) = getDecimals n rest5- where n = (numberOfVariables . systemVariables) reportingVariables- valueConstructor = ValuesForOneDateTime dateTimeValue- subcatchmentValue- nodeValue- linkValue- systemValue- appendW valueConstructor (getComputedResults (n-1) reportingVariables header rest6)+getComputedResults :: Integer -> Header -> ReportingVariables -> Get ComputedResult+getComputedResults n header report = ComputedResult <$> replicateM (fromInteger n) (getResults header report)++getValues :: Integer -> Get [Float]+getValues n = replicateM (fromInteger n) getFloat32le++getSplitValues :: Integer -> Integer -> Get [[Float]]+getSplitValues n nv = chunksOf (fromInteger nv) <$> replicateM (fromInteger n) getFloat32le getClosingRecords :: Get ClosingRecord getClosingRecords = ClosingRecord <$> a