1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
{-# 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') }
|
