module CustomInterpolation.TH where
import CustomInterpolation.Config (InterpolationConfig (..), Interpolator (..))
import CustomInterpolation.Parser (StringPart (..), parseInterpolations)
import Language.Haskell.TH (Exp, Q, appE, listE)
import Language.Haskell.TH.Quote (QuasiQuoter (..))
import Text.Parsec (ParseError)
-- | Create a new 'QuasiQuoter' that interpolates strings as specified by the given 'InterpolationConfig'.
interpolateQQ :: InterpolationConfig a -> QuasiQuoter
interpolateQQ interpolation =
QuasiQuoter
{ quoteExp = interpolate interpolation,
quotePat = error "not used",
quoteType = error "not used",
quoteDec = error "not used"
}
-- | Interpolate a string as specified by the given 'InterpolationConfig'.
interpolate :: InterpolationConfig a -> String -> Q Exp
interpolate defaultConfig@InterpolationConfig {handlers, finalize} str = do
res <- either (parsingError str) (pure . concatParts defaultConfig) (parseInterpolations handlers str)
finalize res
{- | Concatenate the literals and interpolated parts of a list of 'StringPart's.
The interpolations may also each return some value which gets accumulated as a list in the first output.
-}
concatParts :: InterpolationConfig a -> [StringPart a] -> ([a], Q Exp)
concatParts InterpolationConfig {escape} ps = (otherData, concatenatedE)
where
concatenatedE = appE [|concat|] $ listE stringListE
(otherData, stringListE) = foldr step ([], []) ps
step subExpr (ds, qs) = case subExpr of
Lit str -> (ds, [|str|] : qs)
Esc c -> let c' = escape c in (ds, [|[c']|] : qs)
Anti Interpolator {handler} expr -> (\(d, q) -> (d : ds, q : qs)) $ handler expr
parsingError :: String -> ParseError -> Q a
parsingError expStr parseError =
error $
"Failed to parse interpolated expression in string: "
<> expStr
<> "\n"
<> show parseError