diff options
| -rw-r--r-- | vdv-protocol.cabal | 6 | ||||
| -rw-r--r-- | vdv-server/Example452.hs | 44 | ||||
| -rw-r--r-- | vdv-server/VDV451.hs | 18 | ||||
| -rw-r--r-- | vdv-server/VDV452.hs | 95 |
4 files changed, 102 insertions, 61 deletions
diff --git a/vdv-protocol.cabal b/vdv-protocol.cabal index 8518916..a055861 100644 --- a/vdv-protocol.cabal +++ b/vdv-protocol.cabal @@ -22,7 +22,7 @@ maintainer: stuebinm@disroot.org extra-source-files: CHANGELOG.md library - build-depends: base ^>=4.14.3.0 + build-depends: base ^>=4.15.0 , servant , servant-server , servant-client @@ -57,7 +57,7 @@ executable vdv-testclient -- LANGUAGE extensions used by modules in this package. -- other-extensions: - build-depends: base ^>=4.14.3.0 + build-depends: base ^>=4.15.0 , vdv-protocol hs-source-dirs: vdv-testclient default-language: Haskell2010 @@ -70,7 +70,7 @@ executable vdv-testserver -- LANGUAGE extensions used by modules in this package. -- other-extensions: - build-depends: base ^>=4.14.3.0 + build-depends: base ^>=4.15 , vdv-protocol hs-source-dirs: vdv-testserver default-language: Haskell2010 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 |