diff options
| -rw-r--r-- | vdv-protocol.cabal | 1 | ||||
| -rw-r--r-- | vdv-server/VDV451.hs | 38 | ||||
| -rw-r--r-- | vdv-server/VDV452.hs | 8 |
3 files changed, 33 insertions, 14 deletions
diff --git a/vdv-protocol.cabal b/vdv-protocol.cabal index c8fa3b8..7feaa13 100644 --- a/vdv-protocol.cabal +++ b/vdv-protocol.cabal @@ -40,6 +40,7 @@ library , async , bytestring , vector + , zip-archive hs-source-dirs: vdv-server default-language: Haskell2010 exposed-modules: VDV453.Kommunikationsschicht diff --git a/vdv-server/VDV451.hs b/vdv-server/VDV451.hs index b962208..8e8a841 100644 --- a/vdv-server/VDV451.hs +++ b/vdv-server/VDV451.hs @@ -21,11 +21,13 @@ import qualified Data.Vector as V import qualified Data.ByteString.Char8 as C8 import GHC.Base (ord) import Fmt ((+|),(|+)) -import Data.Time (Day, toGregorian, UTCTime (..), DiffTime, formatTime, defaultTimeLocale) +import Data.Time (Day, toGregorian, UTCTime (..), DiffTime, formatTime, defaultTimeLocale, isLeapYear) import Data.String (IsString) import GHC.Exts (IsString(..)) import Data.Time.Format.ISO8601 (formatShow) import Data.Data (Proxy (..)) +import Data.Time.Calendar.MonthDay (monthAndDayToDayOfYear) +import Codec.Archive.Zip (toEntry, emptyArchive, addEntryToArchive, Archive) class ÖPNVEncode a where encode :: a -> ByteString @@ -39,7 +41,7 @@ instance ÖPNVEncode Text where then C8.pack bytes else error ("invalid unicode in iso8859-1 string: "+|unsafe|+".") where (safe, unsafe) = T.span (\c -> ord c <= 0xFF) text - bytes = "\"" <> (concatMap escape (T.unpack safe)) <> "\"" + bytes = "\"" <> concatMap escape (T.unpack safe) <> "\"" escape c = case c of '"' -> "\"\"" a -> [a] @@ -86,7 +88,7 @@ instance ÖPNVEncode Longitude where -- | this isn't specified anywhere, but seems to be what VDV 452 implies instance ÖPNVEncode a => ÖPNVEncode (Maybe a) where encode (Just a) = encode a - encode Nothing = "NULL" + encode Nothing = "0" instance ÖPNVEncode Bool where encode False = "0" @@ -136,9 +138,6 @@ tableInfo proxy = fmap (\(n, ty, _) -> (n, ty)) (tableSchema proxy) data Feld = forall a. ÖPNVEncode a => F a | Raw ByteString -instance IsString Feld where - fromString = Raw . C8.pack - data ÖPNVOptions = ÖPNVOptions { öpnvSource :: Text , öpnvProgramVersion :: Text @@ -148,20 +147,20 @@ data ÖPNVOptions = ÖPNVOptions öpnvSchnittstellenDaten :: forall a. ÖPNVDatum a => ÖPNVOptions -> UTCTime -> Vector a -> LB.ByteString öpnvSchnittstellenDaten ÖPNVOptions{..} time rows = LB.intercalate "\n" $ fmap mkRow - [ [F MOD, "DD.MM.YYYY", "HH:MM:SS", "free"] + [ [F MOD, Raw "DD.MM.YYYY", Raw "HH:MM:SS", Raw "free"] , [F SRC, F öpnvSource, F (utctDay time), F (utctDayTime time) ] , [F CHS, F ("ISO8859-1" :: Text)] , [F VER, F öpnvProgramVersion] , [F IFV, F ("1.0" :: Text)] , [F DVE, F öpnvDataVersion] - , [F FFT, ""] -- this one is probably not needed? + , [F FFT, F ("" :: Text)] -- this one is probably not needed? , [F TBL, Raw (tableName (Proxy @a))] , F ATR : fmap Raw colNames , F FRM : fmap F colTypes] - <> (fmap (mkRow . ((:) (F REC)) . encodeRow) (V.toList rows)) + <> fmap (mkRow . (:) (F REC) . encodeRow) (V.toList rows) <> fmap mkRow [ [F END, F (length rows)] - , [F EOF, "1"]] + , [F EOF, Raw "1"]] where mkRow :: [Feld] -> LB.ByteString mkRow = LB.fromStrict @@ -169,6 +168,25 @@ data ÖPNVOptions = ÖPNVOptions . fmap (\case { (F a) -> encode a; Raw a -> a }) (colNames, colTypes) = unzip (tableInfo (Proxy @a)) +öpnvSchnittstellenDatei :: forall a. ÖPNVDatum a => ÖPNVOptions -> UTCTime -> Vector a -> (FilePath, LB.ByteString) +öpnvSchnittstellenDatei options time rows = (filename, content) + where content = öpnvSchnittstellenDaten options time rows + filename = "i"+|tableNumber (Proxy @a)|+""+|dayOfYearPadded|+"0.x10" + dayOfYearPadded = + replicate (3 - length (show dayOfYear)) '0' <> show dayOfYear + (year, month, day) = toGregorian (utctDay time) + dayOfYear = monthAndDayToDayOfYear + (isLeapYear year) month day + +data ÖPNVTable = forall a. ÖPNVDatum a => ÖPNVTable (Vector a) + +öpnvSchnittstellenZip :: ÖPNVOptions -> UTCTime -> [ÖPNVTable] -> Archive +öpnvSchnittstellenZip options time tables = + foldl addTableEntry emptyArchive tables + where unixt = 0 -- nominalDiffTimeToSeconds (utcTimeToPOSIXSeconds time) + addTableEntry archive (ÖPNVTable t) = + addEntryToArchive (toEntry filename unixt content) archive + where (filename,content) = öpnvSchnittstellenDatei options time t crop n thing = if T.length shown < n then T.replicate (n - T.length shown) "0" <> shown diff --git a/vdv-server/VDV452.hs b/vdv-server/VDV452.hs index 38e6a8d..d1b315f 100644 --- a/vdv-server/VDV452.hs +++ b/vdv-server/VDV452.hs @@ -266,7 +266,7 @@ instance ÖPNVDatum ZulVerkehsbetrieb where -- | 333 data MengeBereich = MengeBereich { mengebereichBasisVersion :: Int - , mengebereichBereichNr :: Text + , mengebereichBereichNr :: Int , mengebereichStrBereich :: Text , mengebereichBereichText :: Text } @@ -440,7 +440,7 @@ data MengeFgr = MengeFgr { mengefgrBasisVersion :: Int , mengefgrFgrNr :: Int , mengefgrText :: Text - , mengefgrTypNr :: Int + -- , mengefgrTypNr :: Int } instance ÖPNVDatum MengeFgr where @@ -450,7 +450,7 @@ instance ÖPNVDatum MengeFgr where [ ("BASIS_VERSION", ÖNum 9, F . mengefgrBasisVersion) , ("FGR_NR", ÖNum 9, F . mengefgrFgrNr) , ("FGR_TEXT", ÖChar 40, F . mengefgrText) - , ("FGR_TYP_NR", ÖNum 3, F . mengefgrTypNr) + -- , ("FGR_TYP_NR", ÖNum 3, F . mengefgrTypNr) ] --- | 999: Angabe von Haltezeiten je Fahrzeitgruppe und Ort @@ -762,7 +762,7 @@ data RecFrt = RecFrt , recfrtStart :: Int , recfrtLiNr :: Int , recfrtTagesartNr :: Int - , recfrtLiKuNr :: Int + , recfrtLiKuNr :: Maybe Int , recfrtFahrtartNr :: Fahrtart , recfrtFgrNr :: Int , recfrtStrLiVar :: Text |