aboutsummaryrefslogtreecommitdiffhomepage
path: root/src/Util/Sanitize.hs
diff options
context:
space:
mode:
authorJohannes Gerer <oss@johannesgerer.com>2016-10-26 02:07:02 +0200
committerJohannes Gerer <oss@johannesgerer.com>2016-10-26 02:07:02 +0200
commit675085c2e0b0b851378da08b7d73024766107c87 (patch)
tree5a927de4a9576aef7e6129b96e74aa5c96f9ffb6 /src/Util/Sanitize.hs
downloadblazeT-675085c2e0b0b851378da08b7d73024766107c87.tar.gz
blazeT-675085c2e0b0b851378da08b7d73024766107c87.tar.zst
blazeT-675085c2e0b0b851378da08b7d73024766107c87.zip
Initial
Diffstat (limited to 'src/Util/Sanitize.hs')
-rw-r--r--src/Util/Sanitize.hs112
1 files changed, 112 insertions, 0 deletions
diff --git a/src/Util/Sanitize.hs b/src/Util/Sanitize.hs
new file mode 100644
index 0000000..112bae1
--- /dev/null
+++ b/src/Util/Sanitize.hs
@@ -0,0 +1,112 @@
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--
35module Util.Sanitize
36 ( sanitize
37 , keywords
38 , prelude
39 ) where
40
41import Data.Char (toLower, toUpper)
42import Data.Set (Set)
43import 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--
53sanitize :: String -> String
54sanitize 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--
75keywords :: Set String
76keywords = 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--
84prelude :: Set String
85prelude = 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 ]