{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DataKinds #-}

module Dormouse.Uri.QQ
  ( uri
  , uriRef
  ) where
  
import Data.ByteString.Char8 (pack)
import Dormouse.Uri
import Language.Haskell.TH.Quote 
import Language.Haskell.TH 

uri :: QuasiQuoter
uri :: QuasiQuoter
uri = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter 
  { quoteExp :: String -> Q Exp
quoteExp = \String
s -> 
      let res :: Either SomeException Uri
res = ByteString -> Either SomeException Uri
forall (m :: * -> *). MonadThrow m => ByteString -> m Uri
parseUri (ByteString -> Either SomeException Uri)
-> ByteString -> Either SomeException Uri
forall a b. (a -> b) -> a -> b
$ String -> ByteString
pack String
s in
      case Either SomeException Uri
res of
        Left SomeException
err -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
err
        Right Uri
x -> [| x :: Uri |]
  , quotePat :: String -> Q Pat
quotePat = \String
s ->
      case ByteString -> Either SomeException Uri
forall (m :: * -> *). MonadThrow m => ByteString -> m Uri
parseUri (String -> ByteString
pack String
s) of
        Left SomeException
err -> String -> Q Pat
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Pat) -> String -> Q Pat
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
err
        Right Uri
x  -> Q Exp -> Q Exp -> Q Exp
appE [|(==)|] [| (x :: Uri) |] Q Exp -> Q Pat -> Q Pat
`viewP` [p|True|]
  , quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error String
"Not supported"
  , quoteDec :: String -> Q [Dec]
quoteDec =String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error String
"Not supported"
  }

uriRef :: QuasiQuoter
uriRef :: QuasiQuoter
uriRef = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter 
  { quoteExp :: String -> Q Exp
quoteExp = \String
s -> 
      let res :: Either SomeException UriReference
res = ByteString -> Either SomeException UriReference
forall (m :: * -> *). MonadThrow m => ByteString -> m UriReference
parseUriRef (ByteString -> Either SomeException UriReference)
-> ByteString -> Either SomeException UriReference
forall a b. (a -> b) -> a -> b
$ String -> ByteString
pack String
s in
      case Either SomeException UriReference
res of
        Left SomeException
err -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
err
        Right UriReference
x -> [| x :: UriReference |]
  , quotePat :: String -> Q Pat
quotePat = \String
s ->
      case ByteString -> Either SomeException UriReference
forall (m :: * -> *). MonadThrow m => ByteString -> m UriReference
parseUriRef (String -> ByteString
pack String
s) of
        Left SomeException
err -> String -> Q Pat
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Pat) -> String -> Q Pat
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
err
        Right UriReference
x  -> Q Exp -> Q Exp -> Q Exp
appE [|(==)|] [| (x :: UriReference) |] Q Exp -> Q Pat -> Q Pat
`viewP` [p|True|]
  , quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error String
"Not supported"
  , quoteDec :: String -> Q [Dec]
quoteDec =String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error String
"Not supported"
  }