59 lines
2.2 KiB
Haskell
59 lines
2.2 KiB
Haskell
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
{-# LANGUAGE FunctionalDependencies #-}
|
|
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
module Servant.API.QQ where
|
|
|
|
import Control.Applicative
|
|
import Data.List.Split (splitOn)
|
|
--import Language.Haskell.TH.Quote
|
|
import Language.Haskell.TH
|
|
|
|
import Servant.API.Capture
|
|
import Servant.API.Get
|
|
import Servant.API.Post
|
|
import Servant.API.Put
|
|
import Servant.API.Delete
|
|
import Servant.API.Sub
|
|
|
|
class ExpSYM repr' repr | repr -> repr', repr' -> repr where
|
|
simplePath :: String -> repr'
|
|
capture :: String -> String -> repr'
|
|
conj :: repr' -> repr' -> repr'
|
|
get :: String -> repr' -> repr
|
|
post :: String -> repr' -> repr
|
|
put :: String -> repr' -> repr
|
|
delete :: String -> repr' -> repr
|
|
|
|
instance ExpSYM Type Type where
|
|
simplePath name = LitT (StrTyLit name)
|
|
capture name typ = AppT (AppT (ConT ''Capture) (simplePath name))
|
|
(ConT $ mkName typ)
|
|
conj f s = AppT (AppT (ConT ''(:>)) f) s
|
|
get typ r = AppT (AppT (ConT ''(:>)) r)
|
|
(AppT (ConT ''Get) (ConT $ mkName typ))
|
|
post typ r = AppT (AppT (ConT ''(:>)) r)
|
|
(AppT (ConT ''Post) (ConT $ mkName typ))
|
|
put typ r = AppT (AppT (ConT ''(:>)) r)
|
|
(AppT (ConT ''Put) (ConT $ mkName typ))
|
|
delete typ r = AppT (AppT (ConT ''(:>)) r)
|
|
(AppT (ConT ''Delete) (ConT $ mkName typ))
|
|
|
|
readEntry :: ExpSYM r' r => [String] -> Maybe r
|
|
readEntry [] = Nothing
|
|
readEntry (met:typ:xs) = case met of
|
|
"GET" -> get typ <$> readEntry' xs
|
|
"POST" -> post typ <$> readEntry' xs
|
|
"PUT" -> put typ <$> readEntry' xs
|
|
"DELETE" -> delete typ <$> readEntry' xs
|
|
x -> error $ "Unknown method: " ++ x
|
|
readEntry x = error $ "Wrong number of elems in line: " ++ show x
|
|
|
|
readEntry' :: ExpSYM r' r => [String] -> Maybe r'
|
|
readEntry' [] = Nothing
|
|
readEntry' [xs] = Just $ foldr1 conj $ tRepr <$> splitOn "/" xs
|
|
where tRepr y | [x] <- splitOn ":" y = simplePath x
|
|
| x:[y] <- splitOn ":" y = capture x y
|
|
| otherwise = error "Only one ':' per section"
|
|
readEntry' _ = Nothing
|
|
|