module Burrito.Internal.TH
( expandTH,
uriTemplate,
)
where
import qualified Burrito.Internal.Expand as Expand
import qualified Burrito.Internal.Parse as Parse
import qualified Burrito.Internal.Type.Template as Template
import qualified Burrito.Internal.Type.Value as Value
import qualified Data.Bifunctor as Bifunctor
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LazyText
import qualified Data.Text.Lazy.Builder as Builder
import qualified Language.Haskell.TH.Quote as TH
import qualified Language.Haskell.TH.Syntax as TH
expandTH :: [(String, Value.Value)] -> Template.Template -> TH.Q TH.Exp
expandTH :: [(String, Value)] -> Template -> Q Exp
expandTH [(String, Value)]
xs Template
t = do
let m :: Map Text Value
m = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Bifunctor.first String -> Text
Text.pack) [(String, Value)]
xs
f :: Text -> Either String (Maybe Value)
f Text
k =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"missing variable: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
k) (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) forall a b. (a -> b) -> a -> b
$
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
k Map Text Value
m
String
x <-
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
LazyText.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Builder.toLazyText) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *).
Monad m =>
(Text -> m (Maybe Value)) -> Template -> m Builder
Expand.expandWith Text -> Either String (Maybe Value)
f Template
t
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
TH.lift String
x
uriTemplate :: TH.QuasiQuoter
uriTemplate :: QuasiQuoter
uriTemplate =
TH.QuasiQuoter
{ quoteDec :: String -> Q [Dec]
TH.quoteDec = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot be used as a declaration",
quoteExp :: String -> Q Exp
TH.quoteExp = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid URI template") forall (m :: * -> *) a. (Quote m, Data a) => a -> m Exp
TH.liftData forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Template
Parse.parse,
quotePat :: String -> Q Pat
TH.quotePat = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot be used as a pattern",
quoteType :: String -> Q Type
TH.quoteType = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot be used as a type"
}