{-# 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))