{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE MultiWayIf        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

module Util where

import qualified Data.ByteString.Lazy as LB
import           Data.Char
import           Data.Csv             hiding (lookup)
import           Data.Function        ((&))
import           Data.Functor         ((<&>))
import           Data.FuzzySet.Simple
import           Data.List            hiding (find)
import           Data.Map             (Map)
import qualified Data.Map             as M
import           Data.Ord
import           Data.Text            (Text)
import qualified Data.Text            as T
import           Data.Tuple           (swap)
import           Data.Vector          (Vector)
import qualified Data.Vector          as V
import           Text.FuzzyFind       (Alignment (score), bestMatch)


data MatchResult a b
 = Exact a
 | Fuzzy b
 | None
 deriving Show

data StaticAppData = StaticAppData
  { ril100map    :: DoubleMap Ril100 Text
  , leitpunktMap :: DoubleMap Ril100 Text
  , ril100set    :: FuzzySet
  }

data DoubleMap code long = DoubleMap
  { there :: Map code long
  , back  :: Map long code
  }

findStationName :: T.Text -> FuzzySet -> MatchResult (Double, Text) (Double, Text)
findStationName query set = case sorted of
  [exact] -> Exact exact
  _ -> case maybeHbf of
    station:_ -> Fuzzy station
    _ -> case results of
      station:_ -> Fuzzy station
      _         -> None
  where
    sorted = results
     & fmap (\(_, match) -> (fromIntegral . maybe 0 score . bestMatch (T.unpack query) $ T.unpack match, match))
     & sortOn (Down . fst)
    results = find query set
    maybeHbf = filter (T.isInfixOf "Hbf" . snd) sorted

newtype Ril100 = Ril100 { unRil100 :: Text }
  deriving (Eq, Ord, Show)


lookupCode :: Ord code => code -> DoubleMap code long -> Maybe long
lookupCode code maps = M.lookup code (there maps)
lookupName :: Ord long => long -> DoubleMap code long -> Maybe code
lookupName name maps = M.lookup name (back maps)

mkDoubleMap :: (Ord code, Ord long) => Vector (code, long) -> DoubleMap code long
mkDoubleMap tuplesvec =  DoubleMap (M.fromList tuples) (M.fromList (fmap swap tuples))
  where tuples = V.toList tuplesvec

readBetriebsstellen :: IO (V.Vector [Text])
readBetriebsstellen = do
  Right (x :: V.Vector [Text]) <-
    LB.readFile "data/DBNetz-Betriebsstellenverzeichnis-Stand2021-10.csv"
    <&> decodeWith csvOptions HasHeader
    <&> (fmap . fmap . fmap) (T.replace "�" "ü")
  return x

readLeitpunktMap :: IO (DoubleMap Ril100 Text)
readLeitpunktMap = do
  Right (leitpunkte :: V.Vector [Text]) <-
    LB.readFile "data/leitpunkte.csv"
    <&> decodeWith csvOptions HasHeader
  return $ mkDoubleMap $ fmap (\line -> (Ril100 (line !! 2), line !! 0)) leitpunkte

readData :: IO StaticAppData
readData = do
  putStrLn "Parsing input .csv files…"
  betriebsstellen <- readBetriebsstellen
  leitpunktMap    <- readLeitpunktMap
  putStrLn "Static data ready."

  let betriebsstellenFiltered = betriebsstellen
       & V.filter (\line -> line !! 4 `notElem` ["BUSH", "LGR", "ÜST", "BFT", "ABZW", "BK", "AWAN", "ANST", "LGR"])
  let ril100set = addMany (V.toList (V.map (!! 2) betriebsstellenFiltered)) (emptySet 5 6 False)
  let ril100map = mkDoubleMap $ fmap (\line -> (Ril100 (line !! 1), line !! 2)) betriebsstellen

  return StaticAppData{..}

csvOptions, tsvOptions :: DecodeOptions
csvOptions = defaultDecodeOptions { decDelimiter = fromIntegral (ord ';') }
tsvOptions = defaultDecodeOptions { decDelimiter = fromIntegral (ord '\t') }