git.iko.soy/text
on ryan-jsstring-inline help sign in
text/scripts/CaseFolding.hs
46 lines 1.4 kB history raw
1-- This script processes the following source file:
2--
3-- http://unicode.org/Public/UNIDATA/CaseFolding.txt
5module CaseFolding
6 (
7 CaseFolding(..)
8 , Fold(..)
9 , parseCF
10 , mapCF
11 ) where
13import Arsec
15data Fold = Fold {
16 code :: Char
17 , status :: Char
18 , mapping :: [Char]
19 , name :: String
20 } deriving (Eq, Ord, Show)
22data CaseFolding = CF { cfComments :: [Comment], cfFolding :: [Fold] }
23 deriving (Show)
25entries :: Parser CaseFolding
26entries = CF <$> many comment <*> many (entry <* many comment)
27 where
28 entry = Fold <$> unichar <* semi
29 <*> oneOf "CFST" <* semi
30 <*> unichars
31 <*> (string "# " *> manyTill anyToken (char '\n'))
33parseCF :: FilePath -> IO (Either ParseError CaseFolding)
34parseCF name = parse entries name <$> readFile name
36mapCF :: CaseFolding -> [String]
37mapCF (CF _ ms) = typ ++ (map nice . filter p $ ms) ++ [last]
38 where
39 typ = ["foldMapping :: forall s. Char -> s -> Step (CC s) Char"
40 ,"{-# NOINLINE foldMapping #-}"]
41 last = "foldMapping c s = Yield (toLower c) (CC s '\\0' '\\0')"
42 nice c = "-- " ++ name c ++ "\n" ++
43 "foldMapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"
44 where [x,y,z] = (map showC . take 3) (mapping c ++ repeat '\0')
45 p f = status f `elem` "CF" &&
46 mapping f /= [toLower (code f)]