85 lines
1.9 KiB
Haskell
85 lines
1.9 KiB
Haskell
|
{-# LANGUAGE OverloadedStrings #-}
|
||
|
|
import Data.Text (Text)
|
||
|
|
import qualified Data.Text as Text
|
||
|
|
|
||
|
|
isConsonant :: Char -> Bool
|
||
|
|
isConsonant = flip elem ("BCDFGHJKLMNPQRSTVWXYZ" :: String)
|
||
|
|
|
||
|
|
isVowel :: Char -> Bool
|
||
|
|
isVowel = flip elem ("AEIOU" :: String)
|
||
|
|
|
||
|
|
serialize :: Text -> Text
|
||
|
|
serialize =
|
||
|
|
Text.filter (\c -> isConsonant c || isVowel c) .
|
||
|
|
Text.replace "Ä" "AE" .
|
||
|
|
Text.replace "Ö" "OE" .
|
||
|
|
Text.replace "Ü" "UE" .
|
||
|
|
Text.replace "ß" "SS" . Text.replace "SCH" "Y" . Text.toUpper
|
||
|
|
|
||
|
|
data Person =
|
||
|
|
Person
|
||
|
|
{ lastName :: Text
|
||
|
|
, firstName :: Text
|
||
|
|
, dateOfBirth :: (Int, Int, Int)
|
||
|
|
}
|
||
|
|
|
||
|
|
serializeName :: Text -> Text
|
||
|
|
serializeName n =
|
||
|
|
Text.pack $
|
||
|
|
take 4 $ filter isConsonant n' <> reverse (filter isVowel n') <> repeat 'X'
|
||
|
|
where
|
||
|
|
n' = Text.unpack $ serialize n
|
||
|
|
|
||
|
|
etin :: Person -> Text
|
||
|
|
etin (Person last first (y, m, d)) =
|
||
|
|
let etin' =
|
||
|
|
serializeName last <> serializeName first <> Text.pack (last2 (show y)) <>
|
||
|
|
Text.singleton (encode (m - 1)) <>
|
||
|
|
Text.pack (fill0 (show d))
|
||
|
|
in etin' <> Text.singleton (encode $ checksum $ Text.unpack etin')
|
||
|
|
where
|
||
|
|
last2 = until (\x -> length x == 2) tail
|
||
|
|
fill0 = until (\x -> length x == 2) ('0' :)
|
||
|
|
encode = (!!) ['A' .. 'Z']
|
||
|
|
checksum x = sum (zipWith value x (cycle [False, True])) `mod` 26
|
||
|
|
|
||
|
|
value :: Char -> Bool -> Int
|
||
|
|
value x = case x of
|
||
|
|
'0' -> eo 0 1
|
||
|
|
'1' -> eo 1 0
|
||
|
|
'2' -> eo 2 5
|
||
|
|
'3' -> eo 3 7
|
||
|
|
'4' -> eo 4 9
|
||
|
|
'5' -> eo 5 13
|
||
|
|
'6' -> eo 6 15
|
||
|
|
'7' -> eo 7 17
|
||
|
|
'8' -> eo 8 19
|
||
|
|
'9' -> eo 9 21
|
||
|
|
'A' -> eo 0 1
|
||
|
|
'B' -> eo 1 0
|
||
|
|
'C' -> eo 2 5
|
||
|
|
'D' -> eo 3 7
|
||
|
|
'E' -> eo 4 9
|
||
|
|
'F' -> eo 5 13
|
||
|
|
'G' -> eo 6 15
|
||
|
|
'H' -> eo 7 17
|
||
|
|
'I' -> eo 8 19
|
||
|
|
'J' -> eo 9 21
|
||
|
|
'K' -> eo 10 2
|
||
|
|
'L' -> eo 11 4
|
||
|
|
'M' -> eo 12 18
|
||
|
|
'N' -> eo 13 20
|
||
|
|
'O' -> eo 14 11
|
||
|
|
'P' -> eo 15 3
|
||
|
|
'Q' -> eo 16 6
|
||
|
|
'R' -> eo 17 8
|
||
|
|
'S' -> eo 18 12
|
||
|
|
'T' -> eo 19 14
|
||
|
|
'U' -> eo 20 16
|
||
|
|
'V' -> eo 21 10
|
||
|
|
'W' -> eo 22 22
|
||
|
|
'X' -> eo 23 23
|
||
|
|
'Y' -> eo 24 24
|
||
|
|
'Z' -> eo 25 25
|
||
|
|
where eo e o b = if b then e else o
|