git.iko.soy/typeable/servant
on master help sign in
Allow comments in API QQ.

Closes #29.

commit108f24a5e72d3e603df5a449367ae14e9382ceea authorJulian K. Arni <jkarni@gmail.com> dateThu 13 Nov 2014, 18:22 (12 years ago) parent4f62dce
2 files changed+52−4
compare with master
unifiedsplit
src/Servant/Utils/ApiQuasiQuoting.hs+18−4 test/Servant/Utils/ApiQuasiQuotingSpec.hs+34
src/Servant/Utils/ApiQuasiQuoting.hs+18−4
@@ -90,9 +90,11 @@ data Typ = Val String
9090
9191parseTyp :: Parser Typ
9292parseTyp = do
93− f <- many (noneOf "-#\n\r")
93+ f <- many (noneOf "-{\n\r")
9494 spaces
95− s <- optionMaybe parseRet
95+ s <- optionMaybe (try parseRet)
96+ try $ optional inlineComment
97+ try $ optional blockComment
9698 case s of
9799 Nothing -> return $ Val (stripTr f)
98100 Just s' -> return $ ReqArgVal (stripTr f) (stripTr s')
@@ -101,7 +103,7 @@ parseTyp = do
101103 parseRet = do
102104 string "->"
103105 spaces
104− many (noneOf "#\n\r")
106+ many (noneOf "-{\n\r")
105107 stripTr = reverse . dropWhile (== ' ') . reverse
106108
107109
@@ -116,6 +118,18 @@ parseEntry = do
116118 Val s -> return $ url (met s)
117119 ReqArgVal i o -> return $ url $ reqBody i (met o)
118120
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+
119133eol :: Parser String
120134eol = try (string "\n\r")
121135 <|> try (string "\r\n")
@@ -124,7 +138,7 @@ eol = try (string "\n\r")
124138 <?> "end of line"
125139
126140eols :: Parser ()
127−eols = skipMany $ void eol
141+eols = skipMany $ void eol <|> blockComment <|> inlineComment
128142
129143parseAll :: Parser Type
130144parseAll = do
test/Servant/Utils/ApiQuasiQuotingSpec.hs+34
@@ -83,6 +83,34 @@ POST hello Bool
8383GET hello Bool
8484|]
8585type 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+
86114--------------------------------------------------------------------------
87115-- Spec
88116--------------------------------------------------------------------------
@@ -118,6 +146,12 @@ spec = do
118146 (u::SimpleQueryParam) ~= (u::SimpleQueryParam''') ~> False
119147 it "Handles multiples paths" $ do
120148 (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
121155
122156
123157--------------------------------------------------------------------------