{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE GADTs              #-}
{-# LANGUAGE CPP                #-}

module URI.ByteString.QQ
    ( uri
    , relativeRef
    ) where

import Language.Haskell.TH.Quote
import URI.ByteString
import Data.ByteString.Char8
import Instances.TH.Lift()

-- | Allows uri literals via QuasiQuotes language extension.
--
-- >>> {-# LANGUAGE QuasiQuotes #-}
-- >>> stackage :: URI
-- >>> stackage = [uri|http://stackage.org|]
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
                        parsedURI :: URIRef Absolute
parsedURI = (URIParseError -> URIRef Absolute)
-> (URIRef Absolute -> URIRef Absolute)
-> Either URIParseError (URIRef Absolute)
-> URIRef Absolute
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\URIParseError
err -> String -> URIRef Absolute
forall a. HasCallStack => String -> a
error (String -> URIRef Absolute) -> String -> URIRef Absolute
forall a b. (a -> b) -> a -> b
$ URIParseError -> String
forall a. Show a => a -> String
show URIParseError
err) URIRef Absolute -> URIRef Absolute
forall a. a -> a
id (URIParserOptions
-> ByteString -> Either URIParseError (URIRef Absolute)
parseURI URIParserOptions
laxURIParserOptions (String -> ByteString
pack String
s))
                      in
                        [| parsedURI |],
                   quotePat :: String -> Q Pat
quotePat = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error String
"Not implemented.",
                   quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error String
"Not implemented.",
                   quoteDec :: String -> Q [Dec]
quoteDec = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error String
"Not implemented."
                  }


-------------------------------------------------------------------------------
-- | Allows relative ref literals via QuasiQuotes language extension.
--
-- >>> {-# LANGUAGE QuasiQuotes #-}
-- >>> ref :: RelativeRef
-- >>> ref = [relativeRef|/foo?bar=baz#quux|]
relativeRef :: QuasiQuoter
relativeRef :: QuasiQuoter
relativeRef = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter { quoteExp :: String -> Q Exp
quoteExp = \String
s ->
                      let
                        parsedURI :: URIRef Relative
parsedURI = (URIParseError -> URIRef Relative)
-> (URIRef Relative -> URIRef Relative)
-> Either URIParseError (URIRef Relative)
-> URIRef Relative
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\URIParseError
err -> String -> URIRef Relative
forall a. HasCallStack => String -> a
error (String -> URIRef Relative) -> String -> URIRef Relative
forall a b. (a -> b) -> a -> b
$ URIParseError -> String
forall a. Show a => a -> String
show URIParseError
err) URIRef Relative -> URIRef Relative
forall a. a -> a
id (URIParserOptions
-> ByteString -> Either URIParseError (URIRef Relative)
parseRelativeRef URIParserOptions
laxURIParserOptions (String -> ByteString
pack String
s))
                      in
                        [| parsedURI |],
                   quotePat :: String -> Q Pat
quotePat = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error String
"Not implemented.",
                   quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error String
"Not implemented.",
                   quoteDec :: String -> Q [Dec]
quoteDec = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error String
"Not implemented."
                  }