summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--vdv-protocol.cabal1
-rw-r--r--vdv-server/VDV451.hs38
-rw-r--r--vdv-server/VDV452.hs8
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