Compile-time checked URIs

Question

I want to make an expression such that I have a compiletime error or a URI.

[uri|http://stackoverflow.com|]

should compile, but

[uri|foo:/bar:\|]

should not.

I've come across QuasiQuotes, which are apparently for this kind of problem. However, I can't seem to create the Q Exp from the parsed URI.

import Language.Haskell.TH.Quote
import Language.Haskell.TH.Syntax
import Language.Haskell.TH
import URI.ByteString
import Data.ByteString.Char8


uri = QuasiQuoter { quoteExp = \s ->
                      let
                        uri = either (\err -> error $ show err) id (parseURI laxURIParserOptions (pack s))
                      in
                        [| uri |]
                  }

Doesn't compile, because it wants a Lift instance for URI. However, I'm not sure how to create one, due to the GADT nature.

deriving instance Lift (URIRef a)

Complains about no Lift ByteString, but I have no idea to write one. Another way would be the Data URI, but that fails with

    85   1 error           • Couldn't match type ‘a’ with ‘Absolute’
  ‘a’ is a rigid type variable bound by
    the instance declaration at uri-bytestring/src/URI/ByteString/Types.hs:85:1
  Expected type: c (URIRef a)
    Actual type: c (URIRef Absolute)
• In the expression: k (k (k (k (k (z URI)))))
  In a case alternative:
      ghc-prim-0.5.0.0:GHC.Types.I# 1# -> k (k (k (k (k (z URI)))))
  In the expression:
    case constrIndex c of {
      ghc-prim-0.5.0.0:GHC.Types.I# 1# -> k (k (k (k (k (z URI)))))
      _ -> k (k (k (k (z RelativeRef)))) }
  When typechecking the code for ‘gunfold’
    in a derived instance for ‘Data (URIRef a)’:
    To see the code I am typechecking, use -ddump-deriv
• Relevant bindings include
    gunfold :: (forall b r. Data b => c (b -> r) -> c r)
                -> (forall r. r -> c r) -> Constr -> c (URIRef a)
      (bound at uri-bytestring/src/URI/ByteString/Types.hs:85:1) (haskell-stack-ghc)

I'd prefer to use Generics, but I'm not sure how to use them with the QQ APIs.

Answer 1

You are almost there - the Lift Bytestring instance you are looking for is provided in the th-lift-instances package.

import Instances.TH.Lift

Of course, you could also just copy the relevant instance instead of incurring a dependency.

-- ByteString
instance Lift ByteString where
  lift b = [| pack $(lift $ unpack b) |]

Then, with DeriveLift, StandaloneDeriving, GADTs, and TemplateHaskell turned on, you can create orphan Lift instances for all the types URIRef depends (transitively) on.

deriving instance Lift (URIRef a)
deriving instance Lift Authority
deriving instance Lift UserInfo
deriving instance Lift Query
deriving instance Lift Host
deriving instance Lift Port
deriving instance Lift Scheme

With this addition, your code now compiles. At GHCi I get the following interaction, confirming everything works.

ghci> :set -XQuasiQuotes
ghci> [uri|http://stackoverflow.com|]
URI {uriScheme = Scheme {schemeBS = "http"}, uriAuthority = Just (Authority {authorityUserInfo = Nothing, authorityHost = Host {hostBS = "stackoverflow.com"}, authorityPort = Nothing}), uriPath = "", uriQuery = Query {queryPairs = []}, uriFragment = Nothing}
ghci> [uri|foo:/bar:\|]

<interactive>:3:1: error:
    • Exception when trying to run compile-time code:
        MalformedPath
CallStack (from HasCallStack):
  error, called at uri.hs:25:47 in main:Main
      Code: quoteExp uri "foo:/bar:\\"
    • In the quasi-quotation: [uri|foo:/bar:\|]
ghci>

EDIT

Just noticed I never answered the last part of your question.

I'd prefer to use Generics, but I'm not sure how to use them with the QQ APIs.

That won't be possible - generic programming won't let you execute arbitrary validation code at compile time. You really need TemplateHaskell for this. At best you could use them inside the TemplateHaskell code generated, but that would be unnecessary (there is nothing generic to do there).