git.iko.soy/typeable/servant
on master help sign in
Allow comments in API QQ.
108f24aJulian K. Arni
src/Servant/Utils/ApiQuasiQuoting.hs+18−4
compare with master
unifiedsplit
@@ -90,9 +90,11 @@ data Typ = Val String
90
90
91parseTyp :: Parser Typ
91parseTyp :: Parser Typ
92parseTyp = do
92parseTyp = do
93− f <- many (noneOf "-#\n\r")
93+ f <- many (noneOf "-{\n\r")
94 spaces
94 spaces
95− s <- optionMaybe parseRet
95+ s <- optionMaybe (try parseRet)
96+ try $ optional inlineComment
97+ try $ optional blockComment
96 case s of
98 case s of
97 Nothing -> return $ Val (stripTr f)
99 Nothing -> return $ Val (stripTr f)
98 Just s' -> return $ ReqArgVal (stripTr f) (stripTr s')
100 Just s' -> return $ ReqArgVal (stripTr f) (stripTr s')
@@ -101,7 +103,7 @@ parseTyp = do
101 parseRet = do
103 parseRet = do
102 string "->"
104 string "->"
103 spaces
105 spaces
104− many (noneOf "#\n\r")
106+ many (noneOf "-{\n\r")
105 stripTr = reverse . dropWhile (== ' ') . reverse
107 stripTr = reverse . dropWhile (== ' ') . reverse
106
108
107
109
@@ -116,6 +118,18 @@ parseEntry = do
116 Val s -> return $ url (met s)
118 Val s -> return $ url (met s)
117 ReqArgVal i o -> return $ url $ reqBody i (met o)
119 ReqArgVal i o -> return $ url $ reqBody i (met o)
118
120
121+blockComment :: Parser ()
122+blockComment = do
123+ string "{-"
124+ manyTill anyChar (try $ string "-}")
125+ return ()
126+
127+inlineComment :: Parser ()
128+inlineComment = do
129+ string "--"
130+ manyTill anyChar (try $ lookAhead eol)
131+ return ()
132+
119eol :: Parser String
133eol :: Parser String
120eol = try (string "\n\r")
134eol = try (string "\n\r")
121 <|> try (string "\r\n")
135 <|> try (string "\r\n")
@@ -124,7 +138,7 @@ eol = try (string "\n\r")
124 <?> "end of line"
138 <?> "end of line"
125
139
126eols :: Parser ()
140eols :: Parser ()
127−eols = skipMany $ void eol
141+eols = skipMany $ void eol <|> blockComment <|> inlineComment
128
142
129parseAll :: Parser Type
143parseAll :: Parser Type
130parseAll = do
144parseAll = do
test/Servant/Utils/ApiQuasiQuotingSpec.hs+34
@@ -83,6 +83,34 @@ POST hello Bool
83GET hello Bool
83GET hello Bool
84|]
84|]
85type TwoPaths' = ("hello" :> Post Bool) :<|> ("hello" :> Get Bool)
85type TwoPaths' = ("hello" :> Post Bool) :<|> ("hello" :> Get Bool)
86+
87+type WithInlineComments = [sitemap|
88+GET hello Bool -- This is a comment
89+|]
90+type WithInlineComments' = "hello" :> Get Bool
91+
92+type WithInlineComments2 = [sitemap|
93+GET hello Bool
94+-- This is a comment
95+|]
96+type WithInlineComments2' = "hello" :> Get Bool
97+
98+
99+type WithBlockComments = [sitemap|
100+GET hello Bool {-
101+POST hello Bool
102+-}
103+|]
104+type WithBlockComments' = "hello" :> Get Bool
105+
106+type WithBlockComments2 = [sitemap|
107+GET hello Bool {-
108+POST hello Bool
109+-}
110+POST hello Bool
111+|]
112+type WithBlockComments2' = ("hello" :> Get Bool) :<|> ("hello" :> Post Bool)
113+
86--------------------------------------------------------------------------
114--------------------------------------------------------------------------
87-- Spec
115-- Spec
88--------------------------------------------------------------------------
116--------------------------------------------------------------------------
@@ -118,6 +146,12 @@ spec = do
118 (u::SimpleQueryParam) ~= (u::SimpleQueryParam''') ~> False
146 (u::SimpleQueryParam) ~= (u::SimpleQueryParam''') ~> False
119 it "Handles multiples paths" $ do
147 it "Handles multiples paths" $ do
120 (u::TwoPaths) ~= (u::TwoPaths') ~> True
148 (u::TwoPaths) ~= (u::TwoPaths') ~> True
149+ it "Ignores inline comments" $ do
150+ (u::WithInlineComments) ~= (u::WithInlineComments') ~> True
151+ (u::WithInlineComments2) ~= (u::WithInlineComments2') ~> True
152+ it "Ignores inline comments" $ do
153+ (u::WithBlockComments) ~= (u::WithBlockComments') ~> True
154+ (u::WithBlockComments2) ~= (u::WithBlockComments2') ~> True
121
155
122
156
123--------------------------------------------------------------------------
157--------------------------------------------------------------------------