]>
Commit | Line | Data |
---|---|---|
675085c2 JG |
1 | -- taken from https://github.com/jaspervdj/blaze-html/blob/2c4513e30ce768517b8d7b7b154d438f55217006/src/Util/Sanitize.hs |
2 | ||
3 | -- Copyright Jasper Van der Jeugt 2010 | |
4 | ||
5 | -- All rights reserved. | |
6 | ||
7 | -- Redistribution and use in source and binary forms, with or without | |
8 | -- modification, are permitted provided that the following conditions are met: | |
9 | ||
10 | -- * Redistributions of source code must retain the above copyright | |
11 | -- notice, this list of conditions and the following disclaimer. | |
12 | ||
13 | -- * Redistributions in binary form must reproduce the above | |
14 | -- copyright notice, this list of conditions and the following | |
15 | -- disclaimer in the documentation and/or other materials provided | |
16 | -- with the distribution. | |
17 | ||
18 | -- * Neither the name of Jasper Van der Jeugt nor the names of other | |
19 | -- contributors may be used to endorse or promote products derived | |
20 | -- from this software without specific prior written permission. | |
21 | ||
22 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS | |
23 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT | |
24 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR | |
25 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT | |
26 | -- OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, | |
27 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT | |
28 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, | |
29 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY | |
30 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT | |
31 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE | |
32 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. | |
33 | -- | A program to sanitize an HTML tag to a Haskell function. | |
34 | -- | |
35 | module Util.Sanitize | |
36 | ( sanitize | |
37 | , keywords | |
38 | , prelude | |
39 | ) where | |
40 | ||
41 | import Data.Char (toLower, toUpper) | |
42 | import Data.Set (Set) | |
43 | import qualified Data.Set as S | |
44 | ||
45 | -- | Sanitize a tag. This function returns a name that can be used as | |
46 | -- combinator in haskell source code. | |
47 | -- | |
48 | -- Examples: | |
49 | -- | |
50 | -- > sanitize "class" == "class_" | |
51 | -- > sanitize "http-equiv" == "httpEquiv" | |
52 | -- | |
53 | sanitize :: String -> String | |
54 | sanitize str | |
55 | | lower == "doctypehtml" = "docTypeHtml" | |
56 | | otherwise = appendUnderscore $ removeDash lower | |
57 | where | |
58 | lower = map toLower str | |
59 | ||
60 | -- Remove a dash, replacing it by camelcase notation | |
61 | -- | |
62 | -- Example: | |
63 | -- | |
64 | -- > removeDash "foo-bar" == "fooBar" | |
65 | -- | |
66 | removeDash ('-' : x : xs) = toUpper x : removeDash xs | |
67 | removeDash (x : xs) = x : removeDash xs | |
68 | removeDash [] = [] | |
69 | ||
70 | appendUnderscore t | t `S.member` keywords = t ++ "_" | |
71 | | otherwise = t | |
72 | ||
73 | -- | A set of standard Haskell keywords, which cannot be used as combinators. | |
74 | -- | |
75 | keywords :: Set String | |
76 | keywords = S.fromList | |
77 | [ "case", "class", "data", "default", "deriving", "do", "else", "if" | |
78 | , "import", "in", "infix", "infixl", "infixr", "instance" , "let", "module" | |
79 | , "newtype", "of", "then", "type", "where" | |
80 | ] | |
81 | ||
82 | -- | Set of functions from the Prelude, which we do not use as combinators. | |
83 | -- | |
84 | prelude :: Set String | |
85 | prelude = S.fromList | |
86 | [ "abs", "acos", "acosh", "all", "and", "any", "appendFile", "asTypeOf" | |
87 | , "asin", "asinh", "atan", "atan2", "atanh", "break", "catch", "ceiling" | |
88 | , "compare", "concat", "concatMap", "const", "cos", "cosh", "curry", "cycle" | |
89 | , "decodeFloat", "div", "divMod", "drop", "dropWhile", "either", "elem" | |
90 | , "encodeFloat", "enumFrom", "enumFromThen", "enumFromThenTo", "enumFromTo" | |
91 | , "error", "even", "exp", "exponent", "fail", "filter", "flip" | |
92 | , "floatDigits", "floatRadix", "floatRange", "floor", "fmap", "foldl" | |
93 | , "foldl1", "foldr", "foldr1", "fromEnum", "fromInteger", "fromIntegral" | |
94 | , "fromRational", "fst", "gcd", "getChar", "getContents", "getLine", "head" | |
95 | , "id", "init", "interact", "ioError", "isDenormalized", "isIEEE" | |
96 | , "isInfinite", "isNaN", "isNegativeZero", "iterate", "last", "lcm" | |
97 | , "length", "lex", "lines", "log", "logBase", "lookup", "map", "mapM" | |
98 | , "mapM_", "max", "maxBound", "maximum", "maybe", "min", "minBound" | |
99 | , "minimum", "mod", "negate", "not", "notElem", "null", "odd", "or" | |
100 | , "otherwise", "pi", "pred", "print", "product", "properFraction", "putChar" | |
101 | , "putStr", "putStrLn", "quot", "quotRem", "read", "readFile", "readIO" | |
102 | , "readList", "readLn", "readParen", "reads", "readsPrec", "realToFrac" | |
103 | , "recip", "rem", "repeat", "replicate", "return", "reverse", "round" | |
104 | , "scaleFloat", "scanl", "scanl1", "scanr", "scanr1", "seq", "sequence" | |
105 | , "sequence_", "show", "showChar", "showList", "showParen", "showString" | |
106 | , "shows", "showsPrec", "significand", "signum", "sin", "sinh", "snd" | |
107 | , "span", "splitAt", "sqrt", "subtract", "succ", "sum", "tail", "take" | |
108 | , "takeWhile", "tan", "tanh", "toEnum", "toInteger", "toRational" | |
109 | , "truncate", "uncurry", "undefined", "unlines", "until", "unwords", "unzip" | |
110 | , "unzip3", "userError", "words", "writeFile", "zip", "zip3", "zipWith" | |
111 | , "zipWith3" | |
112 | ] |