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

module Dormouse.Url.QQ
  ( http
  , https
  , url
  ) where

import Data.ByteString.Char8 (pack)
import Dormouse.Url
import Language.Haskell.TH.Quote 
import Language.Haskell.TH

http :: QuasiQuoter
http :: QuasiQuoter
http = 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 (Url "http")
res = ByteString -> Either SomeException (Url "http")
forall (m :: * -> *). MonadThrow m => ByteString -> m (Url "http")
parseHttpUrl (ByteString -> Either SomeException (Url "http"))
-> ByteString -> Either SomeException (Url "http")
forall a b. (a -> b) -> a -> b
$ String -> ByteString
pack String
s in
      case Either SomeException (Url "http")
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 Url "http"
x -> [| x |]
  , quotePat :: String -> Q Pat
quotePat = \String
s ->
      case ByteString -> Either SomeException (Url "http")
forall (m :: * -> *). MonadThrow m => ByteString -> m (Url "http")
parseHttpUrl (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 Url "http"
x  -> Q Exp -> Q Exp -> Q Exp
appE [|(==)|] [| (x :: Url "http") |] 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"
  }

https :: QuasiQuoter
https :: QuasiQuoter
https = 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 (Url "https")
res = ByteString -> Either SomeException (Url "https")
forall (m :: * -> *). MonadThrow m => ByteString -> m (Url "https")
parseHttpsUrl (ByteString -> Either SomeException (Url "https"))
-> ByteString -> Either SomeException (Url "https")
forall a b. (a -> b) -> a -> b
$ String -> ByteString
pack String
s in
      case Either SomeException (Url "https")
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 Url "https"
x -> [| (x :: Url "https") |]
  , quotePat :: String -> Q Pat
quotePat = \String
s ->
      case ByteString -> Either SomeException (Url "https")
forall (m :: * -> *). MonadThrow m => ByteString -> m (Url "https")
parseHttpsUrl (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 Url "https"
x  -> Q Exp -> Q Exp -> Q Exp
appE [|(==)|] [| (x :: Url "https") |] 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"
  }

url :: QuasiQuoter
url :: QuasiQuoter
url = 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 AnyUrl
res = ByteString -> Either SomeException AnyUrl
forall (m :: * -> *). MonadThrow m => ByteString -> m AnyUrl
parseUrl (ByteString -> Either SomeException AnyUrl)
-> ByteString -> Either SomeException AnyUrl
forall a b. (a -> b) -> a -> b
$ String -> ByteString
pack String
s in
      case Either SomeException AnyUrl
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 AnyUrl
x -> [| (x :: AnyUrl) |]
  , quotePat :: String -> Q Pat
quotePat = \String
s ->
      case ByteString -> Either SomeException AnyUrl
forall (m :: * -> *). MonadThrow m => ByteString -> m AnyUrl
parseUrl (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 AnyUrl
x  -> Q Exp -> Q Exp -> Q Exp
appE [|(==)|] [| (x :: AnyUrl) |] 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"
  }