git.iko.soy/text
on master help sign in
Record leading comments from Unicode data files

This lets us easily see which version of Unicode we're up to date with.

commitf0437f2bf93a6794928ebd9574513cefb5fb81a2 authorBryan O'Sullivan <bos@serpentine.com> dateSat 30 Nov 2013, 21:30 (13 years ago) parent25f65e6
4 files changed+34−16
compare with master
unifiedsplit
scripts/Arsec.hs+5−2 scripts/CaseFolding.hs+10−6 scripts/CaseMapping.hs+7−2 scripts/SpecialCasing.hs+12−6
scripts/Arsec.hs+5−2
@@ -1,6 +1,7 @@
11module Arsec
22 (
3− comment
3+ Comment
4+ , comment
45 , semi
56 , showC
67 , unichar
@@ -23,6 +24,8 @@ import Text.ParserCombinators.Parsec.Combinator hiding (optional)
2324import Text.ParserCombinators.Parsec.Error
2425import Text.ParserCombinators.Parsec.Prim hiding ((<|>), many)
2526
27+type Comment = String
28+
2629unichar :: Parser Char
2730unichar = chr . fst . head . readHex <$> many1 hexDigit
2831
@@ -32,7 +35,7 @@ unichars = manyTill (unichar <* spaces) semi
3235semi :: Parser ()
3336semi = char ';' *> spaces *> pure ()
3437
35−comment :: Parser String
38+comment :: Parser Comment
3639comment = (char '#' *> manyTill anyToken (char '\n')) <|> string "\n"
3740
3841showC :: Char -> String
scripts/CaseFolding.hs+10−6
@@ -4,7 +4,8 @@
44
55module CaseFolding
66 (
7− Fold(..)
7+ CaseFolding(..)
8+ , Fold(..)
89 , parseCF
910 , mapCF
1011 ) where
@@ -18,19 +19,22 @@ data Fold = Fold {
1819 , name :: String
1920 } deriving (Eq, Ord, Show)
2021
21−entries :: Parser [Fold]
22−entries = many comment *> many (entry <* many comment)
22+data CaseFolding = CF { cfComments :: [Comment], cfFolding :: [Fold] }
23+ deriving (Show)
24+
25+entries :: Parser CaseFolding
26+entries = CF <$> many comment <*> many (entry <* many comment)
2327 where
2428 entry = Fold <$> unichar <* semi
2529 <*> oneOf "CFST" <* semi
2630 <*> unichars
2731 <*> (string "# " *> manyTill anyToken (char '\n'))
2832
29−parseCF :: FilePath -> IO (Either ParseError [Fold])
33+parseCF :: FilePath -> IO (Either ParseError CaseFolding)
3034parseCF name = parse entries name <$> readFile name
3135
32−mapCF :: [Fold] -> [String]
33−mapCF ms = typ ++ (map nice . filter p $ ms) ++ [last]
36+mapCF :: CaseFolding -> [String]
37+mapCF (CF _ ms) = typ ++ (map nice . filter p $ ms) ++ [last]
3438 where
3539 typ = ["foldMapping :: forall s. Char -> s -> Step (CC s) Char"
3640 ,"{-# INLINE foldMapping #-}"]
scripts/CaseMapping.hs+7−2
@@ -19,9 +19,14 @@ main = do
1919 Left err -> print err >> return undefined
2020 Right ms -> return ms
2121 h <- openFile oname WriteMode
22− mapM_ (hPutStrLn h) ["{-# LANGUAGE Rank2Types #-}"
22+ let comments = map ("--" ++) $
23+ take 2 (cfComments cfs) ++ take 2 (scComments scs)
24+ mapM_ (hPutStrLn h) $
25+ ["{-# LANGUAGE Rank2Types #-}"
2326 ,"-- AUTOMATICALLY GENERATED - DO NOT EDIT"
24− ,"-- Generated by scripts/SpecialCasing.hs"
27+ ,"-- Generated by scripts/SpecialCasing.hs"] ++
28+ comments ++
29+ [""
2530 ,"module Data.Text.Fusion.CaseMapping where"
2631 ,"import Data.Char"
2732 ,"import Data.Text.Fusion.Internal"
scripts/SpecialCasing.hs+12−6
@@ -4,13 +4,17 @@
44
55module SpecialCasing
66 (
7− Case(..)
7+ SpecialCasing(..)
8+ , Case(..)
89 , parseSC
910 , mapSC
1011 ) where
1112
1213import Arsec
1314
15+data SpecialCasing = SC { scComments :: [Comment], scCasing :: [Case] }
16+ deriving (Show)
17+
1418data Case = Case {
1519 code :: Char
1620 , lower :: [Char]
@@ -20,8 +24,8 @@ data Case = Case {
2024 , name :: String
2125 } deriving (Eq, Ord, Show)
2226
23−entries :: Parser [Case]
24−entries = many comment *> many (entry <* many comment)
27+entries :: Parser SpecialCasing
28+entries = SC <$> many comment <*> many (entry <* many comment)
2529 where
2630 entry = Case <$> unichar <* semi
2731 <*> unichars
@@ -30,11 +34,13 @@ entries = many comment *> many (entry <* many comment)
3034 <*> manyTill anyToken (string "# ")
3135 <*> manyTill anyToken (char '\n')
3236
33−parseSC :: FilePath -> IO (Either ParseError [Case])
37+parseSC :: FilePath -> IO (Either ParseError SpecialCasing)
3438parseSC name = parse entries name <$> readFile name
3539
36−mapSC :: String -> (Case -> String) -> (Char -> Char) -> [Case] -> [String]
37−mapSC which access twiddle ms = typ ++ (map nice . filter p $ ms) ++ [last]
40+mapSC :: String -> (Case -> String) -> (Char -> Char) -> SpecialCasing
41+ -> [String]
42+mapSC which access twiddle (SC _ ms) =
43+ typ ++ (map nice . filter p $ ms) ++ [last]
3844 where
3945 typ = [which ++ "Mapping :: forall s. Char -> s -> Step (CC s) Char"
4046 ,"{-# INLINE " ++ which ++ "Mapping #-}"]