f0437f2 · text · git.iko.soy

scripts/Arsec.hs+5−2

compare with master

unifiedsplit

@@ -1,6 +1,7 @@

1module Arsec

2 (

3+ Comment

3− comment

4+ , comment

4 , semi

5 , semi

5 , showC

6 , showC

6 , unichar

7 , unichar

@@ -23,6 +24,8 @@ import Text.ParserCombinators.Parsec.Combinator hiding (optional)

23import Text.ParserCombinators.Parsec.Error

24import Text.ParserCombinators.Parsec.Error

24import Text.ParserCombinators.Parsec.Prim hiding ((<|>), many)

25import Text.ParserCombinators.Parsec.Prim hiding ((<|>), many)

25

26

27+type Comment = String

28+

26unichar :: Parser Char

29unichar :: Parser Char

27unichar = chr . fst . head . readHex <$> many1 hexDigit

30unichar = chr . fst . head . readHex <$> many1 hexDigit

28

31

@@ -32,7 +35,7 @@ unichars = manyTill (unichar <* spaces) semi

32semi :: Parser ()

35semi :: Parser ()

33semi = char ';' *> spaces *> pure ()

36semi = char ';' *> spaces *> pure ()

34

37

35−comment :: Parser String

38+comment :: Parser Comment

36comment = (char '#' *> manyTill anyToken (char '\n')) <|> string "\n"

39comment = (char '#' *> manyTill anyToken (char '\n')) <|> string "\n"

37

40

38showC :: Char -> String

41showC :: Char -> String

scripts/CaseFolding.hs+10−6

@@ -4,7 +4,8 @@

4

5module CaseFolding

6 (

7+ CaseFolding(..)

7− Fold(..)

8+ , Fold(..)

8 , parseCF

9 , parseCF

9 , mapCF

10 , mapCF

10 ) where

11 ) where

@@ -18,19 +19,22 @@ data Fold = Fold {

18 , name :: String

19 , name :: String

19 } deriving (Eq, Ord, Show)

20 } deriving (Eq, Ord, Show)

20

21

22+data CaseFolding = CF { cfComments :: [Comment], cfFolding :: [Fold] }

23+ deriving (Show)

24+

21−entries :: Parser [Fold]

25+entries :: Parser CaseFolding

22−entries = many comment *> many (entry <* many comment)

26+entries = CF <$> many comment <*> many (entry <* many comment)

23 where

27 where

24 entry = Fold <$> unichar <* semi

28 entry = Fold <$> unichar <* semi

25 <*> oneOf "CFST" <* semi

29 <*> oneOf "CFST" <* semi

26 <*> unichars

30 <*> unichars

27 <*> (string "# " *> manyTill anyToken (char '\n'))

31 <*> (string "# " *> manyTill anyToken (char '\n'))

28

32

29−parseCF :: FilePath -> IO (Either ParseError [Fold])

33+parseCF :: FilePath -> IO (Either ParseError CaseFolding)

30parseCF name = parse entries name <$> readFile name

34parseCF name = parse entries name <$> readFile name

31

35

32−mapCF :: [Fold] -> [String]

36+mapCF :: CaseFolding -> [String]

33−mapCF ms = typ ++ (map nice . filter p $ ms) ++ [last]

37+mapCF (CF _ ms) = typ ++ (map nice . filter p $ ms) ++ [last]

34 where

38 where

35 typ = ["foldMapping :: forall s. Char -> s -> Step (CC s) Char"

39 typ = ["foldMapping :: forall s. Char -> s -> Step (CC s) Char"

36 ,"{-# INLINE foldMapping #-}"]

40 ,"{-# INLINE foldMapping #-}"]

scripts/CaseMapping.hs+7−2

@@ -19,9 +19,14 @@ main = do

19 Left err -> print err >> return undefined

20 Right ms -> return ms

21 h <- openFile oname WriteMode

22+ let comments = map ("--" ++) $

23+ take 2 (cfComments cfs) ++ take 2 (scComments scs)

24+ mapM_ (hPutStrLn h) $

22− mapM_ (hPutStrLn h) ["{-# LANGUAGE Rank2Types #-}"

25+ ["{-# LANGUAGE Rank2Types #-}"

23 ,"-- AUTOMATICALLY GENERATED - DO NOT EDIT"

26 ,"-- AUTOMATICALLY GENERATED - DO NOT EDIT"

24− ,"-- Generated by scripts/SpecialCasing.hs"

27+ ,"-- Generated by scripts/SpecialCasing.hs"] ++

28+ comments ++

29+ [""

25 ,"module Data.Text.Fusion.CaseMapping where"

30 ,"module Data.Text.Fusion.CaseMapping where"

26 ,"import Data.Char"

31 ,"import Data.Char"

27 ,"import Data.Text.Fusion.Internal"

32 ,"import Data.Text.Fusion.Internal"

scripts/SpecialCasing.hs+12−6

@@ -4,13 +4,17 @@

4

5module SpecialCasing

6 (

7+ SpecialCasing(..)

7− Case(..)

8+ , Case(..)

8 , parseSC

9 , parseSC

9 , mapSC

10 , mapSC

10 ) where

11 ) where

11

12

12import Arsec

13import Arsec

13

14

15+data SpecialCasing = SC { scComments :: [Comment], scCasing :: [Case] }

16+ deriving (Show)

17+

14data Case = Case {

18data Case = Case {

15 code :: Char

19 code :: Char

16 , lower :: [Char]

20 , lower :: [Char]

@@ -20,8 +24,8 @@ data Case = Case {

20 , name :: String

24 , name :: String

21 } deriving (Eq, Ord, Show)

25 } deriving (Eq, Ord, Show)

22

26

23−entries :: Parser [Case]

27+entries :: Parser SpecialCasing

24−entries = many comment *> many (entry <* many comment)

28+entries = SC <$> many comment <*> many (entry <* many comment)

25 where

29 where

26 entry = Case <$> unichar <* semi

30 entry = Case <$> unichar <* semi

27 <*> unichars

31 <*> unichars

@@ -30,11 +34,13 @@ entries = many comment *> many (entry <* many comment)

30 <*> manyTill anyToken (string "# ")

34 <*> manyTill anyToken (string "# ")

31 <*> manyTill anyToken (char '\n')

35 <*> manyTill anyToken (char '\n')

32

36

33−parseSC :: FilePath -> IO (Either ParseError [Case])

37+parseSC :: FilePath -> IO (Either ParseError SpecialCasing)

34parseSC name = parse entries name <$> readFile name

38parseSC name = parse entries name <$> readFile name

35

39

36−mapSC :: String -> (Case -> String) -> (Char -> Char) -> [Case] -> [String]

40+mapSC :: String -> (Case -> String) -> (Char -> Char) -> SpecialCasing

41+ -> [String]

37−mapSC which access twiddle ms = typ ++ (map nice . filter p $ ms) ++ [last]

42+mapSC which access twiddle (SC _ ms) =

43+ typ ++ (map nice . filter p $ ms) ++ [last]

38 where

44 where

39 typ = [which ++ "Mapping :: forall s. Char -> s -> Step (CC s) Char"

45 typ = [which ++ "Mapping :: forall s. Char -> s -> Step (CC s) Char"

40 ,"{-# INLINE " ++ which ++ "Mapping #-}"]

46 ,"{-# INLINE " ++ which ++ "Mapping #-}"]