@@ -17,12 +17,14 @@ import Servant.API.Get
1717import Servant.API.Post
1818import Servant.API.Put
1919import Servant.API.Delete
20+import Servant.API.RQBody
2021import Servant.API.Sub
2122import Servant.API.Union
2223
2324class ExpSYM repr' repr | repr -> repr', repr' -> repr where
2425 lit :: String -> repr' -> repr
2526 capture :: String -> String -> repr -> repr
27+ rqBody :: String -> repr -> repr
2628 conj :: repr' -> repr -> repr
2729 get :: String -> repr
2830 post :: String -> repr
@@ -34,34 +36,42 @@ infixr 6 >:
3436(>:) :: Type -> Type -> Type
3537(>:) = conj
3638
39+
3740instance ExpSYM Type Type where
3841 lit name r = (LitT (StrTyLit name)) >: r
3942 capture name typ r = (AppT (AppT (ConT ''Capture) (LitT (StrTyLit name)))
4043 (ConT $ mkName typ)) >: r
44+ rqBody typ r = (AppT (ConT ''RQBody) (ConT $ mkName typ)) >: r
4145 conj x y = AppT (AppT (ConT ''(:>)) x) y
4246 get typ = AppT (ConT ''Get) (ConT $ mkName typ)
4347 post typ = AppT (ConT ''Post) (ConT $ mkName typ)
4448 put typ = AppT (ConT ''Put) (ConT $ mkName typ)
45− delete typ = AppT (ConT ''Delete) (ConT $ mkName typ)
49+ delete "()" = ConT ''Delete
50+ delete _ = error "Delete does not return a request body"
4651
4752readEntry :: ExpSYM r r => [String] -> Maybe r
4853readEntry [] = Nothing
49−readEntry (met:typ:xs) = case met of
50− "GET" -> readEntry' xs $ get typ
51− "POST" -> readEntry' xs $ post typ
52− "PUT" -> readEntry' xs $ put typ
53− "DELETE" -> readEntry' xs $ delete typ
54+readEntry (met:xs:typ) = case met of
55+ "GET" -> rd get
56+ "POST" -> rd post
57+ "PUT" -> rd put
58+ "DELETE" -> rd delete
5459 x -> error $ "Unknown method: " ++ x
60+ where typ' = splitOn "->" $ concat typ
61+ rd m = case typ' of
62+ [] -> readEntry' xs $ m "()"
63+ [rsp] -> readEntry' xs $ m rsp
64+ (rqbd:[rsp]) -> readEntry' xs $ rqBody rqbd $ m rsp
65+ _ -> error "Only functions of one argument allowed!"
5566readEntry x = error $ "Wrong number of elems in line: " ++ show x
5667
57−readEntry' :: ExpSYM r r => [String] -> r -> Maybe r
68+readEntry' :: ExpSYM r r => String -> r -> Maybe r
5869readEntry' [] _ = Nothing
59−readEntry' [xs] r = Just $ foldr1 (.) (tRepr <$> splitOn "/" xs) r
70+readEntry' xs r = Just $ foldr1 (.) (tRepr <$> splitOn "/" xs) r
6071 where
6172 tRepr y | [x] <- splitOn ":" y = lit x
6273 | a:[b] <- splitOn ":" y = capture a b
6374 | otherwise = error "Only one ':' per section"
64−readEntry' _ _ = Nothing
6575
6676readAll :: String -> Type
6777readAll s = foldr1 union $ mapMaybe readEntry $ words <$> lines s