VDV 452 fixes & utilities

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