+
−{-# LANGUAGE OverloadedStrings #-}
+
−module Confuse where
+
−
+
−import Numeric
+
−import Data.Char
+
−import Control.Monad
+
−import qualified Data.ByteString as B
+
−import qualified Data.ByteString.UTF8 as UTF8
+
−import qualified Data.Map as Map
+
−
+
−hx :: [Char] -> String
+
−hx cs = let ch = (chr . fst . last . readHex $ cs) in
+
−            case ch of
+
−                 '\'' -> "''"
+
−                 '\\' -> "\\\\"
+
−                 c -> c : []
+
−
+
−conv :: String -> B.ByteString
+
−conv s = B.concat ["('", UTF8.fromString i, "', '", UTF8.fromString r, "')"]
+
−    where
+
−        i :: String
+
−        i = hx s
+
−        r :: String
+
−        r = concatMap hx . words . takeWhile ((/=) ';') . tail $ dropWhile ((/=) '\t') s
+
−
+
−convRules :: (B.ByteString, [B.ByteString]) -> B.ByteString
+
−convRules (a, b) = B.concat ["<reset>", u a, "</reset>\n<s>", B.concat $ map u b, "</s>"]
+
−    where
+
−        u a = B.concat ["\\","u",a]
+
−
+
−toPair :: String -> (B.ByteString, [B.ByteString])
+
−toPair s = (UTF8.fromString $ takeWhile isHexDigit s, map UTF8.fromString . words . takeWhile ((/=) ';') . tail $ dropWhile ((/=) '\t') s)
+
−
+
−
+
−main = do
+
−    ll <- liftM (filter (isHexDigit . head) . filter (not . null) . lines) $ readFile "confusables.txt"
+
−    B.writeFile "rules.txt" . B.intercalate "\n" . map convRules . Map.toList . Map.fromList . filter notTooLong . filter fits16bit . map toPair $ ll
+
−    where
+
−        notTooLong = (>) 6 . length . snd
+
−        fits16bit (a, b) = let f = (>) 5 . B.length in all f $ a:b
+
−