diff options
Diffstat (limited to 'vdv-server/VDV451.hs')
-rw-r--r-- | vdv-server/VDV451.hs | 38 |
1 files changed, 28 insertions, 10 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 |