diff options
Diffstat (limited to '')
| -rw-r--r-- | vdv-server/VDV451.hs | 38 | ||||
| -rw-r--r-- | vdv-server/VDV452.hs | 8 | 
2 files changed, 32 insertions, 14 deletions
| 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 | 
