misc: add more scripts

misc/ETIN.hs

@@ -0,0 +1,84 @@
+{-# 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