diff options
Diffstat (limited to '')
| -rw-r--r-- | vdv-protocol.cabal | 3 | ||||
| -rw-r--r-- | vdv-server/VDV451.hs | 147 |
2 files changed, 150 insertions, 0 deletions
diff --git a/vdv-protocol.cabal b/vdv-protocol.cabal index 822eb94..43acd14 100644 --- a/vdv-protocol.cabal +++ b/vdv-protocol.cabal @@ -38,9 +38,12 @@ library , containers , stm , async + , bytestring + , vector hs-source-dirs: vdv-server default-language: Haskell2010 exposed-modules: VDV453.Kommunikationsschicht + , VDV451 executable vdv-testclient diff --git a/vdv-server/VDV451.hs b/vdv-server/VDV451.hs new file mode 100644 index 0000000..1d56e1c --- /dev/null +++ b/vdv-server/VDV451.hs @@ -0,0 +1,147 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE FlexibleInstances #-} + + +module VDV451 where + +import qualified Data.ByteString.Lazy as LB +import qualified Data.ByteString as SB +import Data.ByteString (ByteString) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Vector (Vector) +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.String (IsString) +import GHC.Exts (IsString(..)) +import Data.Time.Format.ISO8601 (formatShow) +import Data.Data (Proxy (..)) + +class ÖPNVEncode a where + encode :: a -> ByteString + default encode :: Show a => a -> ByteString + encode = C8.pack . show + + +instance ÖPNVEncode Text where + -- hopefully not too naive iso8859-1 encoding + encode text = if T.null unsafe + 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)) <> "\"" + escape c = case c of + '"' -> "\"\"" + a -> [a] + +instance ÖPNVEncode Day where + encode day = "\""+|crop 2 d|+"."+|crop 2 m|+"."+|crop 4 y|+"\"" + where (y,m,d) = toGregorian day + crop n thing = if T.length shown < n + then T.replicate (n - T.length shown) "0" <> shown + else T.takeEnd n shown + where shown = T.pack $ show thing + +-- | 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 + +instance ÖPNVEncode (AsNumber Day) where + encode (AsNumber day) = + encode (d*1000000 + m*10000 + (fromInteger y `mod` 10000)) + where (y,m,d) = toGregorian day + +instance ÖPNVEncode DiffTime where + encode = C8.pack . formatTime defaultTimeLocale "\"%2H:%2M:%2S\"" + +instance ÖPNVEncode Int +instance ÖPNVEncode Integer + + + +data ÖPNVBefehl = + MOD | SRC | CHS | VER | IFV + | DVE | FFT | TBL | ATR | FRM + | REC | END | EOF | COM + deriving Show + +instance ÖPNVEncode ÖPNVBefehl where + encode MOD = "mod" + encode SRC = "src" + encode CHS = "chs" + encode VER = "ver" + encode IFV = "ifv" + encode DVE = "dve" + encode FFT = "fft" + encode TBL = "tbl" + encode ATR = "atr" + encode FRM = "frm" + encode REC = "rec" + encode END = "end" + encode EOF = "eof" + encode COM = "com" + +data ÖPNVType = + ÖChar Int | ÖNum Int + deriving Show + +instance ÖPNVEncode ÖPNVType where + encode (ÖChar n) = "char["+|n|+"]" + encode (ÖNum n) = "num["+|n|+".0]" + +class ÖPNVDatum a where + tableName :: Proxy a -> ByteString + tableSchema :: Proxy a -> [(ByteString, ÖPNVType, a -> Feld)] + +encodeRow :: forall a. ÖPNVDatum a => a -> [Feld] +encodeRow a = fmap (\f -> f a) accessors + where accessors = fmap (\(_,_,a) -> a) (tableSchema (Proxy @a)) + +tableInfo :: ÖPNVDatum a => Proxy a -> [(ByteString, ÖPNVType)] +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 + , öpnvDataVersion :: Text + } deriving Show + + +ö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 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 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 END, F (length rows)] + , [F EOF, "1"]] + where + mkRow :: [Feld] -> LB.ByteString + mkRow = LB.fromStrict + . C8.intercalate "; " + . fmap (\case { (F a) -> encode a; Raw a -> a }) + (colNames, colTypes) = unzip (tableInfo (Proxy @a)) |