summaryrefslogtreecommitdiff
path: root/vdv-server
diff options
context:
space:
mode:
Diffstat (limited to 'vdv-server')
-rw-r--r--vdv-server/Example452.hs44
-rw-r--r--vdv-server/VDV451.hs18
-rw-r--r--vdv-server/VDV452.hs95
3 files changed, 99 insertions, 58 deletions
diff --git a/vdv-server/Example452.hs b/vdv-server/Example452.hs
index 51d4a46..41bee99 100644
--- a/vdv-server/Example452.hs
+++ b/vdv-server/Example452.hs
@@ -7,11 +7,20 @@ import VDV451 (Latitude(..), Longitude(..), ÖPNVOptions(..), ÖPNVTable(..), ö
import VDV452
import Data.Vector (Vector)
import Data.Time (Day, fromGregorian, getCurrentTime, utctDay)
-import Codec.Archive.Zip (Archive)
+import Codec.Archive.Zip (Archive, fromArchive)
+import qualified Data.ByteString.Lazy as LB
-- TODO: RecHp, MengeFztTyp, OrtHztf, RecUeb, UebFzt, RecUmlauf
+-- we only have one of these.
+-- TODO: add newtypes for the other relations?
+bereich :: BereichNr
+bereich = BereichNr 1
+livar = LineVariant "itb"
+
+pa1 = OrtNr (OrtRefOrt 10) (SteigNr 1)
+fr1 = OrtNr (OrtRefOrt 11) (SteigNr 1)
t993 :: Day -> Vector BasisVerGueltigkeit
t993 day = [ BasisVerGueltigkeit day 1 ]
@@ -28,13 +37,13 @@ t997 :: Vector MengeOrtTyp
t997 = [ MengeOrtTyp 1 OrtHaltestelle "Haltestelle" ]
t253 :: Vector RecOrt
-t253 = [ RecOrt 1 OnrHaltepunkt 10 "Passau Hbf" 10 8000298 "de:09262:156" 0 OrtHaltestelle Nothing "PA" "Passau Hbf" Nothing (Just $ Longitude 13.450776) (Just $ Latitude 48.573632) Nothing Nothing
- , RecOrt 1 OnrHaltepunkt 11 "Freyung Bf" 11 8002094 "de:09272:4851" 1 OrtHaltestelle Nothing "FR" "Freyung" Nothing (Just $ Longitude 13.548351) (Just $ Latitude 48.802843) Nothing Nothing
+t253 = [ RecOrt 1 OnrHaltepunkt pa1 "Passau Hbf" 10 8000298 (DHID "de:09262:156:0" (steigNr pa1)) (ortRef pa1) OrtHaltestelle Nothing "PA" "Passau Hbf" Nothing (Just $ Longitude 13.450776) (Just $ Latitude 48.573632) Nothing Nothing
+ , RecOrt 1 OnrHaltepunkt fr1 "Freyung Bf" 11 8002094 (DHID "de:09272:4851:0" (steigNr fr1)) (ortRef fr1) OrtHaltestelle Nothing "FR" "Freyung" Nothing (Just $ Longitude 13.548351) (Just $ Latitude 48.802843) Nothing Nothing
]
t229 :: Vector RecHp
-t229 = [ RecHp 1 OrtHaltestelle 10 10 "Passau Hbf"
- , RecHp 1 OrtHaltestelle 11 11 "Freyung Bf"]
+t229 = [ RecHp 1 OrtHaltestelle pa1 (steigNr pa1) "Passau Hbf"
+ , RecHp 1 OrtHaltestelle fr1 (steigNr fr1) "Freyung Bf"]
t293 :: Vector MengeFzgTyp
t293 = [ MengeFzgTyp 1 1 0 0 0 0 80 30 "irgendein Fahrzeug" 1 "dings" Nothing Nothing Nothing ]
@@ -50,7 +59,7 @@ t290 = [ MengeTagesart 1 1 "normaler Betriebstag"
, MengeTagesart 1 2 "Sonderfahrt Dezember"]
t348 :: Vector Firmenkalender
-t348 = [ Firmenkalender 1 (fromGregorian 3 12 2022) "Sonderfahrt Dezember" 2 ]
+t348 = [ Firmenkalender 1 (fromGregorian 2022 12 3) "Sonderfahrt Dezember" 2 ]
t222 :: Vector MengeFgr
t222 = [ MengeFgr 1 1 "gibt nur eine" ]
@@ -59,36 +68,36 @@ t332 :: Vector MengeFahrtart
t332 = [ MengeFahrtart 1 Normalfahrt "Normal"]
t333 :: Vector MengeBereich
-t333 = [ MengeBereich 1 1 "bahn" "die ilztalbahn fährt bahn, sonst nix" ]
+t333 = [ MengeBereich 1 bereich "bahn" "die ilztalbahn fährt bahn, sonst nix" ]
-- let's just say there's 30km between the stations
t299 :: Vector RecSel
-t299 = [ RecSel 1 1 OnrHaltepunkt 10 11 OrtHaltestelle 30000 ]
+t299 = [ RecSel 1 bereich OnrHaltepunkt pa1 fr1 OrtHaltestelle 30000 ]
-- let's just say there's an hour between the two stations
t282 :: Vector SelFztFeld
-t282 = [ SelFztFeld 1 1 1 OrtHaltestelle 10 11 OrtHaltestelle 3600 ]
+t282 = [ SelFztFeld 1 bereich 1 OrtHaltestelle pa1 fr1 OrtHaltestelle 3600 ]
t999 :: Vector OrtHztf
-t999 = [ OrtHztf 1 1 OrtHaltestelle 10 60
- , OrtHztf 1 1 OrtHaltestelle 11 60
+t999 = [ OrtHztf 1 1 OrtHaltestelle pa1 60
+ , OrtHztf 1 1 OrtHaltestelle fr1 60
]
-- zwei halte für eine fahrt auf linie 13
t246 :: Vector LidVerlauf
-t246 = [ LidVerlauf 1 1 56446 "" OrtHaltestelle 10 1 Nothing 0 True True False False False False
- , LidVerlauf 1 2 56446 "" OrtHaltestelle 11 2 Nothing 0 True True False False False False]
+t246 = [ LidVerlauf 1 1 56446 livar OrtHaltestelle pa1 1 Nothing 0 True True False False False False
+ , LidVerlauf 1 2 56446 livar OrtHaltestelle fr1 2 Nothing 0 True True False False False False]
-- keine ahnung was die routennummer soll, steht jetzt auf 0
t226 :: Vector RecLid
-t226 = [ RecLid 1 56446 "itb" 1 0 0 "itb" "Ilztalbahn" Normalfahrt Nothing "Ilztalbahn" ]
+t226 = [ RecLid 1 56446 livar 1 1 bereich "itb" "Ilztalbahn" Normalfahrt Nothing "Ilztalbahn" ]
t715 :: Vector RecFrt
-t715 = [ RecFrt 1 1 28800 56446 2 Nothing Normalfahrt 1 "" Nothing 56446 False False "P 56446" 0 ]
+t715 = [ RecFrt 1 1 28800 56446 2 Nothing Normalfahrt 1 livar Nothing 56446 False False "P 56446" 0 ]
mkArchive :: IO Archive
@@ -120,3 +129,8 @@ mkArchive = do
, ÖPNVTable t226
, ÖPNVTable t715
]
+
+writeArchive :: IO ()
+writeArchive = do
+ archive <- mkArchive
+ LB.writeFile "example.zip" (fromArchive archive)
diff --git a/vdv-server/VDV451.hs b/vdv-server/VDV451.hs
index 8e8a841..c1d0842 100644
--- a/vdv-server/VDV451.hs
+++ b/vdv-server/VDV451.hs
@@ -28,6 +28,7 @@ import Data.Time.Format.ISO8601 (formatShow)
import Data.Data (Proxy (..))
import Data.Time.Calendar.MonthDay (monthAndDayToDayOfYear)
import Codec.Archive.Zip (toEntry, emptyArchive, addEntryToArchive, Archive)
+import Debug.Trace (trace)
class ÖPNVEncode a where
encode :: a -> ByteString
@@ -47,19 +48,20 @@ instance ÖPNVEncode Text where
a -> [a]
instance ÖPNVEncode Day where
- encode day = "\""+|crop 2 d|+"."+|crop 2 m|+"."+|crop 4 y|+"\""
+ encode day = encode $ (fromInteger y*10000) + m*100 + d
where (y,m,d) = toGregorian day
+
-- | for things which can be encoded as either string or number,
--- this module defaults to strings. Add this newtype to the schema
--- to make things encode as numbers instead.
-newtype AsNumber a = AsNumber a
+-- this module defaults to numbers. Add this newtype to the schema
+-- to make things encode as strings instead.
+newtype AsText a = AsText a
-instance ÖPNVEncode (AsNumber Day) where
- encode (AsNumber day) =
- encode (d*1000000 + m*10000 + (fromInteger y `mod` 10000))
+instance ÖPNVEncode (AsText Day) where
+ encode (AsText day) = "\""+|crop 2 d|+"."+|crop 2 m|+"."+|crop 4 y|+"\""
where (y,m,d) = toGregorian day
+
instance ÖPNVEncode DiffTime where
encode = C8.pack . formatTime defaultTimeLocale "\"%2H:%2M:%2S\""
@@ -148,7 +150,7 @@ 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, Raw "DD.MM.YYYY", Raw "HH:MM:SS", Raw "free"]
- , [F SRC, F öpnvSource, F (utctDay time), F (utctDayTime time) ]
+ , [F SRC, F öpnvSource, (F . AsText . utctDay) time, F (utctDayTime time) ]
, [F CHS, F ("ISO8859-1" :: Text)]
, [F VER, F öpnvProgramVersion]
, [F IFV, F ("1.0" :: Text)]
diff --git a/vdv-server/VDV452.hs b/vdv-server/VDV452.hs
index e8840ce..0d24934 100644
--- a/vdv-server/VDV452.hs
+++ b/vdv-server/VDV452.hs
@@ -1,16 +1,41 @@
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- |
module VDV452 where
+
+import qualified Data.Text as T
+import Data.ByteString (ByteString)
import Data.Time (Day)
import Data.Text (Text)
-import VDV451 (ÖPNVEncode (encode), ÖPNVDatum (..), ÖPNVType (..), Feld (F), AsNumber (AsNumber), Longitude, Latitude)
-import Data.ByteString (ByteString)
-
+import VDV451 (ÖPNVEncode (encode), ÖPNVDatum (..), ÖPNVType (..), Feld (F), Longitude, Latitude)
+
+newtype BereichNr = BereichNr Int
+ deriving newtype ÖPNVEncode
+newtype LineVariant = LineVariant Text
+ deriving newtype ÖPNVEncode
+newtype SteigNr = SteigNr Int
+ deriving newtype ÖPNVEncode
+newtype OrtRefOrt = OrtRefOrt Int
+ deriving newtype ÖPNVEncode
+
+-- see mail correspondence with Mentz, 2023-03-06
+data OrtNr = OrtNr { ortRef :: OrtRefOrt, steigNr :: SteigNr }
+instance ÖPNVEncode OrtNr where
+ encode (OrtNr (OrtRefOrt ort) (SteigNr steig)) =
+ encode (ort * 100 + steig)
+
+-- | this should technically be in its own file VDV432.hs
+-- prefix enthält alle Felder bis Bereich-ID; SteigNr ist die Mast-ID
+-- Halteposition wird hier nicht benutzt.
+data DHID = DHID Text SteigNr
+instance ÖPNVEncode DHID where
+ encode (DHID prefix (SteigNr steig)) =
+ encode (prefix <> ":" <> (T.pack . show) steig)
-- | 993
data BasisVerGueltigkeit = BasisVerGueltigkeit
@@ -24,7 +49,7 @@ instance ÖPNVDatum BasisVerGueltigkeit where
tableName _ = "BASIS_VER_GUELTIGKEIT"
tableNumber _ = 993
tableSchema _ =
- [ ("VER_GUELTIGKEIT", ÖNum 8, F . AsNumber . basisVerGueltigkeit)
+ [ ("VER_GUELTIGKEIT", ÖNum 8, F . basisVerGueltigkeit)
, ("BASIS_VERSION", ÖNum 9, F . basisBasisVersion)]
-- | 485
@@ -136,8 +161,8 @@ instance ÖPNVDatum MengeOrtTyp where
data RecHp = RecHp
{ rechpBasisVersion :: Int
, rechpOnrTypNr :: OrtTypNr
- , rechpOrtNr :: Int
- , rechpHaltepunktNr :: Int
+ , rechpOrtNr :: OrtNr
+ , rechpHaltepunktNr :: SteigNr
, rechpZusatzInfo :: Text
}
@@ -156,7 +181,7 @@ data RecOm = RecOm
{ recomBasisVersion :: Int
, recomOnrTypNr :: OnrTypNr
-- ^ nur 3..4
- , recomOrtNr :: Int
+ , recomOrtNr :: OrtNr
, recomOrmKuerzel :: Text
, recomOrmacode :: Int
, recomOrmText :: Text
@@ -178,13 +203,13 @@ instance ÖPNVDatum RecOm where
data RecOrt = RecOrt
{ recortBasisVersion :: Int
, recortOnrTypNr :: OnrTypNr
- , recortOrtNr :: Int
+ , recortOrtNr :: OrtNr
, recortOrtName :: Text
, recortHastNrLokal :: Int
, recortHstNrNational :: Int
- , recortHstNrInternational :: Text
+ , recortHstNrInternational :: DHID
-- these only if recortOnrTypNr = 1 or 2
- , recortOrtRefOrt :: Int
+ , recortOrtRefOrt :: OrtRefOrt
, recortOrtRefOrtTyp :: OrtTypNr
, recortOrtRefOrtLangNr :: Maybe Int
, recortOrtRefOrtKuerzel :: Text
@@ -266,7 +291,7 @@ instance ÖPNVDatum ZulVerkehsbetrieb where
-- | 333
data MengeBereich = MengeBereich
{ mengebereichBasisVersion :: Int
- , mengebereichBereichNr :: Int
+ , mengebereichBereichNr :: BereichNr
, mengebereichStrBereich :: Text
, mengebereichBereichText :: Text
}
@@ -374,13 +399,13 @@ instance ÖPNVDatum RecZnr where
-- 299
data RecSel = RecSel
{ recselBasisVersion :: Int
- , recselBereichNr :: Int
+ , recselBereichNr :: BereichNr
-- ^ fremdschlüssel MangeBereich
, recselOnrTypNr :: OnrTypNr
-- ^ fremdschlüssel MengeOnrTyp
- , recselOrtNr :: Int
+ , recselOrtNr :: OrtNr
-- ^ fremdschlüssel RecOrt
- , recselSelZiel :: Int
+ , recselSelZiel :: OrtNr
, recselSelZielTyp :: OrtTypNr
, recselSelLaenge :: Int
}
@@ -404,9 +429,9 @@ instance ÖPNVDatum RecSel where
-- honestly i hope this one's optional
data RecSelZp = RecSelZp
{ recselzpBasisVersion :: Int
- , recselzpBereichNr :: Int
+ , recselzpBereichNr :: BereichNr
, recselzpOnrTypNr :: OrtTypNr
- , recselzpOrtNr :: Int
+ , recselzpOrtNr :: OrtNr
, recselzpSelZiel :: Int
, recselzpSelZielTyp :: OrtTypNr
, recselzpZpOnr :: Int
@@ -458,7 +483,7 @@ data OrtHztf = OrtHztf
{ orthztfBasisVersion :: Int
, orthztfFgrNr :: Int
, orthztfOnrTypNr :: OrtTypNr
- , orthztfOrtNr :: Int
+ , orthztfOrtNr :: OrtNr
, orthztfHpHzt :: Int
}
@@ -477,11 +502,11 @@ instance ÖPNVDatum OrtHztf where
-- nie als fremdschlüssel benutzt, ist optional
data SelFztFeld = SelFztFeld
{ selfztBasisVersion :: Int
- , selfztBereichNr :: Int
+ , selfztBereichNr :: BereichNr
, selfztFgrNr :: Int
, selfztOnrTypNr :: OrtTypNr
- , selfztOrtNr :: Int
- , selfztSelZiel :: Int
+ , selfztOrtNr :: OrtNr
+ , selfztSelZiel :: OrtNr
, selfztSelZielTyp :: OrtTypNr
, selfztSelFzt :: Int
}
@@ -503,9 +528,9 @@ instance ÖPNVDatum SelFztFeld where
-- | 225: keine ahnung, irgendwas halt
data RecUeb = RecUeb
{ recuebBasisVersion :: Int
- , recuebBereichNr :: Int
+ , recuebBereichNr :: BereichNr
, recuebOnrTypNr :: OrtTypNr
- , recuebOrtNr :: Int
+ , recuebOrtNr :: OrtNr
, recuebZielTyp :: OrtTypNr
, recuebZiel :: Int
, recuebLaenge :: Int
@@ -528,10 +553,10 @@ instance ÖPNVDatum RecUeb where
-- nirgendwo anders benutzt, ist wohl optional
data UebFzt = UebFzt
{ uebfztBasisVersion :: Int
- , uebfztBereichNr :: Int
+ , uebfztBereichNr :: BereichNr
, uebfztFgrNr :: Int
, uebfztOnrTypNr :: OrtTypNr
- , uebfztOrtNr :: Int
+ , uebfztOrtNr :: OrtNr
, uebfztZielTyp :: OrtTypNr
, uebfztZiel :: Int
, uebfztFahrzeit :: Int
@@ -601,7 +626,7 @@ data FlZoneOrt = FlZoneOrt
, flzoneTypNr :: Int
, flzoneNr :: Int
, flzoneOnrTypNr :: OnrTypNr
- , flzoneOrtNr :: Int
+ , flzoneOrtNr :: OrtNr
}
instance ÖPNVDatum FlZoneOrt where
@@ -643,10 +668,10 @@ instance ÖPNVDatum MengeFlaechenZoneTyp where
-- nirgendwo fremdschlüssel, optional
data SelFztFeldZp = SelFztFeldZp
{ selfztfeldBasisVersion :: Int
- , selfztfeldBereichNr :: Int
+ , selfztfeldBereichNr :: BereichNr
, selfztfeldFgrNr :: Int
, selfztfeldOnrTypNr :: OrtTypNr
- , selfztfeldOrtNr :: Int
+ , selfztfeldOrtNr :: OrtNr
, selfztfeldSelZiel :: Int
, selfztfeldSelZielTyp :: Int
-- this one can only be 1 or 2??
@@ -681,9 +706,9 @@ data LidVerlauf = LidVerlauf
{ verlaufBasisVersion :: Int
, verlaufLfdNr :: Int
, verlaufNr :: Int
- , verlaufStrLiVar :: Text
+ , verlaufStrLiVar :: LineVariant
, verlaufOnrTypNr :: OrtTypNr
- , verlaufOrtNr :: Int
+ , verlaufOrtNr :: OrtNr
, verlaufZnrNr :: Int
, verlaufAnrNr :: Maybe Int
, verlaufEinfangbereich :: Int
@@ -720,11 +745,11 @@ instance ÖPNVDatum LidVerlauf where
data RecLid = RecLid
{ reclidBasisVersion :: Int
, reclidLiNr :: Int
- , reclidStrLiVar :: Text
+ , reclidStrLiVar :: LineVariant
, reclidRoutenNr :: Int
, reclidLiRiNr :: Int
-- ^ 1..2
- , reclidBereichNr :: Int
+ , reclidBereichNr :: BereichNr
, reclidLiKuerzel :: Text
, reclidLidname :: Text
, reclidRoutenArt :: Fahrtart
@@ -763,7 +788,7 @@ data RecFrt = RecFrt
, recfrtLiKuNr :: Maybe Int
, recfrtFahrtartNr :: Fahrtart
, recfrtFgrNr :: Int
- , recfrtStrLiVar :: Text
+ , recfrtStrLiVar :: LineVariant
, recfrtUmUid :: Maybe Int
, recfrtZugNr :: Int
, recfrtDurchbiFrtStart :: Bool
@@ -799,7 +824,7 @@ data RecFrtHzt = RecFrtHzt
{ recfrthztBasisVersion :: Int
, recfrthztFid :: Int
, recfrthztOnrTypNr :: OrtTypNr
- , recfrthztOrtNr :: Int
+ , recfrthztOrtNr :: OrtNr
, recfrthztZeit :: Int
}
@@ -855,7 +880,7 @@ data Einzelanschluss = Einzelanschluss
, einzelZubLiRiNr :: Richtung
, einzelZubOrtRefOrt :: Int
, einzelZubOnrTypNr :: Maybe OnrTypNr
- , einzelZubOrtNr :: Maybe Int
+ , einzelZubOrtNr :: Maybe OrtNr
, einzelVonOrtRefOrt :: Maybe Int
, einzelLinienId :: Text
, einzelRichtungsId :: Text
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-31 21:45:35 +0000