Haskell: Making Quasi-Quoted values strict / evaluated at compile-time

Question

I have a 'Month' type, which is roughly

newtype Month = Month Word8

where the Month constructor isn't exported; instead, a function

mon :: Word8 -> Maybe Month
mon i = if i > 0 && i < 13
        then Just $ Month i
        else Nothing

is exported, which will only return a value if the input value is between 1 & 12 inclusive.

Now, using Language.Haskell.TH.Quote, I have defined a quasi-quoting ... operator? ... that allows me to "create" instances of Month "at compile time":

month :: QuasiQuoter
month = QuasiQuoter { quoteDec  = error "quoteDec not implemented"
                    , quoteType = error "quoteType not implemented"
                    , quotePat  = "quotePat not implemented"
                    , quoteExp = (\ s → ⟦ force $ __fromString @Month s ⟧)
                    }


m :: Month
m = [month|3|]

Where __fromString parses a string, and either returns a value or calls error. force is from Control.DeepSeq.

Now this is well and good, but the principle value of this is to catch bad values as early as possible - but, thanks to Lazy Evaluation, the value m is not evaluated either at compile-time (which would be ideal, but a rather tall order, perhaps) or at least at the earliest stage of runtime.

Is there any way that I can annotate the value (preferably within the quasi-quotation infra, so that every use of month gets it for free; but failing that, annotating m) to force the evaluation of m when the program gets run? Requiring an NFData constraint or similar is fine.

Thanks,

Answer 1

Your quasiquoter just defers everything to runtime by putting everything inside a quote. You need to move the parsing and verification outside the quote.

My quick proof of concept:

{-# LANGUAGE TemplateHaskell, DeriveLift #-}
module A ( Month,
           mon,
           month
         ) where

import Text.Read
import Language.Haskell.TH
import Language.Haskell.TH.Syntax (Lift)
import Language.Haskell.TH.Quote

newtype Month = Month Int deriving (Show, Eq, Ord, Lift)

mon :: Int -> Maybe Month
mon n | n >= 1 && n <= 12 = Just $ Month n
      | otherwise = Nothing

monthExpImpl :: String -> Q Exp
monthExpImpl s = case readMaybe s of
  Nothing -> fail "Couldn't parse input as number"
  Just n -> case mon n of
    Nothing -> fail "Not a valid month"
    Just x -> [| x |]

month :: QuasiQuoter
month = QuasiQuoter { quoteDec  = error "quoteDec not implemented"
                    , quoteType = error "quoteType not implemented"
                    , quotePat  = error "quotePat not implemented"
                    , quoteExp = monthExpImpl
                    }

Note that monthExpImpl puts all the logic outside of the quote. fail is the recommended way to terminate a Q action with a compilation error, strange as that feels to someone used to thinking of fail as a historical accident that we're moving away from.

The most surprising bits here are the DeriveLift extension and its use to add Lift to the list of derived classes for Month. Lift is used by TH to convert a value to code that generates that value. Without it, the compiler has no idea how to make the [| x |] quote into code.

You might wonder about how valid it is for TH to generate code that calls a constructor that shouldn't be visible from the compilation unit the generated code is in. I wondered the same. Turns out it's fine, as long as the code that creates the constructor in TH can see the constructor. In this case, it's the Lift instance which is doing that, and it's defined in the same module, so it can see the constructor. That might give you pause about creating such an instance, because you can't prevent an instance from being exported. And that's a valid consideration. In this case it's fine, though, because lift requires a value to convert to code, and the only* way to get such a value from outside the module is through mon anyway, so it doesn't introduce any new ways to muck things up. (I say "only*" because unsafeCoerce exists, but let's just pretend it doesn't. When you use it, you have to take responsibility for breaking everything anyway.)