0

I have a Lift instance that works with template-haskell 2.14, but won't compile with later versions. Can someone explain what changes are needed?

{-# LANGUAGE FlexibleInstances, TemplateHaskell #-}

module LiftBS where

import Data.ByteString as B (ByteString, length, unpack)
import Data.ByteString.Unsafe (unsafePackAddressLen)
import Language.Haskell.TH (runIO, litE, stringPrimL)
import Language.Haskell.TH.Lift (Lift(lift))

instance Lift (IO B.ByteString) where
  lift bsio = do
    bs <- runIO bsio
    [|unsafePackAddressLen $(lift (B.length bs)) $(litE (stringPrimL (B.unpack bs))) :: IO ByteString|]
David Fox
  • 654
  • 4
  • 10
  • I don't think you'll be able to write that instance with `template-haskell-2.17.0.0` or newer. The type of `lift` is `Quote m => t -> m Exp`, and the `Quote` type class can't do IO. – Taylor Fausak May 09 '22 at 23:40

1 Answers1

6

That's a sketchy instance of Lift. It's really not what Lift is for. It isn't an accident that the new type of lift rules out compile-time side effects. Lift is for serializing data structures, which this isn't even doing conceptually. If this were serializing the data structure passed to it, it would be splicing in a representation of the IO action. This is executing an action and serializing the result of that action. That's just not what someone unfamiliar with this code is going to expect to happen.

Also, all the work you're putting in to serialize the ByteString as its components hasn't been necessary since bytestring-0.11.2.0, when it got its own Lift instance.

But the real thing to do here is just write a function that does what you want:

atCompileTime :: Lift a => IO a -> Q Exp
atCompileTime act = do
    x <- runIO act
    [| pure x |]

It's not a Lift instance, so it can have a type that allows it to do what you want. It's not a Lift instance, so it can have a name that explains what it's actually doing. And as a bonus, it will work across a wide range of versions of template haskell.

Carl
  • 26,500
  • 4
  • 65
  • 86