vdv 452: apply some correctionsvdv452

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